Listes, Strings, et function en variable

LobsterLang/LobsterLang.cabal

@@ -32,6 +32,7 @@ library
       Scope
       SExpr
       Stack
+      Utils
       Vm
   other-modules:
       Paths_LobsterLang
@@ -63,7 +64,6 @@ test-suite LobsterLang-test
   main-is: Spec.hs
   other-modules:
       AstEvalSpec
-      ParseSpec
       VmSpec
       Paths_LobsterLang
   autogen-modules:

LobsterLang/src/AST.hs

@@ -10,8 +10,10 @@ module AST (Ast(..)) where
 -- | Abstract syntax tree for representing instructions
 data Ast = Define String Ast
         | Value Int
-        | Symbol String
         | Boolean Bool
+        | String String
+        | List [Ast]
+        | Symbol String (Maybe [Ast])
         | Call String [Ast]
         | FunctionValue [String] Ast (Maybe [Ast])
         | Cond Ast Ast (Maybe Ast)

LobsterLang/src/AstEval.hs

@@ -30,7 +30,7 @@ sexprToAst (SExpr.List _) = Nothing
 sexprToAst (SExpr.Value i) = Just (AST.Value i)
 sexprToAst (SExpr.Symbol "true") = Just (Boolean True)
 sexprToAst (SExpr.Symbol "false") = Just (Boolean False)
-sexprToAst (SExpr.Symbol s) = Just (AST.Symbol s)
+sexprToAst (SExpr.Symbol s) = Just (AST.Symbol s Nothing)
 
 -- | Evaluate a 'Ast'.
 -- Takes a stack representing variables and the Ast to evaluate.
@@ -39,15 +39,16 @@ sexprToAst (SExpr.Symbol s) = Just (AST.Symbol s)
 -- or a 'String' containing the error message in case of error
 -- and the stack after evaluation.
 evalAst :: [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
-evalAst stack (Define s (FunctionValue params ast Nothing)) =
-  (Right Nothing, addFuncToScope stack s params ast)
-evalAst stack (Define s v) = (Right Nothing, addVarToScope stack s v)
+evalAst stack (Define s v) = case getVarInScope stack s of
+  Nothing -> (Right Nothing, addVarToScope stack s v)
+  Just _ -> (Right Nothing, updateVar stack s v)
 evalAst stack (AST.Value i) = (Right (Just (AST.Value i)), stack)
-evalAst stack (AST.Symbol s) =
-  maybe
-    (Left ("Variable '" ++ s ++ "' doesn't exist"), stack)
-    (evalAst stack)
-    (getVarInScope stack s)
+evalAst stack (AST.Symbol s asts) = case getVarInScope stack s of
+  Nothing -> (Left ("Symbol '" ++ s ++ "' doesn't exist in the current or global scope"), stack)
+  Just (FunctionValue params ast Nothing) -> evalAst stack (FunctionValue params ast asts)
+  Just value -> evalAst stack value
+evalAst stack (AST.List l) = (Right (Just (AST.List l)), stack)
+evalAst stack (AST.String str) = (Right (Just (AST.String str)), stack)
 evalAst stack (Boolean b) = (Right (Just (Boolean b)), stack)
 evalAst stack (Call "+" astList) = evalBiValOp (+) stack (Call "+" astList)
 evalAst stack (Call "-" astList) = evalBiValOp (-) stack (Call "-" astList)
@@ -69,24 +70,35 @@ evalAst stack (Call "!" [AST.Boolean b]) = (Right (Just (AST.Boolean (not b))),
 -- TODO: add ! support for evaluation of sub parameters
 evalAst stack (Call "!" [_]) = (Left "Parameter of unary operator '!' isn't a boolean", stack)
 evalAst stack (Call "!" _) = (Left "Invalid number of parameter for unary operator '!'", stack)
-evalAst stack (Call name params) = case evalSubParams stack params of
+evalAst stack (Call "@" [ast]) = case astToString stack ast of
   Left err -> (Left err, stack)
-  Right asts -> case maybe (Left ("No evaluation in one or more parameters of '" ++ name ++ "'"), stack) (callFunc stack name) asts of
-    (Left err', _) -> (Left err', stack)
-    (Right fAst, newStack) -> maybe
-      (Left ("Function '" ++ name ++ "' doesn't exist"), stack)
-      (Data.Bifunctor.second clearScope . evalAst newStack)
-      fAst
-evalAst stack (FunctionValue _ _ Nothing) = (Right Nothing, stack) -- TODO: will change when function are treated as variables
+  Right ast' -> (Right (Just ast'), stack)
+evalAst stack (Call "@" (_ : _)) = (Left "Too much parameters for string conversion", stack)
+evalAst stack (Call "@" []) = (Left "Not enough parameters for string conversion", stack)
+evalAst stack (Call "++" astList) = evalBiListOp (\l el -> l ++ [el]) stack (Call "++" astList)
+evalAst stack (Call "--" astList) = evalBiListOp (\l el -> filter (/= el) l) stack (Call "++" astList)
+evalAst stack (Call "!!" astList) = case getElemInAstList stack (Call "!!" astList) of
+  Left err -> (Left err, stack)
+  Right ast' -> (Right (Just ast'), stack)
+evalAst stack (Call "len" astList) = evalUnListOp (AST.Value . length) stack (Call "len" astList)
+evalAst stack (Call unknown _) = (Left ("Unknown operator: " ++ unknown), stack)
+evalAst stack (FunctionValue params ast Nothing) =
+  (Right (Just (FunctionValue params ast Nothing)), stack)
 evalAst stack (FunctionValue params ast (Just asts))
