cleanup

src/Gyehoek/CPS/Close.hs

@@ -4,29 +4,12 @@ module Gyehoek.CPS.Close
   ) where
 
 import Gyehoek.CPS.Syntax
-import Effectful
-import Data.Functor.Foldable
-import Control.Monad ((>=>))
-import Control.Lens
-import Data.List.NonEmpty (NonEmpty)
-import qualified Data.HashSet as HS
-import qualified Data.Set.Ordered as O
-import Data.Set.Ordered (OSet)
 import Gyehoek.GenSym
-import Data.String.Interpolate (i)
-import Debug.Pretty.Simple
-import Data.HashSet (HashSet)
+import Gyehoek.Prelude
 
 
-cataM
-  :: (Monad m, Traversable (Base t), Recursive t)
-  => (Base t a -> m a) -> t -> m a
-cataM f = cata (sequenceA >=> f)
-
 close :: GenSym :> es => Exp -> Eff es Exp
-
 close = transformM \case
-
   ExpLetRec [(f, AbsLambda lam@(MkLambda bs kb m))] e -> do
     f_code <- gensym' @Name $ f ^. _Wrapped'. to (<> "-code")
     -- it would probably be most sane to generate a symbol for `env`,
@@ -55,45 +38,5 @@ close = transformM \case
 
   e -> pure e
 
