added num and bool ops
This commit is contained in:
parent
bd36b02931
commit
d7feabece0
4 changed files with 59 additions and 18 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 _) = "<stream>"
|
||||
repr (WaitingStream _) = "<w-stream>"
|
||||
|
||||
|
|
Loading…
Reference in a new issue