X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=0da9c7735cb1ca7d6faca7301aec2dfc8e87511f;hb=f081c2c5e248331eb6e2f090f4afe818fd8259eb;hp=68b804d42939c49739bb662f0688ccd527740913;hpb=0a75e19cdae3c9fa329cc8c18f8284419a62432b;p=cc1516.git diff --git a/sem.icl b/sem.icl index 68b804d..0da9c77 100644 --- a/sem.icl +++ b/sem.icl @@ -26,7 +26,6 @@ from Text import class Text(concat), instance Text String import AST - :: Scheme = Forall [TVar] Type :: Gamma :== 'Map'.Map String Scheme //map from Variables! to types :: Typing a :== StateT (Gamma, [TVar]) (Either SemError) a @@ -49,11 +48,17 @@ instance zero Gamma where variableStream :: [TVar] variableStream = map toString [1..] +defaultGamma :: Gamma //includes all default functions +defaultGamma = extend "print" (Forall ["a"] ((IdType "a") ->> VoidType)) + $ extend "isEmpty" (Forall ["a"] (ListType (IdType "a") ->> BoolType)) + $ extend "read" (Forall [] (IntType ->> (ListType CharType))) + zero + sem :: AST -> Either [SemError] AST sem (AST fd) = case foldM (const $ hasNoDups fd) () fd >>| foldM (const isNiceMain) () fd >>| hasMain fd - >>| evalStateT (type fd) (zero, variableStream) of + >>| evalStateT (type fd) (defaultGamma, variableStream) of Left e = Left [e] Right (_,fds) = Right (AST fds) where @@ -173,6 +178,7 @@ generalize :: Type -> Typing Scheme generalize t = gamma >>= \g-> pure $ Forall (difference (ftv t) (ftv g)) t lookup :: String -> Typing Type +lookup "isEmpty" = ListType <$> fresh lookup k = gamma >>= \g-> case 'Map'.member k g of False = liftT (Left $ UndeclaredVariableError zero k) True = instantiate $ 'Map'.find k g @@ -278,7 +284,7 @@ instance infer Stmt where changeGamma (extend k (Forall [] given)) >>| //todo: fieldselectors pure (s, VoidType) - FunStmt f es = undef //what is this? + FunStmt f es = pure (zero, VoidType) ReturnStmt Nothing = pure (zero, VoidType) ReturnStmt (Just e) = infer e