wip: abstract stack/continuation machine

src/Gyehoek/Scheme/Syntax.hs

@@ -23,6 +23,8 @@ module Gyehoek.Scheme.Syntax
   , subst
   , getName
   , scm
+  , readExp
+  , readProgram
   )
   where
 
@@ -33,6 +35,7 @@ import Language.SexpGrammar
 import Language.SexpGrammar qualified as Sexp
 import Language.Sexp.Located qualified as S
 import Language.SexpGrammar.Generic
+import Effectful
 import GHC.Generics
 import Prelude hiding ((.), id)
 import Control.Category
@@ -49,6 +52,10 @@ import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
 import Data.Foldable (fold)
 import Language.Haskell.TH.Quote (QuasiQuoter)
+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
 
 
 newtype Name = MkName { inner :: Text }
@@ -72,7 +79,8 @@ data Prim e
   | PrimWrite e
   | PrimZeroP e
   | PrimNewline
-  | PrimMakeClosure { code :: e, upvals :: List e }
+  | PrimMakeClosure { code :: e, env :: List e }
+  | PriEnvRef e Int
   deriving (Show, Generic, Functor, Foldable, Traversable, Data, Eq)
 
 instance Each (Prim e) (Prim e') e e'
@@ -157,6 +165,7 @@ primSexpIso namefn a = match
     $ With (. unop "zero?")
     $ With (. nullop "newline")
     $ With (. mkclosure)
+    $ With (. envref)
     $ End
     where
       idn s = el (sym (namefn s))
@@ -164,6 +173,7 @@ primSexpIso namefn a = match
       unop s = list $ idn s >>> el a
       binop s = list $ idn s >>> el a >>> el a
       mkclosure = list $ idn "make-closure" >>> el a >>> rest a
+      envref = list $ idn "env-ref" >>> el a >>> el Sexp.int
 
 instance SexpIso a => SexpIso (Prim a) where
   -- sexpIso = primSexpIso ("prim:"<>) sexpIso
@@ -259,3 +269,22 @@ subst f = \e -> cata go e mempty where
   go (ExpLetF _ _) _ = error "todo lol"
   go (ExpLambdaF bs e) bound = e $ insertFrom bs bound
   go e bound = embed $ fmap ($ bound) e
+
+
+
+fileName :: FilePath -> FilePath
+fileName "-" = "<interactive>"
+fileName e = e
+
+hGetContents :: FS.FileSystem :> es => FS.Handle -> Eff es Text
+hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
+
+readProgram :: IOE :> es => FilePath -> Eff es Program
+readProgram fp = runFileSystem $
+  FS.withFile fp FS.ReadMode $ \h ->
+    Gyehoek.Sexp.parseSexps @CommandOrDef (fileName fp) <$> hGetContents h
+     >>= either error (pure . MkProgram)
+
+readExp :: IOE :> es => FilePath -> Eff es Program
+readExp fp = readProgram fp <&>
+  (^?! (#commandsAndDefs . _head . _Comm))