diff --git a/src/Lish/Core.hs b/src/Lish/Core.hs index a41f9d9..cbad30b 100644 --- a/src/Lish/Core.hs +++ b/src/Lish/Core.hs @@ -45,7 +45,7 @@ mainLoop env = do Just "exit" -> outputStrLn "bye bye!" Just "logout" -> outputStrLn "bye bye!" Just line -> do - newenv <- eval env (parseCmd ("(" <> line <> ")")) + newenv <- eval env (parseCmd ("(" <> toS line <> ")")) mainLoop newenv -- | Eval the reduced form diff --git a/src/Lish/InternalCommands.hs b/src/Lish/InternalCommands.hs index abc1da7..4846bd4 100644 --- a/src/Lish/InternalCommands.hs +++ b/src/Lish/InternalCommands.hs @@ -90,6 +90,19 @@ atom ((Atom a):[]) = return $ Atom a atom ((Str s):[]) = return $ Atom s atom _ = evalErr "atom need an atom or a string" +-- | Numbers Ops +binop :: (Integer -> Integer -> Integer) -> Command +binop f ((Num x):(Num y):[]) = return $ Num (f x y) +binop _ _ = evalErr "binary operator needs two numbers" + +bbinop :: (Bool -> Bool -> Bool) -> Command +bbinop f ((Bool x):(Bool y):[]) = return $ Bool (f x y) +bbinop _ _ = evalErr "boolean binary operator need two booleans arguments" + +lnot :: Command +lnot ((Bool x):[]) = return ( Bool (not x)) +lnot _ = evalErr "not need a boolean" + toWaitingStream :: Command toWaitingStream (Stream (Just h) :[]) = return (WaitingStream (Just h)) toWaitingStream _ = return Void @@ -106,6 +119,16 @@ internalCommands = [ ("prn", prn) , ("$",getenv) , ("str",str) , ("atom",atom) + -- binary operators + , ("+",binop (+)) + , ("-",binop (-)) + , ("*",binop (*)) + , ("/",binop div) + , ("^",binop (^)) + -- boolean bin ops + , ("and", bbinop (&&)) + , ("or", bbinop (||)) + , ("not", lnot) ] & Map.fromList lookup :: Text -> Maybe Command diff --git a/src/Lish/Parser.hs b/src/Lish/Parser.hs index 5c72e8b..a3554eb 100644 --- a/src/Lish/Parser.hs +++ b/src/Lish/Parser.hs @@ -5,36 +5,45 @@ module Lish.Parser (parseCmd) where -import Prelude (String) -import Protolude hiding (for, many, (<|>)) +import Protolude hiding (for, many, (<|>), optional) import Text.Parsec +import Text.Parsec.Text import Lish.Types -parseCmd :: String -> Either ParseError SExp +parseCmd :: Text -> Either ParseError SExp parseCmd = parse parseExpr "S-Expr" -parseExpr :: Parsec String () SExp +parseExpr :: Parser SExp parseExpr = parseLambda <|> parseList + <|> parseBool + <|> parseNumber <|> parseAtom <|> parseString -parseAtom :: Parsec String () SExp +parseNumber :: Parser SExp +parseNumber = (Num . fromMaybe 0 . readMaybe) <$> many1 digit + +parseBool :: Parser SExp +parseBool = Bool <$> ((string "true" >> return True) + <|> (string "false" >> return False)) + +parseAtom :: Parser SExp parseAtom = Atom <$> do frst <- (noneOf " \t()[]\"") rest <- many (noneOf " \t()[]") return $ toS (frst:rest) -parseString :: Parsec String () SExp +parseString :: Parser SExp parseString = (Str . toS) <$> between (char '"') (char '"') (many (noneOf "\"")) -parseSExps :: Parsec String () [SExp] +parseSExps :: Parser [SExp] parseSExps = sepEndBy parseExpr spaces -parseLambda :: Parsec String () SExp +parseLambda :: Parser SExp parseLambda = Lambda <$> between (char '(') (char ')') parseSExps -parseList :: Parsec String () SExp +parseList :: Parser SExp parseList = List <$> between (char '[') (char ']') parseSExps diff --git a/src/Lish/Types.hs b/src/Lish/Types.hs index 16a5116..d94104f 100644 --- a/src/Lish/Types.hs +++ b/src/Lish/Types.hs @@ -16,12 +16,18 @@ import GHC.IO.Handle (Handle) import GHC.Show (Show (..)) import Protolude hiding (show) -data SExp = Lambda [SExp] - | Atom Text - | List [SExp] +data SExp = Atom Text + | Num Integer + | Bool Bool | Str Text + | List [SExp] + | Lambda [SExp] | Void -- only exists during evaluation + | Fn { params :: [Text] + , body :: [SExp] + , closure :: Env + } | Stream CmdStream | WaitingStream CmdStream @@ -29,11 +35,14 @@ instance Show SExp where show = toS . repr repr :: SExp -> Text -repr (Atom s) = s -repr (Str s) = "\"" <> toS s <> "\"" -repr (Lambda sexprs) = "(λ." <> (Text.intercalate " " (map repr sexprs)) <> ")" -repr (List sexprs) = "[" <> (Text.intercalate " " (map repr sexprs)) <> "]" -repr Void = "ε" +repr (Atom s) = s +repr (Num n) = toS $ show n +repr (Bool b) = if b then "true" else "false" +repr (Str s) = "\"" <> toS s <> "\"" +repr (List sexprs) = "[" <> (Text.intercalate " " (map repr sexprs)) <> "]" +repr (Lambda sexprs) = "(" <> (Text.intercalate " " (map repr sexprs)) <> ")" +repr Void = "ε" +repr (Fn p _ _) = "(λ" <> (Text.intercalate "." p) <> ". ... )" repr (Stream _) = "" repr (WaitingStream _) = ""