fix: reverted last pull request

app/AST.hs

@@ -1,25 +1,33 @@
+{-
+-- EPITECH PROJECT, 2023
+-- glados
+-- File description:
+-- AST
+-}
+
 module AST
   ( Ast (Symbol, Define, Atom, Truth, Lambda, Func, Call, Builtin, If),
     evalAST,
     Context,
-    emptyContext)
+    emptyContext,
+  )
 where
 
-import Data.HashMap.Lazy (HashMap, insert, (!?), empty)
-
-data Ast = Error String             -- error type with string detail
-        | Null                      -- No-Op or resolved expression leaving no value
-        | Symbol String             -- Variable that must be bound
-        | Define String Ast         -- bind an expression to a variable
-        | Atom Int                  -- Single known value
-        | Truth Bool                -- Single known boolean value
-        | Lambda [String] Ast       -- expression with local bindings
-        | Func String [String] Ast  -- named expression with local bindings ?? TODO: verify that this shouldn't just be a Define-Lambda pair
-        | Call Ast [Ast]            -- call to be exectuted or fail immediately
-        | Builtin String [Ast]      -- builtin (binary?) operator
-        | If Ast Ast Ast            -- branching condition
-            deriving Show
-
+import Data.HashMap.Lazy (HashMap, empty, insert, (!?))
+
+data Ast
+  = Error String -- error type with string detail
+  | Null -- No-Op or resolved expression leaving no value
+  | Symbol String -- Variable that must be bound
+  | Define String Ast -- bind an expression to a variable
+  | Atom Int -- Single known value
+  | Truth Bool -- Single known boolean value
+  | Lambda [String] Ast -- expression with local bindings
+  | Func String [String] Ast -- named expression with local bindings ?? TODO: verify that this shouldn't just be a Define-Lambda pair
+  | Call Ast [Ast] -- call to be exectuted or fail immediately
+  | Builtin String [Ast] -- builtin (binary?) operator
+  | If Ast Ast Ast -- branching condition
+  deriving (Show)
 
 type Context = (HashMap String Ast)
 
@@ -31,16 +39,14 @@ execCallDistribute ctx [] [] = Just ctx
 execCallDistribute ctx (s : ss) (x : xs) = case execCallDistribute ctx ss xs of
   Just next -> case evalAST ctx x of
     (_, y) -> Just $ insert s y next
-    _ -> Nothing
   Nothing -> Nothing
 execCallDistribute _ _ _ = Nothing
 
