repositories
/
minfp.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
f2b4f22
)
cleanup
author
Mart Lubbers
<mart@martlubbers.net>
Mon, 4 Mar 2019 15:26:30 +0000
(16:26 +0100)
committer
Mart Lubbers
<mart@martlubbers.net>
Mon, 4 Mar 2019 15:26:30 +0000
(16:26 +0100)
int.icl
patch
|
blob
|
history
parse.icl
patch
|
blob
|
history
diff --git
a/int.icl
b/int.icl
index
4cf6b78
..
78f2c1f
100644
(file)
--- a/
int.icl
+++ b/
int.icl
@@
-50,12
+50,11
@@
eval (Let ident as body rest)
= modify (\vs->[(ident, Func (length as) [] \e->zipSt sub as e body):vs])
>>| eval rest
eval (Lit v) = pure v
= modify (\vs->[(ident, Func (length as) [] \e->zipSt sub as e body):vs])
>>| eval rest
eval (Lit v) = pure v
-eval (Var v) = gets (lookup v)
- >>= maybe (err ("Variable " +++ toString v +++ " not found")) pure
+eval (Var v) = gets (lookup v) >>= maybe (err (toString v +++ " not found")) pure
eval (App e1 e2) = eval e1 >>= \v->case v of
eval (App e1 e2) = eval e1 >>= \v->case v of
-
(Func 0 a b) = err ("Saturated function: : " +++ toString e1)
+
//
(Func 0 a b) = err ("Saturated function: : " +++ toString e1)
(Func n as b) = pure (Func (n-1) (as ++ [e2]) b)
(Func n as b) = pure (Func (n-1) (as ++ [e2]) b)
-
_ = err ("Cannot apply " +++ toString e2 +++ " to " +++ toString e1)
+
//
_ = err ("Cannot apply " +++ toString e2 +++ " to " +++ toString e1)
eval (Lambda a b) = pure (Func 1 [] (\[arg]->sub a arg b))
eval (Builtin i as) = case (i, as) of
(['if'], [p,t,e]) = eval p >>= printer >>= \v->case v of
eval (Lambda a b) = pure (Func 1 [] (\[arg]->sub a arg b))
eval (Builtin i as) = case (i, as) of
(['if'], [p,t,e]) = eval p >>= printer >>= \v->case v of
diff --git
a/parse.icl
b/parse.icl
index
6a9ab29
..
5bb4bac
100644
(file)
--- a/
parse.icl
+++ b/
parse.icl
@@
-18,9
+18,12
@@
import ast
(<:>) l r = (\xs->[l:xs]) <$> r
:: Token = TTEq | TTSemiColon | TTLambda | TTDot | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int | TTOp [Char] | TTIdent [Char]
(<:>) l r = (\xs->[l:xs]) <$> r
:: Token = TTEq | TTSemiColon | TTLambda | TTDot | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int | TTOp [Char] | TTIdent [Char]
+
derive gEq Token
derive gEq Token
-instance toString Token where toString t = printToString t
derive gPrint Token
derive gPrint Token
+
+instance toString Token where toString t = printToString t
+
lex :: [Char] -> Either [String] [Token]
lex [] = pure []
lex [';':ts] = TTSemiColon <:> lex ts
lex :: [Char] -> Either [String] [Token]
lex [] = pure []
lex [';':ts] = TTSemiColon <:> lex ts
@@
-109,7
+112,8
@@
where
(map fst $ sortBy (on (<) snd) ifxs)
$ pChainl (pure App)
$ Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression
(map fst $ sortBy (on (<) snd) ifxs)
$ pChainl (pure App)
$ Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression
+ <|> Var <$ pToken TTBrackOpen <*> pOp <* pToken TTBrackClose
<|> pToken TTBrackOpen *> pExpression <* pToken TTBrackClose
<|> pToken TTBrackOpen *> pExpression <* pToken TTBrackClose
- <|>
Lit o Int <$> (\(TTInt i)->i
) <$> pTop ? (\t->t=:(TTInt _))
+ <|>
(\(TTInt i)->Lit (Int i)
) <$> pTop ? (\t->t=:(TTInt _))
<|> (\(TTBool i)->Lit (Bool i)) <$> pTop ? (\t->t=:(TTBool _))
<|> Var <$> pId
<|> (\(TTBool i)->Lit (Bool i)) <$> pTop ? (\t->t=:(TTBool _))
<|> Var <$> pId