repositories
/
cc1516.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3bf5967
)
Added function type inference
author
pimjager
<pim@pimjager.nl>
Wed, 13 Apr 2016 17:19:39 +0000
(19:19 +0200)
committer
pimjager
<pim@pimjager.nl>
Wed, 13 Apr 2016 17:19:39 +0000
(19:19 +0200)
examples/StmtEx.spl
patch
|
blob
|
history
sem.icl
patch
|
blob
|
history
diff --git
a/examples/StmtEx.spl
b/examples/StmtEx.spl
index
1e1d4fe
..
35ff096
100644
(file)
--- a/
examples/StmtEx.spl
+++ b/
examples/StmtEx.spl
@@
-3,6
+3,7
@@
var y = 3;
var z = 3 + y;
Int a = facR(4);
//Int b = test(3);
var z = 3 + y;
Int a = facR(4);
//Int b = test(3);
+var f = beep();
facR(n) :: Int -> Int {
test(3);
facR(n) :: Int -> Int {
test(3);
@@
-20,4
+21,12
@@
test(n) :: Int -> Int {
while (z < 3) {
return 3;
}
while (z < 3) {
return 3;
}
+}
+
+beep() {
+ boop();
+}
+
+boop() {
+ beep();
}
\ No newline at end of file
}
\ No newline at end of file
diff --git
a/sem.icl
b/sem.icl
index
ffe95dd
..
3f4458a
100644
(file)
--- a/
sem.icl
+++ b/
sem.icl
@@
-95,7
+95,10
@@
where
pure (vds, fds)
semFunDecl :: FunDecl -> Env FunDecl
pure (vds, fds)
semFunDecl :: FunDecl -> Env FunDecl
-semFunDecl fd=:(FunDecl p f _ mt vds stmts) = mapM_ semVarDecl vds >>|
+semFunDecl fd=:(FunDecl p f args mt vds stmts) = (case mt of
+ Nothing = typeFun f args
+ Just t = putIdent f t) >>|
+ mapM_ semVarDecl vds >>|
mapM_ (checkStmt IntType) stmts >>|
case mt of
Nothing = let t = IdType f in putIdent f t >>| pure fd
mapM_ (checkStmt IntType) stmts >>|
case mt of
Nothing = let t = IdType f in putIdent f t >>| pure fd
@@
-110,8
+113,8
@@
checkStmt t (IfStmt c st se) = unify BoolType c >>| mapM (checkStmt t) st
>>= \st1-> mapM (checkStmt t) se >>= \se1-> pure (IfStmt c st1 se1)
checkStmt t w=:(WhileStmt c et) = unify BoolType c >>| mapM (checkStmt t) et
>>= \et1-> pure w
>>= \st1-> mapM (checkStmt t) se >>= \se1-> pure (IfStmt c st1 se1)
checkStmt t w=:(WhileStmt c et) = unify BoolType c >>| mapM (checkStmt t) et
>>= \et1-> pure w
-checkStmt t (AssStmt (VarDef ident fs) e) =
undef
-checkStmt t r=:(FunStmt
funcall) = typeFun funcall
>>| pure r
+checkStmt t (AssStmt (VarDef ident fs) e) =
+checkStmt t r=:(FunStmt
(FunCall f es)) = typeFun f es
>>| pure r
checkStmt VoidType r=:(ReturnStmt Nothing) = pure r
checkStmt t r=:(ReturnStmt (Just e)) = unify t e >>| pure r
checkStmt VoidType r=:(ReturnStmt Nothing) = pure r
checkStmt t r=:(ReturnStmt (Just e)) = unify t e >>| pure r
@@
-139,7
+142,7
@@
typeExpr (Op2Expr p e1 op e2)
>>= \t2-> unify (ListType t1) t2
typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in
putIdent frsh t >>| pure t
>>= \t2-> unify (ListType t1) t2
typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in
putIdent frsh t >>| pure t
-typeExpr (FunExpr p
funcall) = typeFun funcall
+typeExpr (FunExpr p
(FunCall f es)) = typeFun f es
typeExpr (VarExpr p (VarDef ident fs)) = gets (\(st, r)->'Map'.get ident st)
>>= \mt->case mt of
Nothing = liftT $ Left $ UndeclaredVariableError p ident
typeExpr (VarExpr p (VarDef ident fs)) = gets (\(st, r)->'Map'.get ident st)
>>= \mt->case mt of
Nothing = liftT $ Left $ UndeclaredVariableError p ident
@@
-198,12
+201,14
@@
instance unify Type where
instance zero Pos where
zero = {line=0,col=0}
instance zero Pos where
zero = {line=0,col=0}
-typeFun ::
FunCall
-> Env Type
-typeFun
(FunCall f es)
= gets (\(st, r)->'Map'.get f st) >>= \mt-> case mt of
+typeFun ::
String [String]
-> Env Type
+typeFun
f es
= gets (\(st, r)->'Map'.get f st) >>= \mt-> case mt of
Nothing = freshIdent >>= \frsh-> buildFunctionType frsh es
>>= \ft-> putIdent f ft >>| (pure $ IdType frsh)
Just t = unifyApp t es
Nothing = freshIdent >>= \frsh-> buildFunctionType frsh es
>>= \ft-> putIdent f ft >>| (pure $ IdType frsh)
Just t = unifyApp t es
+
+
decErr :: Expr SemError -> SemError
decErr e (UnifyError _ t1 t2) = UnifyError (extrPos e) t1 t2
decErr e (FieldSelectorError _ t fs) = FieldSelectorError (extrPos e) t fs
decErr :: Expr SemError -> SemError
decErr e (UnifyError _ t1 t2) = UnifyError (extrPos e) t1 t2
decErr e (FieldSelectorError _ t fs) = FieldSelectorError (extrPos e) t fs
@@
-229,5
+234,3
@@
instance toString Gamma where
toString (mp, _) = concat
[concat [k, ": ", toString v, "\n"]\\(k, v) <- 'Map'.toList mp]
toString (mp, _) = concat
[concat [k, ": ", toString v, "\n"]\\(k, v) <- 'Map'.toList mp]
-
-// class free a :: a -> Env [a]