Implement let

6 files changed, 79 insertions, 38 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 978cafc..84e95d2 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -4,6 +4,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import System.Console.Haskeline
 import Types
+import Builtins
 import Lib
 
 parseArgs :: Config -> [String] -> Config
@@ -17,17 +18,19 @@ parseArgs config args =
             config { configShowHelp = True } rest
         _ -> config
 
-repl :: Config -> InputT IO ()
-repl config = do
+repl :: Config -> Env -> InputT IO ()
+repl config env = do
     minput <- getInputLine "> "
     case minput of
         Nothing -> return ()
         Just input -> do
-            result <- lift $ runExceptT $ runReaderT (runInlineScript input) config
+            result <- lift $ runExceptT $ runReaderT (runInlineScript env input) config
             case result of
-                Left (LException ex) -> outputStrLn $ "Error: " ++ ex
-                Right () -> return ()
-            repl config
+                Left (LException ex) -> do
+                    outputStrLn $ "Error: " ++ ex
+                    repl config env
+                Right newEnv -> do
+                    repl config newEnv
 
 main :: IO ()
 main = do
@@ -53,12 +56,12 @@ main = do
 
         case (configScriptFileName config) of
             Just scriptFileName -> do
-                result <- runExceptT $ runReaderT (runScriptFile scriptFileName) config
+                result <- runExceptT $ runReaderT (runScriptFile builtinEnv scriptFileName) config
                 case result of
                     Left (LException ex) -> putStrLn $ "Error: " ++ ex
-                    Right () -> return ()
+                    Right _ -> return ()
             Nothing -> do
                 putStrLn $ "Lang REPL"
                 putStrLn $ "Use CTRL+D to exit"
-                runInputT defaultSettings (repl config)
+                runInputT defaultSettings (repl config builtinEnv)
     return ()
diff --git a/examples/spec.lisp b/examples/spec.lisp
index 2d870a3..4f4d303 100644
--- a/examples/spec.lisp
+++ b/examples/spec.lisp
@@ -65,7 +65,7 @@
 (let map (\[f lst]
     (match lst
         [] []
-        (prep (f head lst) (map f (tail lst))))))
+        (prepend (f head lst) (map f (tail lst))))))
 
 (print!
     (map (sum2 1) [1 2 3]))
diff --git a/examples/test.lisp b/examples/test.lisp
index b41007d..3b9fa5e 100644
--- a/examples/test.lisp
+++ b/examples/test.lisp
@@ -1,11 +1,15 @@
-(sum2 1 (
-    sum2 2 3
-)) ; test1
-;; (sum2   ; test2
-;;     1
-;;     2  )
-;; "string with space"
-;; "another \n\"string\""
-;; (let id
-;;     (\[a] a))
-(\[x] (\[y] (sum2 x y)))
\ No newline at end of file
+;; (let map (\[f lst]
+;;     (match lst
+;;         [] []
+;;         (prepend (f head lst) (map f (tail lst))))))
+
+;; (map (+ 1) [1 2 3])
+
+(let mapinc (\[vec]
+    (match vec
+        [] []
+        (prepend
+            (+ 1 (head vec))
+            (mapinc (tail vec))))))
+(env)
+(mapinc [1 2 3])
diff --git a/src/Builtins.hs b/src/Builtins.hs
index 71401d8..1c1dd1b 100644
--- a/src/Builtins.hs
+++ b/src/Builtins.hs
@@ -9,7 +9,8 @@ builtinEnv = M.fromList [
     ("+", builtinAdd2),
     ("-", builtinSubtract2),
     ("head", builtinHead),
-    ("tail", builtinTail)
+    ("tail", builtinTail),
+    ("prepend", builtinPrepend)
     ]
 
 builtinAdd2 :: AST
@@ -46,4 +47,13 @@ builtinTail =
             (ASTVector vec) <- assertIsASTVector ast
             when (length vec == 0) $ throwError $ LException $ "tail of empty vector"
             return $ ASTVector $ tail vec
+     in ASTFunction outer
+
+builtinPrepend :: AST
+builtinPrepend =
+    let outer ast1 = do
+            let inner ast2 = do
+                    (ASTVector vec) <- assertIsASTVector ast2
+                    return $ ASTVector $ ast1 : vec
+            return $ ASTFunction $ inner
      in ASTFunction outer
\ No newline at end of file
diff --git a/src/Lib.hs b/src/Lib.hs
index 8ad4866..0f81331 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -158,7 +158,8 @@ makeUserDefFn env (ASTSymbol param) body =
     let fn :: AST -> LContext AST
         fn arg = do
             let newBody = traverseAndReplace param arg body
-            evaluate env newBody
+            (_, ret) <- evaluate env newBody
+            return ret
      in fn
 makeUserDefFn _ _ _ = error $ "unreachable: makeUserDefFn"
 
