lowerslop

app/Gyehoek/CPS/Convert.hs

@@ -45,6 +45,3 @@ convert (Scm.ExpApply f xs) k =
     pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
 
 convert _ k = _
-
-halt :: Applicative f => Val -> f Exp
-halt = pure . ExpApply (ValVar "halt") . pure

app/Gyehoek/CPS/Lower.hs

@@ -1,9 +1,13 @@
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE TypeFamilies #-}
 module Gyehoek.CPS.Lower
   ( lower
   ) where
 
 import Gyehoek.CPS.Syntax
+import Data.Generics.Labels
 import Gyehoek.Scheme.Syntax qualified as Scm
 import Gyehoek.GenSym
 import Data.List.NonEmpty (NonEmpty((:|)))
@@ -14,6 +18,9 @@ import Data.Text (Text)
 import Data.Vector.Strict (Vector)
 import Control.Lens
 import Data.Foldable
+import Data.HashMap.Strict (HashMap)
+import Numeric.Natural
+import GHC.Generics (Generic)
 
 
 type Emit = Writer (Vector Text)
@@ -21,5 +28,37 @@ type Emit = Writer (Vector Text)
 runEmit :: Eff (Emit : es) a -> Eff es (a, Text)
 runEmit = (mapped . _2 %~ fold) . runWriter
 
-lower :: Exp -> Eff _ _
+data Env = MkEnv { vars :: HashMap Name Natural }
-lower = _
+  deriving (Show, Generic)
+
+type instance Index Env = Name
+type instance IxValue Env = Natural
+
+instance Ixed Env where
+
+instance At Env where
+  at i = #vars . at i
+
+
+
+-- countLocals :: Exp -> Int
+
+-- countLocals (ExpPrim p rs es) = length rs + sumOf (each . to countLocals) es
+
+-- countLocals (ExpFix bs e) =
+--   sumOf (each . _2 . _MkKappa . ((_1 . each . to (const 1))
+--                                  <> (_2 . to countLocals))) bs
+--   + countLocals e
+
+-- countLocals (ExpApply _ _) = 0
+
+
+
+lowerVal :: Env -> Val -> Vector Text
+lowerVal g (ValVar x) = _
+
+lower :: Env -> Exp -> Vector Text
+
+lower g (Halt _) = []
+
+lower g (ExpPrim p rs es) = _

app/Gyehoek/CPS/Syntax.hs

@@ -1,10 +1,17 @@
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE TemplateHaskell #-}
 module Gyehoek.CPS.Syntax
   ( Val(..)
   , Kappa(..)
   , Exp(..)
   , Name(..)
   , Prim(..)
+  , pattern Halt
+  , pattern Halt1
+  , _MkKappa
+  , _ExpPrim
+  , _ExpFix
+  , _ExpApply
   )
   where
 
@@ -16,6 +23,7 @@ import Data.List (List)
 import GHC.Generics (Generic)
 import Language.SexpGrammar.Generic
 import Control.Category
+import Control.Lens
 import Data.Text qualified as T
 import Data.Generics.Labels
 import Prelude hiding ((.), id)
@@ -38,6 +46,15 @@ data Exp
   | ExpApply Val (List Val)
   deriving (Show, Generic)
 
+pattern Halt :: List Val -> Exp
+pattern Halt xs = ExpApply (ValVar "halt") xs
+
+pattern Halt1 :: Val -> Exp
+pattern Halt1 x = ExpApply (ValVar "halt") [x]
+
+makePrisms ''Kappa
+makePrisms ''Exp
+
 
 -- SexpIso instances
 

app/Gyehoek/Scheme/Syntax.hs

@@ -28,10 +28,11 @@ import Gyehoek.Sexp qualified
 import Gyehoek.GenSym (Gen)
 import Control.Lens (Each)
 import Data.String (IsString)
+import Data.Hashable (Hashable)
 
 
 newtype Name = MkName { getName :: Text }
-  deriving newtype (Show, Eq, IsString, Gen)
+  deriving newtype (Show, Eq, IsString, Gen, Hashable)
   deriving stock (Generic)
 
 data Prim e

gyehoek.cabal

@@ -54,6 +54,7 @@ executable gyehoek
     , effectful-plugin
     , filepath
     , generic-lens
+    , hashable
     , invertible-grammar
     , lens
     , megaparsec