-
 execCall :: Context -> Ast -> [Ast] -> (Context, Ast)
 execCall ctx call args =
   ( ctx,
     case evalAST ctx call of
-      (ctx2, Lambda bindings expr) -> case execCallDistribute ctx2 bindings args of
+      (ctx2, Lambda binds expr) -> case execCallDistribute ctx2 binds args of
         Just jLocalCtx -> snd (evalAST jLocalCtx expr)
         Nothing -> Error "incorrect args to lambda"
       (_, Symbol sym) ->
@@ -75,22 +81,23 @@ evalAST :: Context -> Ast -> (Context, Ast)
 evalAST ctx (Error msg) = (ctx, Error msg)
 evalAST ctx (Null) = (ctx, Error "expression has no value")
 evalAST ctx (Symbol sym) = case ctx !? sym of
-    Just jast -> (ctx, jast)
-    Nothing -> if isBuiltin sym then
-            (ctx, Symbol sym)
-        else
-            (ctx, Error ("Symbol '" ++ sym ++ "' is not bound"))
+  Just jast -> (ctx, jast)
+  Nothing ->
+    if isBuiltin sym
+      then (ctx, Symbol sym)
+      else (ctx, Error ("Symbol '" ++ sym ++ "' is not bound"))
 evalAST ctx (Define name x) = (insert name val ctx2, Null)
-    where (ctx2, val) = evalAST ctx x
+  where
+    (ctx2, val) = evalAST ctx x
 evalAST ctx (Atom i) = (ctx, Atom i)
 evalAST ctx (Truth t) = (ctx, Truth t)
 -- lambda and func go to the default state of no expansion at this state
 evalAST ctx (Call expr args) = execCall ctx expr args
 evalAST ctx (Builtin name args) = (ctx, execBuiltins ctx name args)
 evalAST ctx (If _if _then _else) = case expectAtom (evalAST ctx _if) of
-    Error err -> (ctx, Error err)
-    Truth False -> evalAST ctx _else
-    _ -> evalAST ctx _then
+  Error err -> (ctx, Error err)
+  Truth False -> evalAST ctx _else
+  _ -> evalAST ctx _then
 evalAST ctx x = (ctx, x)
 
 expectAtom :: (Context, Ast) -> Ast
@@ -102,45 +109,47 @@ expectAtom (_, x) = Error ("expected Atom but got: " ++ show x)
 
 binOp :: (Int -> Int -> Int) -> Context -> [Ast] -> Ast
 binOp op ctx [a, b] =
-        case expectAtom (evalAST ctx a) of
-        Atom ia -> case expectAtom (evalAST ctx b) of
-            Atom ib -> Atom (op ia ib)
-            x -> x
-        x -> x
+  case expectAtom (evalAST ctx a) of
+    Atom ia -> case expectAtom (evalAST ctx b) of
+      Atom ib -> Atom (op ia ib)
+      x -> x
+    x -> x
 binOp _ _ _ = Error "Bad number of args to binary operand"
 
 builtinEq :: Context -> [Ast] -> Ast
 builtinEq ctx [a, b] = case expectAtom (evalAST ctx a) of
-    Atom ia -> case expectAtom (evalAST ctx b) of
-        Atom ib -> Truth (ia == ib)
-        x -> x
+  Atom ia -> case expectAtom (evalAST ctx b) of
+    Atom ib -> Truth (ia == ib)
     x -> x
+  x -> x
 builtinEq _ _ = Error "Bad number of args to eq?"
 
 builtinLt :: Context -> [Ast] -> Ast
 builtinLt ctx [a, b] = case expectAtom (evalAST ctx a) of
-    Atom ia -> case expectAtom (evalAST ctx b) of
-        Atom ib -> Truth (ia < ib)
-        x -> x
+  Atom ia -> case expectAtom (evalAST ctx b) of
+    Atom ib -> Truth (ia < ib)
     x -> x
+  x -> x
 builtinLt _ _ = Error "Bad number of args to <"
 
 builtinDiv :: Context -> [Ast] -> Ast
 builtinDiv ctx [a, b] = case expectAtom (evalAST ctx a) of
-    Atom ia -> case expectAtom (evalAST ctx b) of
-        Atom ib -> if ib == 0
-            then Error "division by zero"
-            else Atom (ia `div` ib)
-        x -> x
+  Atom ia -> case expectAtom (evalAST ctx b) of
+    Atom ib ->
+      if ib == 0
+        then Error "division by zero"
+        else Atom (ia `div` ib)
     x -> x
+  x -> x
 builtinDiv _ _ = Error "Bad number of args to div"
 
 builtinMod :: Context -> [Ast] -> Ast
 builtinMod ctx [a, b] = case expectAtom (evalAST ctx a) of
-    Atom ia -> case expectAtom (evalAST ctx b) of
-        Atom ib -> if ib == 0
-            then Error "modulo by zero"
-            else Atom (ia `mod` ib)
-        x -> x
+  Atom ia -> case expectAtom (evalAST ctx b) of
+    Atom ib ->
+      if ib == 0
+        then Error "modulo by zero"
+        else Atom (ia `mod` ib)
     x -> x
+  x -> x
 builtinMod _ _ = Error "Bad number of args to mod"

app/Converter.hs

@@ -1,51 +1,50 @@
---
+{-
 -- EPITECH PROJECT, 2023
 -- glados
 -- File description:
 -- Converter
---
+-}
 
 module Converter (sexprToAST) where
 
-import AST (Ast (Symbol, Atom, Call, Define, Lambda, If))
-import SParser (SExpr (SInt, SSym, SList))
+import AST (Ast (Atom, Call, Define, If, Lambda, Symbol))
+import SParser (SExpr (SInt, SList, SSym))
 
 convertArgsContinuous :: [SExpr] -> Maybe [Ast]
-convertArgsContinuous (x:xs) = case convertArgsContinuous xs of
-    (Just ys) -> case sexprToAST x of
-        Just y -> Just (y:ys)
-        Nothing -> Nothing
+convertArgsContinuous (x : xs) = case convertArgsContinuous xs of
+  (Just ys) -> case sexprToAST x of
+    Just y -> Just (y : ys)
     Nothing -> Nothing
+  Nothing -> Nothing
 convertArgsContinuous [] = Just []
 
 convertSymbols :: [SExpr] -> Maybe [String]
-convertSymbols (SSym sym:xs) = case convertSymbols xs of
-    (Just ys) -> Just (sym:ys)
-    Nothing -> Nothing
+convertSymbols (SSym sym : xs) = case convertSymbols xs of
+  (Just ys) -> Just (sym : ys)
+  Nothing -> Nothing
 convertSymbols [] = Just []
 convertSymbols _ = Nothing
 
 sexprToAST :: SExpr -> Maybe Ast
 sexprToAST (SList [x]) = sexprToAST x
-sexprToAST (SList [SSym "define",SSym name,s]) = case mexpr of
-        Just expr -> Just $ Define name expr
-        Nothing -> Nothing
-    where mexpr = sexprToAST s
-sexprToAST (SList [SSym "define", SList (SSym name:args), expr]) =
-    case convertSymbols args of
+sexprToAST (SList [SSym "define", SSym name, s]) = case mexpr of
+  Just expr -> Just $ Define name expr
+  Nothing -> Nothing
+  where
+    mexpr = sexprToAST s
+sexprToAST (SList [SSym "define", SList (SSym name : args), expr]) =
+  case convertSymbols args of
     (Just jArgs) -> case sexprToAST expr of
-        (Just jExpr) -> Just (Define name (Lambda jArgs jExpr))
-        Nothing -> Nothing
+      (Just jExpr) -> Just (Define name (Lambda jArgs jExpr))
+      Nothing -> Nothing
     _ -> Nothing
-
 sexprToAST (SList [SSym "if", _if, _then, _else]) =
-    case (sexprToAST _if, sexprToAST _then, sexprToAST _else) of
-        (Just jIf, Just jThen, Just jElse) -> Just (If jIf jThen jElse)
-        _ -> Nothing
-
-sexprToAST (SList (SSym name:args)) = case convertArgsContinuous args of
-    (Just jArgs) -> Just (Call (Symbol name) jArgs)
+  case (sexprToAST _if, sexprToAST _then, sexprToAST _else) of
+    (Just jIf, Just jThen, Just jElse) -> Just (If jIf jThen jElse)
     _ -> Nothing
+sexprToAST (SList (SSym name : args)) = case convertArgsContinuous args of
+  (Just jArgs) -> Just (Call (Symbol name) jArgs)
+  _ -> Nothing
 sexprToAST (SInt x) = Just $ Atom x
 sexprToAST (SSym x) = Just $ Symbol x
 sexprToAST (SList _) = Nothing

app/Main.hs

@@ -7,64 +7,26 @@
 
 module Main (main) where
 
-import System.Environment (getArgs, getProgName)
-import System.IO (stdin, hGetContents', hIsTerminalDevice)
-import System.Timeout (timeout)
-import System.Exit
-import SParser (sExprParser, SExpr)
+import AST (Context, emptyContext, evalAST)
 import Converter (sexprToAST)
-import AST (evalAST, Context, emptyContext)
-
--- print the command line, with exec name and all args seperated by a space
--- note the lack of quoting for params containing a space
-cmd :: IO ()
-cmd = do
-    name <- getProgName
-    args <- getArgs
-    putStr name
-    putStr " "
-    mapM_ (\s -> putStr (' ':s)) args
-    putStrLn ""
-
--- print the stdin or fail if stdin is a tty
-cat :: IO ()
-cat = do
-    bool <- hIsTerminalDevice stdin
-    if bool
-        then
-            putStrLn "#ERR: input is tty"
-        else
-            do
-                contents <- hGetContents' stdin
-                putStrLn contents
-
--- dump input
-scraper :: IO ()
-scraper =  putStrLn "cmd:" >> cmd >> putStrLn "cat:" >> cat
+import SParser (SExpr, sExprParser)
+import System.Exit
+import System.IO (hGetContents', stdin)
 
 testInput :: IO [SExpr]
 testInput = do
-    contents <- hGetContents' stdin
-    return $ sExprParser contents
+  contents <- hGetContents' stdin
+  return $ sExprParser contents
 
 main :: IO ExitCode
 main = do
-    expr <- testInput
-    loopOnCommands emptyContext expr
+  expr <- testInput
+  loopOnCommands emptyContext expr
 
 loopOnCommands :: Context -> [SExpr] -> IO ExitCode
 loopOnCommands _ [] = exitSuccess
-loopOnCommands ctx (expr:xs) = case sexprToAST expr of
-    Just ast -> print res >> loopOnCommands newCtx xs
-        where (newCtx, res) = evalAST ctx ast
-    Nothing -> exitWith (ExitFailure 84)
-
-
--- wrap the scraper in a timeout loop to prevent apparent crash should
---  measures to avoid waiting on input to fail
-main2 :: IO ExitCode
-main2 = do
-    status <- timeout (10 * 1000 * 1000) scraper
-    case status of
-        Just () -> exitSuccess
-        Nothing -> putStrLn "#ERR: timedout" >> exitWith (ExitFailure 84)
+loopOnCommands ctx (expr : xs) = case sexprToAST expr of
+  Just ast -> print res >> loopOnCommands newCtx xs
+    where
+      (newCtx, res) = evalAST ctx ast
+  Nothing -> exitWith (ExitFailure 84)