added some primitive
This commit is contained in:
parent
b0ed22f436
commit
bb18191ce4
3 changed files with 82 additions and 0 deletions
1
test.sh
1
test.sh
|
@ -16,6 +16,7 @@ if ((${#listfic}>1)); then
|
|||
# compile
|
||||
[[ ! -d .tmp ]] && mkdir .tmp
|
||||
ghc -O2 -hidir .tmp -odir .tmp y.hs
|
||||
(($?!=0)) && exit 1
|
||||
cmd='./y'
|
||||
else
|
||||
cmd=(runghc y.hs)
|
||||
|
|
18
tests/eval
Normal file
18
tests/eval
Normal file
|
@ -0,0 +1,18 @@
|
|||
(+ 2 2)
|
||||
4
|
||||
(* 3 5)
|
||||
15
|
||||
(/ 10 2)
|
||||
5
|
||||
(- 15 5 3 2)
|
||||
5
|
||||
(* (+ 2 2) (- 4 3))
|
||||
4
|
||||
(boolean? #t)
|
||||
#t
|
||||
(boolean? (+ 2 2))
|
||||
#f
|
||||
(string? "hello")
|
||||
#t
|
||||
(string? (* 3 2))
|
||||
#f
|
63
y.hs
63
y.hs
|
@ -183,3 +183,66 @@ eval val@(Number _) = val
|
|||
eval val@(Float _) = val
|
||||
eval val@(Bool _) = val
|
||||
eval (List [Atom "quote", val]) = val
|
||||
|
||||
-- strict evaluation here:
|
||||
eval (List (Atom func : args)) = apply func $ map eval args
|
||||
|
||||
apply :: String -> [LispVal] -> LispVal
|
||||
apply func args = maybe (Bool False) ($ args) $ lookup func primitives
|
||||
|
||||
primitives :: [(String, [LispVal] -> LispVal)]
|
||||
primitives =[ ("+", numericBinop (+))
|
||||
, ("-", numericBinop (-))
|
||||
, ("*", numericBinop (*))
|
||||
, ("/", numericBinop div)
|
||||
, ("mod", numericBinop mod)
|
||||
, ("quotient", numericBinop quot)
|
||||
, ("remainder", numericBinop rem)
|
||||
, ("boolean?", isBool)
|
||||
, ("string?", isString)
|
||||
, ("number?", isNumber)
|
||||
, ("float?", isFloat)
|
||||
, ("character?", isCharacter)
|
||||
, ("dottedlist?", isDottedList)
|
||||
, ("list?", isList)
|
||||
, ("symbol?", isAtom)
|
||||
]
|
||||
|
||||
isBool :: [LispVal] -> LispVal
|
||||
isBool ((Bool _):_) = Bool True
|
||||
isBool _ = Bool False
|
||||
|
||||
isString :: [LispVal] -> LispVal
|
||||
isString ((String _):_) = Bool True
|
||||
isString _ = Bool False
|
||||
|
||||
isCharacter :: [LispVal] -> LispVal
|
||||
isCharacter ((Character _):_) = Bool True
|
||||
isCharacter _ = Bool False
|
||||
|
||||
isNumber :: [LispVal] -> LispVal
|
||||
isNumber ((Number _):_) = Bool True
|
||||
isNumber _ = Bool False
|
||||
|
||||
isFloat :: [LispVal] -> LispVal
|
||||
isFloat ((Float _):_) = Bool True
|
||||
isFloat _ = Bool False
|
||||
|
||||
isDottedList :: [LispVal] -> LispVal
|
||||
isDottedList ((DottedList _ _):_) = Bool True
|
||||
isDottedList _ = Bool False
|
||||
|
||||
isList :: [LispVal] -> LispVal
|
||||
isList ((List _):_) = Bool True
|
||||
isList _ = Bool False
|
||||
|
||||
isAtom :: [LispVal] -> LispVal
|
||||
isAtom ((Atom _):_) = Bool True
|
||||
isAtom _ = Bool False
|
||||
|
||||
numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> LispVal
|
||||
numericBinop op params = Number $ foldl1 op $ map unpackNum params
|
||||
|
||||
unpackNum :: LispVal -> Integer
|
||||
unpackNum (Number n) = n
|
||||
unpackNum _ = 0
|
||||
|
|
Loading…
Reference in a new issue