@@ -174,7 +175,7 @@ curriedMakeUserDefFn env ((ASTSymbol param):rest) body =
      in fn
 curriedMakeUserDefFn _ _ _ = error $ "unreachable: curriedMakeUserDefFn"
 
-evaluate :: Env -> AST -> LContext AST
+evaluate :: Env -> AST -> LContext (Env, AST)
 evaluate env (ASTFunctionCall (first:args))
     | first == ASTSymbol "\\" = do
         (arg1, arg2) <- case args of
@@ -185,7 +186,7 @@ evaluate env (ASTFunctionCall (first:args))
         -- when (length params == 0) $ throwError $ LException $ "Function must have > 0 parameters"
         body <- assertIsASTFunctionCall arg2
         let fn = curriedMakeUserDefFn env params body
-        return $ ASTFunction fn
+        return $ (env, ASTFunction fn)
     | first == ASTSymbol "match" = do
         (cond, rest) <- case args of
                 [] -> throwError $ LException $ "match called with no arguments"
@@ -209,26 +210,48 @@ evaluate env (ASTFunctionCall (first:args))
                 case M.lookup evaledCond caseMap of
                     Just branch -> evaluate env branch
                     Nothing -> evaluate env defaultBranch
+    | first == ASTSymbol "let" = do
+        (symbol, value) <- case args of
+                [ASTSymbol symbol', value'] -> do
+                    (_, evaledValue) <- evaluate env value'
+                    return (symbol', evaledValue)
+                [ASTSymbol "lazy", ASTSymbol symbol', value'] -> do
+                    return (symbol', value')
+                other -> throwError $ LException $ "let called with invalid args " ++ show other
+        when (M.member symbol env) $ throwError $ LException $ "symbol already defined: " ++ symbol
+        let newEnv = M.insert symbol value env
+        return $ (newEnv, ASTUnit)
+    | first == ASTSymbol "env" = do
+        liftIO $ putStrLn $ show env
+        return (env, ASTUnit)
     | otherwise = do
-        fnEvaled <- evaluate env first
+        (_, fnEvaled) <- evaluate env first
         (ASTFunction fn) <- assertIsASTFunction fnEvaled
-        evaledArgs <- mapM (evaluate env) args
+        evaledArgs' <- mapM (evaluate env) args
+        let evaledArgs = map (\(_, a) -> a) evaledArgs'
         result <- curryCall (reverse evaledArgs) fn
-        return result
+        return (env, result)
 evaluate env (ASTSymbol sym) = do
     let val = M.lookup sym env
     case val of
-        Just ast -> return ast
+        Just ast -> return (env, ast)
         Nothing -> throwError $ LException $ "Symbol " ++ sym ++ " not defined in environment"
-evaluate _ ast = return ast
+evaluate env ast = return (env, ast)
 
-runScriptFile :: String -> LContext ()
-runScriptFile fileName = do
+runScriptFile :: Env -> String -> LContext Env
+runScriptFile env fileName = do
     src <- liftIO $ readFile fileName
-    runInlineScript src
+    runInlineScript env src
 
-runInlineScript :: String -> LContext ()
-runInlineScript src = do
+evalParsed :: Env -> [AST] -> LContext (Env, [AST])
+evalParsed env [] = return (env, [])
+evalParsed env (ast:rest) = do
+    (newEnv, newAst) <- evaluate env ast
+    (retEnv, restEvaled) <- evalParsed newEnv rest
+    return $ (retEnv, newAst : restEvaled)
+
+runInlineScript :: Env -> String -> LContext Env
+runInlineScript env src = do
     tokenized <- tokenize src
     config <- ask
     when (configVerboseMode config) $ liftIO $ putStrLn $ "tokenized:\t\t" ++ show tokenized
@@ -236,5 +259,6 @@ runInlineScript src = do
     when (configVerboseMode config) $ do
         let output = "parsed:\t\t\t" ++ (map show parsed $> L.intercalate "\n\t\t\t")
         liftIO $ putStrLn output
-    evaluated <- mapM (evaluate builtinEnv) parsed
+    (newEnv, evaluated) <- evalParsed env parsed
     liftIO $ mapM_ putStrLn (map show evaluated)
+    return newEnv
diff --git a/src/Types.hs b/src/Types.hs
index 9953882..515910b 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -16,6 +16,8 @@ data Config = Config {
 
 type LContext a = ReaderT Config (ExceptT LException IO) a
 
+type Env = M.Map String AST
+
 data AST
     = ASTInteger Int
     | ASTDouble Double
@@ -87,5 +89,3 @@ assertIsASTFunctionCall :: AST -> LContext AST
 assertIsASTFunctionCall ast = case ast of
     (ASTFunctionCall _) -> return ast
     _ -> throwError $ LException $ show ast ++ " is not a function call or body"
-
-type Env = M.Map String AST