X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=820e45df5b84f822bb0bd69cc232cc5e4cf71eb0;hb=7b1d68ab317aaf431d123078daf9bd04f8829de0;hp=3438810cc3b0b5e6a62a2bd760ba9b0eda4c3844;hpb=bf8de26a347182ab0de1aa45a5cc3fdf6c320c21;p=cc1516.git diff --git a/sem.icl b/sem.icl index 3438810..820e45d 100644 --- a/sem.icl +++ b/sem.icl @@ -42,13 +42,13 @@ where m :: Env ([VarDecl], [FunDecl]) m = mapM semVarDecl vd >>= \vd1 -> mapM semFunDecl fd >>= \fd1 -> - mapM semVarDecl vd1 >>= \vd2 -> - mapM semFunDecl fd1 >>= \fd2 -> - mapM semVarDecl vd2 >>= \vd3 -> - mapM semFunDecl fd2 >>= \fd3 -> - mapM semVarDecl vd3 >>= \vd4 -> - mapM semFunDecl fd3 >>= \fd4 -> //Dit is puur om te proberen - pure (vd4, fd4) +// mapM semVarDecl vd1 >>= \vd2 -> +// mapM semFunDecl fd1 >>= \fd2 -> +// mapM semVarDecl vd2 >>= \vd3 -> +// mapM semFunDecl fd2 >>= \fd3 -> +// mapM semVarDecl vd3 >>= \vd4 -> +// mapM semFunDecl fd3 >>= \fd4 -> //Dit is puur om te proberen + pure (vd1, fd1) semFunDecl :: FunDecl -> Env FunDecl semFunDecl fd=:(FunDecl p f args mt vds stmts) = @@ -59,15 +59,26 @@ semFunDecl fd=:(FunDecl p f args mt vds stmts) = matchFunctions args ft >>= \tres-> mapM semVarDecl vds >>= \newvds-> mapM (checkStmt tres) stmts >>= \newstmts-> - inferReturnType stmts >>= \returntype-> + inferReturnType stmts >>= \returntype`-> + unify returntype` tres >>= \returntype-> case mt of Nothing = reconstructType args tres + >>= \ftype`->recoverType ftype` >>= \ftype->restoreGamma gamma >>| putIdent f ftype >>| pure ( FunDecl p f args (Just ftype) newvds newstmts) Just t = restoreGamma gamma >>| updateFunType t returntype >>= \tt-> pure (FunDecl p f args (Just tt) newvds newstmts) +recoverType :: Type -> Env Type +recoverType (IdType ident) = gets (\(st, r)->'Map'.get ident st) + >>= \mt->case mt of + Nothing = pure (IdType ident) + Just t = pure t +recoverType (t1 ->> t2) = recoverType t1 >>= \t1`->recoverType t2 + >>= \t2`->pure (t1` ->> t2`) +recoverType t = pure t + updateFunType :: Type Type -> Env Type updateFunType t1 t2 = unify t1 t2 updateFunType (t1 ->> t2) t3 = t1 ->> (updateFunType t2 t3)