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
|
# compile
|
||||||
[[ ! -d .tmp ]] && mkdir .tmp
|
[[ ! -d .tmp ]] && mkdir .tmp
|
||||||
ghc -O2 -hidir .tmp -odir .tmp y.hs
|
ghc -O2 -hidir .tmp -odir .tmp y.hs
|
||||||
|
(($?!=0)) && exit 1
|
||||||
cmd='./y'
|
cmd='./y'
|
||||||
else
|
else
|
||||||
cmd=(runghc y.hs)
|
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@(Float _) = val
|
||||||
eval val@(Bool _) = val
|
eval val@(Bool _) = val
|
||||||
eval (List [Atom "quote", val]) = 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