-  e -> error [i|unimplemented case: #{e}|]
-
-  -- lam@(ExpLambdaF bs m) -> do
-  --   env <- gensym' @Name "env"
-  --   let upvalBinds = free' (embed lam)
-  --         & itraversed %@~ \i x -> (x, [cps|(env-ref #{env} #{i})|])
-  --   let upvals = upvalBinds ^.. each . _1
-  --   pure [cps|
-  --     (make-closure (λ (#{env} ##{bs})
-  --                     (let #{upvalBinds}
-  --                       #{m}))
-  --                   ##{upvals})
-  --    |]
-  -- ExpApplyF f xs ->
-  --   pure [scm|
-  --     (apply-closure #{f} ##{xs})
-  --   |]
-
 closeProgram :: GenSym :> es => Program -> Eff es Program
 closeProgram = traverseOf #body close
-
-curriedadd :: Program
-curriedadd = [cps|
-  (letrec ((curried-add
-            (λ (n ktail1)
-              (letrec ((curried-add-in
-                        (λ (m ktail2)
-                          (prim (+ n m)
-                                (κ (x0) (continue ktail2 x0))))))
-                (continue ktail1 curried-add-in)))))
-    (letrec ((k0 (κ (adder) (adder 4 halt))))
-      (curried-add 5 k0)))
-|]
-
-square :: Program
-square = [cps|
-(letrec ((lambda-body0 (λ (x lambda-tail1)
-                (prim (* x x) (κ (r2) (continue lambda-tail1 r2))))))
-  (letrec
-    ((r3 (κ (x4) (continue halt x4))))
-    (lambda-body0 5 r3)))
-|]

src/Gyehoek/CPS/Convert.hs

@@ -9,16 +9,9 @@ import Gyehoek.CPS.Syntax
 import Gyehoek.Scheme.Syntax qualified as Scm
 import Gyehoek.GenSym
 import Data.List.NonEmpty (NonEmpty((:|)))
-import Effectful
 import Control.Monad.Cont qualified as Cont
-import Control.Lens
 import qualified Data.List.NonEmpty as NE
-import qualified Gyehoek.Sexp
-import Data.String.Interpolate (i)
-import Data.Functor (unzip)
-import Data.List (List)
-import Prelude hiding (unzip)
-import Debug.Pretty.Simple (pTraceShowMForceColor)
+import Gyehoek.Prelude
 
 
 -- 뻘짓이어라
@@ -109,8 +102,6 @@ convert (Scm.ExpLetRec bs m) k = do
     (letrec #{bs''} #{m'})
   |]
 
--- convert e k = error [i|unimplemented expr: #{e}|]
-
 convertLambda
   :: GenSym :> es
   => List Name -> Scm.Exp -> Eff es Lambda

src/Gyehoek/CPS/Eval.hs

@@ -5,24 +5,13 @@ module Gyehoek.CPS.Eval
   ) where
 
 import Gyehoek.CPS.Syntax
-import Data.String.Interpolate (i)
-import Data.HashMap.Strict (HashMap)
 import Control.Lens
 import Data.Maybe (fromMaybe)
-import Data.Generics.Labels ()
-import GHC.Generics (Generic)
-import Data.List (List)
 import Text.Show.Functions ()
 import qualified Data.HashMap.Strict as H
-import Debug.Pretty.Simple (pTraceShowId)
-import qualified Data.Text as T
+import Gyehoek.Prelude
 
 
-data Code
-  = CodeKap (List Obj -> List Obj)
-  | CodeLam (List Obj -> Name -> List Obj)
-  deriving (Show, Generic)
-
 data Env = MkEnv
   { vars :: HashMap Name Obj
   , labels :: HashMap Name (Env, Abs)
@@ -78,7 +67,7 @@ evalVal g = \case
 emptyEnv :: Env
 emptyEnv = MkEnv
   { vars = mempty
-  , labels = H.singleton "halt" $
+  , labels = H.singleton "halt"
     ( emptyEnv
     , AbsKappa' ["h0"] $ Halt [ValVar "h0"]
     )
@@ -86,22 +75,3 @@ emptyEnv = MkEnv
 
 evalProgram :: Program -> List Obj
 evalProgram (MkProgram e) = eval emptyEnv e
-
-curriedadd :: Program
-curriedadd = [cps|
-(letrec ((curried-add
-          (λ (n ktail1)
-            (letrec ((curried-add-in
-                      (λ (m ktail2)
-                        (prim (+ n m)
-                              (κ (x0) (continue ktail2 x0))))))
-              (continue ktail1 curried-add-in)))))
-  (letrec ((k0 (κ (adder) (adder 4 halt))))
-    (curried-add 5 k0)))
-|]
-
-idfn = [cps|
-        (letrec ((id (λ (x ktail)
-                       (continue ktail x))))
-          (id 456 halt))
-      |] :: Program

src/Gyehoek/CPS/Lower.hs

@@ -5,20 +5,15 @@
 {-# LANGUAGE MultilineStrings #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ApplicativeDo #-}
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 {-# LANGUAGE RecursiveDo #-}
 {- HLINT ignore "Use camelCase" -}
 module Gyehoek.CPS.Lower
   (lower, lowerProgram) where
 
 import Gyehoek.CPS.Syntax
-import Data.Generics.Labels ()
-import Effectful
-import Data.Text (Text)
 import Data.Vector.Strict (Vector)
 import Control.Lens hiding (op)
 import Numeric.Natural
-import GHC.Generics (Generic)
 import qualified Data.Vector.Strict as V
 import Gyehoek.Wasm qualified as Wasm
 import Gyehoek.Wasm hiding (Expr)
@@ -26,12 +21,9 @@ import Language.Sexp.Located qualified as SL
 import Control.Monad.Fix
 import qualified Gyehoek.Sexp
 import Data.Text qualified as T
-import Data.List qualified
 import Data.Foldable (fold)
-import Gyehoek.Sexp (encodeOrShow, toSexp)
-import Debug.Pretty.Simple
-import GHC.Stack (HasCallStack)
-import Data.String.Interpolate
+import Gyehoek.Sexp (encodeOrShow)
+import Gyehoek.Prelude
 
 
 data Env = MkEnv

src/Gyehoek/CPS/Stackify.hs

@@ -9,18 +9,12 @@ import Gyehoek.CPS.Syntax
 import Gyehoek.Stack.Syntax qualified as Stk
 import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
-import Effectful
 import Gyehoek.GenSym
 import Effectful.Writer.Static.Shared
-import Control.Lens
-import Data.String.Interpolate
-import Gyehoek.Stack.Syntax (Imm(..))
-import GHC.Generics (Generic)
 import Data.Foldable
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as H
-import Data.List (List, elemIndex)
-import GHC.Exts (IsList(fromList))
+import Data.List (elemIndex)
+import Gyehoek.Prelude
 
 
 type Stackify = Writer Stk.Program

src/Gyehoek/CPS/Syntax.hs

@@ -36,8 +36,6 @@ module Gyehoek.CPS.Syntax
   , pattern AbsKappa'
   , Abs(..)
   , Free(..)
-  , Vars(..)
-  , Subst(..)
   , pattern ValLabel
   , labelName -- don't like that this is part of the api
   )
@@ -45,32 +43,21 @@ module Gyehoek.CPS.Syntax
 
 import Language.SexpGrammar qualified as S
 import Gyehoek.Sexp qualified
-import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void, getName)
-import Data.List (List)
-import GHC.Generics (Generic)
-import Data.Generics.Labels ()
+import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void)
 import Language.SexpGrammar.Generic
 import Control.Category
-import Control.Lens hiding (op)
 import Prelude hiding ((.), id)
-import Data.List.NonEmpty (NonEmpty)
 import Language.Haskell.TH.Quote (QuasiQuoter)
-import Data.Data (Data)
 import Language.Sexp.Located (Sexp)
 import qualified Data.InvertibleGrammar.Base as IG
-import qualified Gyehoek.Scheme.Syntax as Gyehoek
 import Data.InvertibleGrammar.Base (type (:-)((:-)))
-import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
-import Data.Hashable (Hashable)
 import Data.Monoid (Endo)
-import Data.Containers.ListUtils (nubOrd)
 import Data.Functor.Foldable.TH
-import Data.Functor.Foldable (Recursive(..), Corecursive (..))
-import Control.DeepSeq (NFData)
 import qualified Gyehoek.Sexp as GS
 import qualified Language.Sexp.Located as SL
 import Data.Data.Lens (uniplate)
+import Gyehoek.Prelude hiding (op)
 
 -- Data types
 
@@ -385,52 +372,3 @@ instance Vars Exp where
   vars k (ExpPrim p kap) = ExpPrim <$> vars k p <*> pure kap
   vars k (ExpContinue kname xs) = ExpContinue <$> k kname <*> pure xs
   vars _ e = pure e
-
-
-
-data Scope
-  = Bind (List Name) (List Scope)
-  | Use (List Name) (List Scope)
-  deriving (Show, Eq)
-
-makeBaseFunctor ''Scope
-
-class Scoped a where
-  scope :: a -> Scope
-
-instance Scoped Kappa where
-  scope (MkKappa bs e) =
-    Bind bs [scope e]
-
-instance Scoped Lambda where
-  scope (MkLambda bs k e) = Bind (bs ++ [k]) [scope e]
-
-instance Scoped Abs where
-  scope = \case
-    AbsKappa k -> scope k
-    AbsLambda l -> scope l
-
-instance Scoped Val where
-  scope = \case
-    ValVar x -> Use [x] []
-    _ -> Use [] []
-
-instance Scoped Exp where
-  scope = \case
-    ExpApply f xs k ->
-      Use (((f:xs) ^.. each . _ValVar) ++ [k]) []
-    ExpLetRec bs e ->
-      Bind (bs ^.. each . _1) $
-        (bs ^.. each . _2 . to scope)
-        ++ [scope e]
-    ExpPrim p k ->
-      Use (p ^.. each . _ValVar) [scope k]
-    ExpContinue k xs ->
-      Use (k : (xs ^.. each . _ValVar)) []
-    ExpIf c t f ->
-      Use (c ^.. _ValVar) [ scope t, scope f ]
-
-
-
-class Subst a where
-  substWith :: (Name -> Maybe Val) -> a -> a

src/Gyehoek/Driver.hs

@@ -3,7 +3,6 @@ module Gyehoek.Driver
   where
 
 import Gyehoek.Options
-import Data.Text (Text)
 import Prelude hiding (readFile)
 import Options.Applicative
 import Control.Lens
@@ -23,21 +22,17 @@ import Gyehoek.CPS.Eval qualified as CPS
 import Control.Monad
 import Text.Pretty.Simple (pShowNoColor)
 import System.Process.Typed
-import Data.Text.Encoding (encodeUtf8)
 import System.Environment.Blank (getEnvDefault)
-import GHC.Conc (atomically)
 import qualified Data.Text.IO as TIO
 import qualified Data.ByteString.Lazy as BS
 import Gyehoek.CPS.Stackify (stackifyProgram)
-import Text.Pretty.Simple (pShow)
 import Gyehoek.Stack.VM (eval, writeObj, Obj)
 import qualified Data.Text as T
-import Data.List (List)
 import Gyehoek.Stack.Syntax qualified as Stk
-import Effectful.Exception
 import Gyehoek.CPS.Close (closeProgram)
 import Control.Lens.Extras (is)
 import Control.Arrow ((>>>))
+import Gyehoek.Prelude
 
 
 main :: IO ()

src/Gyehoek/Options.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE NoFieldSelectors #-}
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE RecordWildCards #-}
 module Gyehoek.Options
   ( Options(..)
   , Runtime(..)
@@ -6,14 +7,9 @@ module Gyehoek.Options
   )
   where
 
-import System.IO (Handle)
-import Data.HashSet (HashSet)
 import Options.Applicative
-import System.FilePath
-import qualified Data.HashSet as HS
-import Control.Lens hiding (argument)
-import GHC.Generics (Generic)
 import Data.Foldable
+import Gyehoek.Prelude hiding (argument)
 
 
 data Runtime = Stackify | Wasm | CPS
@@ -31,55 +27,35 @@ data Options = MkOptions
   }
   deriving (Show, Generic)
 
--- osPath :: ReadM _
--- osPath = eitherReader $
---   (_Left %~ show) . encodeUtf @(Either _)
-
--- parseDumpQBE =
---   optional $ strOption
---     ( long "dump-qbe"
---     <> metavar "FILE"
---     )
-
--- parseDumpANF =
---   optional $ strOption
---     ( long "dump-anf"
---     <> metavar "FILE"
---     )
-
-parseOutput = strOption
-    ( long "output"
-    <> short 'o'
-    <> metavar "FILE"
-    <> value "-"
-    )
-
-parseRuntime = option rdr . fold $
-  [ long "runtime"
-  , short 'R'
-  , value Nothing
-  ]
-  where
-    rdr = maybeReader \case
-      "stackify" -> Just (Just Stackify)
-      "wasm" -> Just (Just Wasm)
-      "cps" -> Just (Just CPS)
-      "none" -> Just Nothing
-      _ -> Nothing
-
-parseDumpClosed = switch (long "dump-closed")
-parseDumpCPS = switch (long "dump-cps")
-parseDumpStackified = switch (long "dump-stackified")
-parseDumpParsed = switch (long "dump-parsed")
-parseInspectWasm = switch $ long "inspect-wasm" <> short 'p'
+runtimeReader = maybeReader \case
+  "stackify" -> Just (Just Stackify)
+  "wasm" -> Just (Just Wasm)
+  "cps" -> Just (Just CPS)
+  "none" -> Just Nothing
+  _ -> Nothing
 
 parser :: Parser Options
-parser = MkOptions
-  <$> parseDumpClosed
-  <*> parseDumpCPS
-  <*> parseDumpParsed
-  <*> parseDumpStackified
-  <*> parseRuntime
-  <*> parseInspectWasm
-  <*> parseOutput
-  <*> argument str (metavar "FILE")
+parser = do
+  dumpClosed <- switch (long "dump-closed")
+  dumpCPS <- switch (long "dump-cps")
+  dumpStackified <- switch (long "dump-stackified")
+  dumpParsed <- switch (long "dump-parsed")
+  inspectWasm <- switch $ long "inspect-wasm" <> short 'p'
+  runtime <- option runtimeReader . fold $
+    [ long "runtime"
+    , short 'R'
+    , value (Just Stackify)
+    , completeWith ["stackify","wasm","cps","none"]
+    , showDefaultWith $ const "stackify"
+    ]
+  output <- strOption . fold $
+    [ long "output"
+    , short 'o'
+    , metavar "FILE"
+    , value "-"
+    ]
+  sourceFile <- argument str . fold $
+    [ metavar "FILE"
+    , action "file"
+    ]
+  pure $ MkOptions {..}

src/Gyehoek/Prelude.hs

@@ -0,0 +1,34 @@
+module Gyehoek.Prelude
+  ( module Control.Lens
+  , module Effectful
+  , module Data.Generics.Labels
+  , module Data.String.Interpolate
+  , Text
+  , List
+  , Generic
+  , Data
+  , NFData
+  , HashMap
+  , HashSet
+  , coerce
+  , IsList(fromList)
+  , HasCallStack
+  , Hashable
+  ) where
+
+import Control.Lens
+import Data.List (List)
+import Data.Text (Text)
+import Effectful (Eff, runEff, runPureEff, (:>))
+import GHC.Generics (Generic)
+import Data.Data (Data)
+import Control.DeepSeq (NFData)
+import Data.HashMap.Strict (HashMap)
+import Data.HashSet (HashSet)
+import Data.Coerce (coerce)
+import GHC.Exts (IsList(..))
+import Data.Generics.Labels ()
+import Data.String.Interpolate
+import GHC.Stack (HasCallStack)
+import Data.Hashable (Hashable)
+

src/Gyehoek/Scheme/Syntax.hs

@@ -35,27 +35,21 @@ module Gyehoek.Scheme.Syntax
   )
   where
 
-import Data.Text (Text)
-import Data.List (List, intersperse)
+import Data.List (intersperse)
 import Language.SexpGrammar
   ( SexpIso(..), list, el, rest, sym, symbol )
 import Language.SexpGrammar qualified as Sexp
 import Language.SexpGrammar.Generic
 import Effectful
-import GHC.Generics (Generic)
 import Prelude hiding ((.), id)
 import Control.Category
-import Data.List.NonEmpty (NonEmpty)
 import Gyehoek.Sexp qualified as GS
 import Gyehoek.GenSym (Gen)
 import Control.Lens
 import Data.Generics.Labels ()
 import Data.String (IsString)
-import Data.Hashable (Hashable)
-import Data.Data (Data)
 import Data.Functor.Foldable.TH (makeBaseFunctor)
 import Data.Functor.Foldable hiding (fold)
-import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
 import Data.Foldable (fold, toList)
 import Language.Haskell.TH.Quote (QuasiQuoter)
@@ -63,9 +57,8 @@ import Effectful.FileSystem (runFileSystem)
 import qualified Effectful.FileSystem.IO as FS
 import qualified Data.Text.Encoding as T
 import qualified Effectful.FileSystem.IO.ByteString as FB
-import Control.DeepSeq (NFData)
 import qualified Data.Set.Ordered as O
-import Data.Sequence (Seq)
+import Gyehoek.Prelude
 
 
 newtype Name = MkName { inner :: Text }

src/Gyehoek/Stack/Syntax.hs

@@ -18,24 +18,15 @@ module Gyehoek.Stack.Syntax
   ) where
 
 import Control.Lens
-import Data.List (List)
-import GHC.Generics (Generic)
-import Data.HashMap.Strict (HashMap)
-import Language.SexpGrammar (SexpIso, (>>>), (:-))
+import Language.SexpGrammar (SexpIso, (>>>))
 import Language.SexpGrammar qualified as S
 import Language.SexpGrammar.Generic
-import Data.Coerce (coerce)
-import Data.Text (Text)
 import qualified Gyehoek.Sexp
-import Language.Haskell.TH.Quote (QuasiQuoter)
-import Data.Data (Data)
-import qualified Data.HashMap.Strict as H
-import Effectful
 import Gyehoek.Scheme.Syntax (Name(..), Lit(..), Prim(..))
 import GHC.Exts (IsList(..))
 import Data.List (intersperse)
-import Control.DeepSeq (NFData)
 import Gyehoek.CPS.Syntax (Imm(..), Obj(..), Hob(..), labelName)
+import Gyehoek.Prelude
 
 
 newtype Program = MkProgram

src/Gyehoek/Stack/VM.hs

@@ -9,18 +9,10 @@ module Gyehoek.Stack.VM
   ) where
 
 import Gyehoek.Stack.Syntax
-import Data.List (List)
-import GHC.Generics (Generic)
 import Control.Lens
-import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
 import qualified Data.HashMap.Strict as H
-import Data.String.Interpolate (i)
-import Gyehoek.Scheme.Syntax (Sexp(..))
-import Debug.Pretty.Simple (pTraceShowIdForceColor)
-import qualified Data.List.NonEmpty as NE
-import Data.Functor (($>))
 import Data.List (unfoldr)
+import Gyehoek.Prelude
 
 
 data VM = MkVM