Add let bindings to Syntax.

semantic-analysis/src/Analysis/Syntax.hs

@@ -32,7 +32,7 @@ module Analysis.Syntax
 import           Analysis.Effect.Domain
 import           Analysis.Effect.Env (Env, bind)
 import           Analysis.Effect.Store
-import           Analysis.Name (Name)
+import           Analysis.Name (Name, formatName)
 import           Control.Applicative (Alternative(..), liftA3)
 import           Control.Effect.Labelled
 import           Control.Monad (guard)
@@ -41,6 +41,7 @@ import qualified Data.Aeson.Internal as A
 import qualified Data.Aeson.Parser as A
 import qualified Data.Aeson.Types as A
 import qualified Data.ByteString.Lazy as B
+import           Data.Foldable (foldl')
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
 import           Data.Text (Text, pack, unpack)
@@ -55,6 +56,8 @@ class Syntax rep where
 
   throw :: rep -> rep
 
+  let_ :: Name -> rep -> (rep -> rep) -> rep
+
 
 -- Pretty-printing
 
@@ -78,6 +81,8 @@ instance Syntax Print where
 
   throw e = parens (str "throw" <+> e)
 
+  let_ n v b = parens (str "let" <+> name n <+> char '=' <+> v <+> str "in" <+> b (name n))
+
 str :: String -> Print
 str = Print . showString
 
@@ -95,6 +100,9 @@ l <+> r = l <> char ' ' <> r
 
 infixr 6 <+>
 
+name :: Name -> Print
+name = text . formatName
+
 
 -- Abstract interpretation
 
@@ -117,6 +125,10 @@ instance (Has (Env addr) sig m, HasLabelled Store (Store addr val) sig m, Has (D
 
   throw e = Interpret (\ eval -> eval e >>= ddie)
 
+  let_ n v b = Interpret (\ eval -> do
+    v' <- eval v
+    let' n v' (eval (b (Interpret (pure (pure v'))))))
+
 
 -- Macro-expressible syntax