Introduce dynamic fns

src/Concretize.hs

@@ -83,7 +83,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
       return (Left (DefinitionsMustBeAtToplevel xobj))
 
     -- | Fn / λ
-    visitList allowAmbig _ env (XObj (Lst [XObj (Fn _ _) fni fnt, args@(XObj (Arr argsArr) ai at), body]) i t) =
+    visitList allowAmbig _ env (XObj (Lst [XObj (Fn _ _ _) fni fnt, args@(XObj (Arr argsArr) ai at), body]) i t) =
       -- The basic idea of this function is to first visit the body of the lambda ("in place"),
       -- then take the resulting body and put into a separate function 'defn' with a new name
       -- in the global scope. That function definition will be set as the lambdas '.callback' in
@@ -158,7 +158,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
                                  modify (deleterDeps ++)
                                  modify (copyFn :)
                                  modify (copyDeps ++)
-                       return (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars)) fni fnt, args, okBody])
+                       return (Right [XObj (Fn (Just lambdaPath) (Set.fromList capturedVars) (FEnv env)) fni fnt, args, okBody])
            Left err ->
              return (Left err)
 
@@ -313,7 +313,7 @@ collectCapturedVars root = removeDuplicates (map toGeneralSymbol (visit root))
     visit xobj =
       case obj xobj of
         -- don't peek inside lambdas, trust their capture lists:
-        (Lst [XObj (Fn _ captures) _ _, _, _]) -> Set.toList captures
+        (Lst [XObj (Fn _ captures _ ) _ _, _, _]) -> Set.toList captures
         (Lst _) -> visitList xobj
         (Arr _) -> visitArray xobj
         (Sym path (LookupLocal Capture)) -> [xobj]
@@ -682,7 +682,7 @@ manageMemory typeEnv globalEnv root =
                                  return (XObj (Lst [defn, nameSymbol, args, okBody]) i t)
 
             -- Fn / λ
-            [fn@(XObj (Fn _ captures) _ _), args@(XObj (Arr argList) _ _), body] ->
+            [fn@(XObj (Fn _ captures _) _ _), args@(XObj (Arr argList) _ _), body] ->
               let Just funcTy@(FuncTy _ fnReturnType) = t
               in  do manage xobj -- manage inner lambdas but leave their bodies unvisited, they will be visited in the lifted version...
                      mapM_ unmanage captures

src/Emit.hs

@@ -200,7 +200,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                      return ""
 
             -- Fn / λ
-            [XObj (Fn name set) _ _, XObj (Arr argList) _ _, body] ->
+            [XObj (Fn name set _) _ _, XObj (Arr argList) _ _, body] ->
               do let retVar = freshVar i
                      capturedVars = Set.toList set
                      Just callback = name

src/Eval.hs

@@ -147,9 +147,9 @@ eval env xobj =
                    _ -> return (makeEvalError ctx Nothing ("`if` condition contains non-boolean value: " ++ pretty okCondition) (info okCondition))
                Left err -> return (Left err)
 
-        [XObj (Fn _ _) _ _, args@(XObj (Arr a) _ _), _] ->
+        [XObj (Fn b c _) d e, args@(XObj (Arr a) _ _), f] ->
             if all isUnqualifiedSym a
-            then return (Right listXObj)
+            then return (Right (XObj (Lst [XObj (Fn b c (FEnv env)) d e, args, f]) i t))
             else return (makeEvalError ctx Nothing ("`fn` requires all arguments to be unqualified symbols, but it got `" ++ pretty args ++ "`") (info xobj))
 
         [defnExpr@(XObj Defn _ _), name, args@(XObj (Arr a) _ _), body] ->
@@ -303,6 +303,15 @@ eval env xobj =
 
         f:args -> do evaledF <- eval env f
                      case evaledF of
+                       Right (XObj (Lst [XObj (Fn _ _ (FEnv e)) _ _, XObj (Arr params) _ _, body]) _ _) -> do
+                         case checkMatchingNrOfArgs ctx fppl f params args of
+                           Left err -> return (Left err)
+                           Right () ->
+                             do evaledArgs <- fmap sequence (mapM (eval env) args)
+                                case evaledArgs of
+                                  Right okArgs -> apply e body params okArgs
+                                  Left err -> return (Left err)
+
                        Right (XObj (Lst [XObj Dynamic _ _, _, XObj (Arr params) _ _, body]) _ _) ->
                          case checkMatchingNrOfArgs ctx fppl f params args of
                            Left err -> return (Left err)

src/GenerateConstraints.hs

@@ -32,7 +32,7 @@ genConstraints typeEnv root = fmap sort (gen root)
                              genF xobj args body
 
                            -- Fn
-                           [XObj (Fn _ _) _ _, XObj (Arr args) _ _, body] ->
+                           [XObj (Fn _ _ _) _ _, XObj (Arr args) _ _, body] ->
                              genF xobj args body
 
                            -- Def