-  | length params /= length asts = (Left ("Lambda takes " ++
-    show (length params) ++ " parameters, got " ++
-    show (length asts)), stack)
+  | length params /= length asts =
+      ( Left
+          ( "Expression takes "
+              ++ show (length params)
+              ++ " parameters, got "
+              ++ show (length asts)
+          ),
+        stack
+      )
   | otherwise = case evalSubParams stack asts of
-  Left err -> (Left err, stack)
-  Right mEAsts -> case mEAsts of
-    Nothing -> (Left "No evaluation in one or more parameters of lambda", stack)
-    Just eAsts -> Data.Bifunctor.second clearScope (evalAst (addVarsToScope (beginScope stack) params eAsts) ast)
+      Left err -> (Left err, stack)
+      Right mEAsts -> case mEAsts of
+        Nothing -> (Left "No evaluation in one or more parameters of expression", stack)
+        Just eAsts -> Data.Bifunctor.second clearScope (evalAst (addVarsToScope (beginScope stack) params eAsts) ast)
 evalAst stack (Cond (AST.Boolean b) a1 (Just a2))
   | b = evalAst stack a1
   | otherwise = evalAst stack a2
@@ -111,6 +123,12 @@ evalAst stack (Cond ast a1 a2) = case fst (evalAst stack ast) of
 evalBiValOp :: (Int -> Int -> Int) -> [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
 evalBiValOp _ stack (Call op [AST.Boolean _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiValOp _ stack (Call op [_, AST.Boolean _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [AST.String _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [_, AST.String _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [AST.List _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [_, AST.List _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [AST.FunctionValue _ _ Nothing, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiValOp _ stack (Call op [_, AST.FunctionValue _ _ Nothing]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiValOp f stack (Call _ [AST.Value a, AST.Value b]) =
   (Right (Just (AST.Value (f a b))), stack)
 evalBiValOp _ stack (Call op [ast1, ast2]) = case evalSubParams stack [ast1, ast2] of
@@ -134,6 +152,12 @@ evalBiValOp _ stack _ = (Left "Ast isn't a Call", stack)
 evalBiBoolOp :: (Bool -> Bool -> Bool) -> [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
 evalBiBoolOp _ stack (Call op [AST.Value _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiBoolOp _ stack (Call op [_, AST.Value _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [AST.String _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [_, AST.String _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [AST.List _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [_, AST.List _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [AST.FunctionValue _ _ Nothing, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiBoolOp _ stack (Call op [_, AST.FunctionValue _ _ Nothing]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiBoolOp f stack (Call _ [AST.Boolean a, AST.Boolean b]) =
   (Right (Just (AST.Boolean (f a b))), stack)
 evalBiBoolOp _ stack (Call op [ast1, ast2]) = case evalSubParams stack [ast1, ast2] of
@@ -157,6 +181,12 @@ evalBiBoolOp _ stack _ = (Left "Ast isn't a Call", stack)
 evalBiCompValOp :: (Int -> Int -> Bool) -> [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
 evalBiCompValOp _ stack (Call op [AST.Boolean _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiCompValOp _ stack (Call op [_, AST.Boolean _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [AST.String _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [_, AST.String _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [AST.List _, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [_, AST.List _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [AST.FunctionValue _ _ Nothing, _]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiCompValOp _ stack (Call op [_, AST.FunctionValue _ _ Nothing]) = (Left ("One or more parameters of binary operator '" ++ op ++ "' is invalid"), stack)
 evalBiCompValOp f stack (Call _ [AST.Value a, AST.Value b]) =
   (Right (Just (AST.Boolean (f a b))), stack)
 evalBiCompValOp _ stack (Call op [ast1, ast2]) = case evalSubParams stack [ast1, ast2] of
@@ -170,6 +200,103 @@ evalBiCompValOp _ stack (Call op (_ : _ : _)) = (Left ("Too much parameter for b
 evalBiCompValOp _ stack (Call op _) = (Left ("Not enough parameter for binary operator '" ++ op ++ "'"), stack)
 evalBiCompValOp _ stack _ = (Left "Ast isn't a Call", stack)
 
+-- | Evaluate the 'Ast' for a given binary list operator
+-- such as '++', '--'.
+-- Takes a function that takes one '[Ast]' and one 'Ast' and return one '[Ast]',
+-- the stack as a '[ScopeMb]', and the 'Ast' to evaluate.
+-- Return a tuple containing the new stack post evaluation, and the
+-- application of the function onto the values inside the given 'Ast'
+-- or a 'String' containing the error message in case of error
+evalBiListOp :: ([Ast] -> Ast -> [Ast]) -> [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
+evalBiListOp _ stack (Call op [AST.Boolean _, _]) = (Left ("First parameter of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiListOp _ stack (Call op [AST.Value _, _]) = (Left ("First parameter of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiListOp _ stack (Call op [AST.String _, _]) = (Left ("First parameter of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiListOp _ stack (Call op [AST.FunctionValue _ _ Nothing, _]) = (Left ("First parameter of binary operator '" ++ op ++ "' is invalid"), stack)
+evalBiListOp f stack (Call _ [AST.List a, ast]) =
+  (Right (Just (AST.List (f a ast))), stack)
+evalBiListOp _ stack (Call op [ast1, ast2]) = case evalSubParams stack [ast1, ast2] of
+  Left err -> (Left err, stack)
+  Right asts ->
+    maybe
+      (Left ("No evaluation in one or more parameters of binary operator '" ++ op ++ "'"), stack)
+      (evalAst stack . Call op)
+      asts
+evalBiListOp _ stack (Call op (_ : _ : _)) = (Left ("Too much parameter for binary operator '" ++ op ++ "'"), stack)
+evalBiListOp _ stack (Call op _) = (Left ("Not enough parameter for binary operator '" ++ op ++ "'"), stack)
+evalBiListOp _ stack _ = (Left "Ast isn't a Call", stack)
+
+-- | Evaluate the 'Ast' for '!!'.
+-- Takes the stack as a '[ScopeMb]', and the 'Ast' to evaluate.
+-- Return the 'Ast' contained at the nth index if the 'Ast' is a list
+-- or a 'String' containing the error message in case of error
+getElemInAstList :: [ScopeMb] -> Ast -> Either String Ast
+getElemInAstList _ (Call "!!" [AST.Boolean _, _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [_, AST.Boolean _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [AST.String _, _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [_, AST.String _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [_, AST.List _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [AST.Value _, _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [AST.FunctionValue _ _ Nothing, _]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [_, AST.FunctionValue _ _ Nothing]) =
+  Left "One or more parameters of binary operator '!!' is invalid"
+getElemInAstList _ (Call "!!" [AST.List a, AST.Value b])
+  | length a > b = Right (a !! b)
+  | otherwise = Left "Index out of range"
+getElemInAstList stack (Call "!!" [ast1, ast2]) =
+  case evalSubParams stack [ast1, ast2] of
+    Left err -> Left err
+    Right asts -> case maybe
+      ( Left "No evaluation in one or more parameters of binary operator '!!'",
+        stack
+      )
+      (evalAst stack . Call "!!")
+      asts of
+      (Left err, _) -> Left err
+      (Right ast, _) ->
+        maybe
+          ( Left
+              "No evaluation in one or more parameters of binary operator '!!'"
+          )
+          Right
+          ast
+getElemInAstList _ (Call "!!" (_ : _ : _)) =
+  Left "Too much parameter for binary operator '!!'"
+getElemInAstList _ (Call "!!" _) =
+  Left "Not enough parameter for binary operator '!!'"
+getElemInAstList _ _ = Left "Ast isn't a '!!' Call"
+
+-- | Evaluate the 'Ast' for a given unary list operator
+-- such as 'len'.
+-- Takes a function that takes one '[Ast]' and return one 'Ast',
+-- the stack as a '[ScopeMb]', and the 'Ast' to evaluate.
+-- Return a tuple containing the new stack post evaluation, and the
+-- application of the function onto the values inside the given 'Ast'
+-- or a 'String' containing the error message in case of error
+evalUnListOp :: ([Ast] -> Ast) -> [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
+evalUnListOp _ stack (Call op [AST.Boolean _]) = (Left ("The parameter of unary operator '" ++ op ++ "' is invalid"), stack)
+evalUnListOp _ stack (Call op [AST.String _]) = (Left ("The parameter of unary operator '" ++ op ++ "' is invalid"), stack)
+evalUnListOp _ stack (Call op [AST.Value _]) = (Left ("The parameter of unary operator '" ++ op ++ "' is invalid"), stack)
+evalUnListOp _ stack (Call op [AST.FunctionValue _ _ Nothing]) = (Left ("The parameter of unary operator '" ++ op ++ "' is invalid"), stack)
+evalUnListOp f stack (Call _ [AST.List a]) =
+  (Right (Just (f a)), stack)
+evalUnListOp _ stack (Call op [ast]) = case evalSubParams stack [ast] of
+  Left err -> (Left err, stack)
+  Right asts ->
+    maybe
+      (Left ("No evaluation in one or more parameters of binary operator '" ++ op ++ "'"), stack)
+      (evalAst stack . Call op)
+      asts
+evalUnListOp _ stack (Call op (_ : _ : _)) = (Left ("Too much parameter for unary operator '" ++ op ++ "'"), stack)
+evalUnListOp _ stack (Call op _) = (Left ("Not enough parameter for unary operator '" ++ op ++ "'"), stack)
+evalUnListOp _ stack _ = (Left "Ast isn't a Call", stack)
+
 -- | Evaluate the list of 'Ast'
 -- Takes the stack as a '[ScopeMb]' and a '[Ast]' to evaluate
 -- Returns a list of the results of the evaluation
@@ -179,3 +306,18 @@ evalSubParams :: [ScopeMb] -> [Ast] -> Either String (Maybe [Ast])
 evalSubParams stack astList = case mapM (fst . evalAst stack) astList of
   Left err -> Left err
   Right asts -> Right (sequence asts)
+
+-- | Transform the given 'Ast' into a 'String',
+-- return an error message when unable to convert
+astToString :: [ScopeMb] -> Ast -> Either String Ast
+astToString _ (AST.String str) = Right (AST.String str)
+astToString _ (AST.Value val) = Right (AST.String (show val))
+astToString _ (AST.Boolean bool) = Right (AST.String (show bool))
+astToString _ (AST.FunctionValue _ _ Nothing) = Left "Cannot convert lambda to string"
+astToString stack ast = case evalAst stack ast of
+  (Left err, _) -> Left err
+  (Right ast', _) ->
+    maybe
+      (Left "Cannot convert no evaluation to string")
+      (astToString stack)
+      ast'