From: Mart Lubbers Date: Fri, 8 Apr 2016 18:03:33 +0000 (+0200) Subject: added some type checking stuff. vardecl now works for basictypes and unary operators X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=a363f872ee96379d8b0b9b14cb6faec9d74e7e92;p=cc1516.git added some type checking stuff. vardecl now works for basictypes and unary operators --- diff --git a/examples/example.spl b/examples/example.spl index 4a55e35..e71c216 100644 --- a/examples/example.spl +++ b/examples/example.spl @@ -2,9 +2,14 @@ Three ways to implement the f acto rial function in SPL. First the recursive version . */ -var r = 1; -var facN = 1; -var ok = True; +Int r = 1; +Char r = 1; +Int r = -1; +Void r = 0; +Bool r = !True; +Bool r = -True; +//var facN = 1; +//var ok = True; facR(n) :: Int -> Int { if (n < 2) { diff --git a/sem.dcl b/sem.dcl index 6351c04..b34bbc3 100644 --- a/sem.dcl +++ b/sem.dcl @@ -7,6 +7,7 @@ from StdOverloaded import class toString :: SemError = ParseError Pos String | UnifyError Pos Type Type + | UnifyErrorStub Type Type | Error String :: SemOutput :== Either [SemError] AST diff --git a/sem.icl b/sem.icl index 667b6eb..7132135 100644 --- a/sem.icl +++ b/sem.icl @@ -35,6 +35,7 @@ instance toString SemError where toString (ParseError p e) = concat [ toString p,"SemError: ParseError: ", e] toString (Error e) = "SemError: " +++ e + toString (UnifyErrorStub t1 t2) = toString (UnifyError {line=0,col=0} t1 t2) toString (UnifyError p t1 t2) = concat [ toString p, "SemError: Cannot unify types. Expected: ", @@ -59,18 +60,15 @@ semFunDecl :: FunDecl -> Env FunDecl semFunDecl f = pure $ Right f semVarDecl :: VarDecl -> Env VarDecl -semVarDecl v = pure $ Right v +semVarDecl vd=:(VarDecl pos type ident ex) = unify type ex + >>= \et->pure ( + et >>= \t->pure $ VarDecl pos t ident ex) //Right v -//semVarDecl vd=:(VarDecl pos type ident expr) = case unify type expr of // Left e = Left e // //TODO ident in de environment // Right e = Right $ pure vd typeOp1 :: Pos Expr Type -> Env Type -typeOp1 p expr rtype = typeExpr expr >>= \exprtype->case exprtype of - Left e = pure $ Left e - Right rtype = pure $ Right rtype - Right (IdType ident) = putIdent ident rtype >>| pure (Right rtype) - Right t = pure $ Left $ UnifyError p rtype t +typeOp1 p expr rtype = unify rtype expr typeExpr :: Expr -> Env Type typeExpr (IntExpr _ _) = pure $ Right IntType @@ -81,10 +79,6 @@ typeExpr (Op1Expr p UnMinus expr) = typeOp1 p expr IntType typeExpr (TupleExpr p (e1, e2)) = typeExpr e1 >>= \ete1->typeExpr e2 >>= \ete2->pure ( ete1 >>= \te1->ete2 >>= \te2->Right $ TupleType (te1, te2)) -//typeExpr (Op1Expr p UnMinus expr) = typeExpr expr -// >>= \exprtype->case exprtype of -// IntType = pure $ Right IntType -// t = Left $ UnifyError p IntType exprtype //typeExpr (Op2Expr Pos Expr Op2 Expr) = undef //typeExpr (FunExpr Pos FunCall) = undef //typeExpr (EmptyListExpr Pos) = undef @@ -92,23 +86,41 @@ typeExpr (TupleExpr p (e1, e2)) = typeExpr e1 class unify a :: Type a -> Env Type +instance unify Expr where + unify (_ ->> _) e = pure $ Left $ ParseError (extrPos e) + "Expression cannot be a higher order function. Yet..." + unify VoidType e = pure $ Left $ ParseError (extrPos e) + "Expression cannot be a Void type." + unify (IdType _) e = pure $ Left $ ParseError (extrPos e) + "Expression cannot be an polymorf type." + unify t e = typeExpr e + >>= \eithertype->case eithertype of + Left e = pure $ Left e + Right tex = unify t tex >>= \eitherun->case eitherun of + Left err = pure $ Left $ decErr e err + Right t = pure $ Right t + instance unify Type where unify IntType IntType = pure $ Right IntType unify BoolType BoolType = pure $ Right BoolType unify CharType CharType = pure $ Right CharType - unify _ _ = undef -// -//instance unify Expr where -// unify type expr = case type of -// _ ->> _ = Left $ ParseError (extrPos expr) -// "Expression cannot be a higher order function. Yet..." -// VoidType = Left $ ParseError (extrPos expr) -// "Expression cannot be a Void type." -// IdType _ = Left $ ParseError (extrPos expr) -// "Expression cannot be an polymorf type." -// TupleType (_, _) = undef -// ListType _ = undef -// IntType = undef -// BoolType = undef -// CharType = undef -// VarType = undef + unify t1 t2 = pure $ Left $ UnifyError zero t1 t2 + +instance zero Pos where + zero = {line=0,col=0} + +decErr :: Expr SemError -> SemError +decErr e (UnifyError _ t1 t2) = UnifyError (extrPos e) t1 t2 +decErr e (ParseError _ s) = ParseError (extrPos e) s +decErr e err = err + +extrPos :: Expr -> Pos +extrPos (VarExpr p _) = p +extrPos (Op2Expr p _ _ _) = p +extrPos (Op1Expr p _ _) = p +extrPos (IntExpr p _) = p +extrPos (CharExpr p _) = p +extrPos (BoolExpr p _) = p +extrPos (FunExpr p _) = p +extrPos (EmptyListExpr p) = p +extrPos (TupleExpr p _) = p diff --git a/spl.icl b/spl.icl index 240de63..1690d71 100644 --- a/spl.icl +++ b/spl.icl @@ -66,8 +66,7 @@ Start w # stdin = if (not args.parse) stdin ( stdin <<< "//PARSER\n" <<< toString parseOut <<< "//PARSER\n") = case sem parseOut of - (Left e) = snd $ fclose (stdin <<< "SEMERRORS: " <<< - join "\n" (map toString e)) w + (Left e) = snd $ fclose (stdin <<< join "\n" (map toString e)) w (Right semOut) # stdin = if (not args.sem) stdin ( stdin <<< "//SEM\n" <<< toString semOut <<< "//SEM\n")