Start capturing values in lambdas (#54)

* Start capturing values in lambdas

* Sort of working, need to capture in struct though

* WIP

* Well, shit

* Just need to drop these fuckers

* Drop function when we're done

* good

wasm-calc12/src/Calc/Ability/Check.hs

@@ -157,6 +157,10 @@ abilityExpr (EBox ann a) = do
   -- we'll need to account for other allocations in future
   tell (S.singleton $ AllocateMemory ann)
   EBox ann <$> abilityExpr a
+abilityExpr (ELambda ann args ident body) = do
+  tell (S.singleton $ AllocateMemory ann)
+  ELambda ann args ident
+    <$> abilityExpr body
 abilityExpr (EConstructor ann constructor as) = do
   tell (S.singleton $ AllocateMemory ann)
   EConstructor ann constructor <$> traverse abilityExpr as

wasm-calc12/src/Calc/ExprUtils.hs

@@ -6,6 +6,7 @@ module Calc.ExprUtils
     bindExpr,
     mapExpr,
     getOuterPatternAnnotation,
+    monoidExpr,
   )
 where
 
@@ -94,3 +95,22 @@ getOuterPatternAnnotation (PTuple ann _ _) = ann
 getOuterPatternAnnotation (PLiteral ann _) = ann
 getOuterPatternAnnotation (PBox ann _) = ann
 getOuterPatternAnnotation (PConstructor ann _ _) = ann
+
+monoidExpr :: (Monoid m) => (Expr ann -> m) -> Expr ann -> m
+monoidExpr _ (EVar {}) = mempty
+monoidExpr _ (EPrim {}) = mempty
+monoidExpr f (ELet _ _ expr body) = f expr <> f body
+monoidExpr f (EMatch _ matchExpr pats) =
+  f matchExpr <> foldMap (f . snd) pats
+monoidExpr f (EInfix _ _ a b) = f a <> f b
+monoidExpr f (EIf _ p a b) = f p <> f a <> f b
+monoidExpr f (EApply _ fn args) = f fn <> foldMap f args
+monoidExpr f (ETuple _ a as) = f a <> foldMap f as
+monoidExpr f (EBox _ a) = f a
+monoidExpr f (EConstructor _ _ args) = foldMap f args
+monoidExpr f (EAnn _ _ a) = f a
+monoidExpr f (ELoad _ a) = f a
+monoidExpr f (EStore _ _ a) = f a
+monoidExpr f (ESet _ _ a) = f a
+monoidExpr f (EBlock _ a) = f a
+monoidExpr f (ELambda _ _ _ body) = f body

wasm-calc12/src/Calc/Wasm/FromExpr/Drops.hs

@@ -6,6 +6,7 @@ module Calc.Wasm.FromExpr.Drops
   ( DropPath (..),
     dropFunctionForType,
     addDropsFromPath,
+    dropInstructionForType,
     typeToDropPaths,
     createDropFunction,
     addDropsToWasmExpr,
@@ -20,6 +21,7 @@ import Calc.Wasm.FromExpr.Helpers
     genericArgName,
     getOffsetList,
     lookupIdent,
+    memorySize,
     scalarFromType,
   )
 import Calc.Wasm.FromExpr.Patterns (Path (..))
@@ -55,7 +57,7 @@ dropInstructionForType itemIdentifier ty =
   case ty of
     TVar _ typeVar -> do
       -- generics must have been passed in as function args
-      nat <- lookupIdent (genericArgName typeVar)
+      (nat, _) <- lookupIdent (genericArgName typeVar)
       pure (WApplyIndirect (WVar nat) [itemIdentifier])
     _ -> do
       -- generate a new fancy drop function
@@ -84,7 +86,7 @@ addDropsFromPath wholeExprIndex path = do
   case ty of
     TVar _ typeVar -> do
       -- generics must have been passed in as function args
-      nat <- lookupIdent (genericArgName typeVar)
+      (nat, _) <- lookupIdent (genericArgName typeVar)
       pure (WApplyIndirect (WVar nat) [wasmExpr])
     _ -> do
       pure $ WDrop wasmExpr
@@ -100,7 +102,7 @@ addDropsToWasmExpr drops wasmExpr =
   -- drop identifiers we will no longer need
   case drops of
     Just (DropIdentifiers idents) -> do
-      nats <- traverse (\(ident, ty) -> (,) <$> lookupIdent ident <*> pure ty) idents
+      nats <- traverse (\(ident, ty) -> (,) <$> (fst <$> lookupIdent ident) <*> pure ty) idents
       foldM
         ( \restExpr (index, ty) -> do
             dropWasm <- dropInstructionForType (WVar index) ty
@@ -135,6 +137,16 @@ typeToDropPaths ty@(TContainer _ tyItems) addPath = do
     )
 typeToDropPaths (TVar _ tyVar) addPath =
   pure [addPath (DropPathFetch (Just tyVar))]
+typeToDropPaths (TFunction ann _ _) addPath =
+  pure
+    [ addPath
+        ( DropPathSelect
+            (TPrim ann TInt32)
+            (memorySize Pointer)
+            (DropPathFetch Nothing)
+        ),
+      addPath (DropPathFetch Nothing)
+    ]
 typeToDropPaths _ _ = pure mempty
 
 typeVars :: Type ann -> S.Set TypeVar
@@ -154,7 +166,7 @@ dropFunctionForType ty =
   case ty of
     TVar _ typeVar -> do
       -- generics must have been passed in as function args
-      WVar <$> lookupIdent (genericArgName typeVar)
+      WVar . fst <$> lookupIdent (genericArgName typeVar)
     _ -> do
       dropFunc <- createDropFunction 1 ty
       WFunctionPointer <$> addGeneratedFunction dropFunc