src/InitialTypes.hs

@@ -79,7 +79,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                        (InterfaceSym _)   -> visitInterfaceSym env xobj
                        Defn               -> return (Left (InvalidObj Defn xobj))
                        Def                -> return (Left (InvalidObj Def xobj))
-                       e@(Fn _ _)         -> return (Left (InvalidObj e xobj))
+                       e@(Fn _ _ _)       -> return (Left (InvalidObj e xobj))
                        Let                -> return (Left (InvalidObj Let xobj))
                        If                 -> return (Left (InvalidObj If xobj))
                        While              -> return (Left (InvalidObj While xobj))
@@ -178,7 +178,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
         XObj Defn _ _ : _  -> return (Left (InvalidObj Defn xobj))
 
         -- Fn
-        [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body] ->
+        [fn@(XObj (Fn _ _ _) _ _), XObj (Arr argList) argsi argst, body] ->
           do (argTypes, returnType, funcScopeEnv) <- getTys env argList
              let funcTy = Just (FuncTy argTypes returnType)
              visitedBody <- visit funcScopeEnv body
@@ -188,8 +188,8 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                          let final = XObj (Lst [fn, XObj (Arr okArgs) argsi argst, okBody]) i funcTy
                          return final --(trace ("FINAL: " ++ show final) final)
 
-        [XObj (Fn _ _) _ _, XObj (Arr _) _ _] -> return (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed?
-        XObj fn@(Fn _ _) _ _ : _  -> return (Left (InvalidObj fn xobj))
+        [XObj (Fn _ _ _ ) _ _, XObj (Arr _) _ _] -> return (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed?
+        XObj fn@(Fn _ _ _) _ _ : _  -> return (Left (InvalidObj fn xobj))
 
         -- Def
         [def@(XObj Def _ _), nameSymbol, expression]->

src/Obj.hs

@@ -57,7 +57,7 @@ data Obj = Sym SymPath SymbolMode
          | Dict (Map.Map XObj XObj)
          | Defn
          | Def
-         | Fn (Maybe SymPath) (Set.Set XObj) -- the name of the lifted function, and the set of variables this lambda captures
+         | Fn (Maybe SymPath) (Set.Set XObj) FnEnv -- the name of the lifted function, the set of variables this lambda captures, and a dynamic environment
          | Do
          | Let
          | While
@@ -270,7 +270,7 @@ pretty = visit 0
             Bol b -> if b then "true" else "false"
             Defn -> "defn"
             Def -> "def"
-            Fn _ captures -> "fn" ++ " <" ++ joinWithComma (map getName (Set.toList captures)) ++ ">"
+            Fn _ captures _ -> "fn" ++ " <" ++ joinWithComma (map getName (Set.toList captures)) ++ ">"
             If -> "if"
             Match -> "match"
             While -> "while"
@@ -438,6 +438,14 @@ data Env = Env { envBindings :: Map.Map String Binder
                , envFunctionNestingLevel :: Int -- Normal defn:s have 0, lambdas get +1 for each level of nesting
                } deriving (Show, Eq)
 
+-- Could be (Maybe Env), but we have to get rid of equality
+data FnEnv = None
+           | FEnv Env
+  deriving (Show)
+
+instance Eq FnEnv where
+  _ == _ = True
+
 newtype TypeEnv = TypeEnv { getTypeEnv :: Env }
 
 instance Show TypeEnv where

src/Parsing.hs

@@ -228,7 +228,7 @@ symbol = do i <- createInfo
                 -- TODO: What about the other def- forms?
                 "do" -> return (XObj Do i Nothing)
                 "while" -> return (XObj While i Nothing)
-                "fn" -> return (XObj (Fn Nothing Set.empty) i Nothing)
+                "fn" -> return (XObj (Fn Nothing Set.empty None) i Nothing)
                 "let" -> return (XObj Let i Nothing)
                 "break" -> return (XObj Break i Nothing)
                 "if" -> return (XObj If i Nothing)

src/Qualify.hs

@@ -37,7 +37,7 @@ setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [defn@(XObj Defn _ _),
       functionEnv = Env Map.empty (Just envWithSelf) Nothing [] InternalEnv 0
       envWithArgs = foldl' (\e arg@(XObj (Sym (SymPath _ argSymName) _) _ _) -> extendEnv e argSymName arg) functionEnv argsArr
   in  XObj (Lst [defn, sym, args, setFullyQualifiedSymbols typeEnv globalEnv envWithArgs body]) i t
-setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [fn@(XObj (Fn _ _) _ _),
+setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [fn@(XObj (Fn _ _ _) _ _),
                                                  args@(XObj (Arr argsArr) _ _),
                                                  body])
                                       i t) =