import AST
-
:: Scheme = Forall [TVar] Type
:: Gamma :== 'Map'.Map String Scheme //map from Variables! to types
:: Typing a :== StateT (Gamma, [TVar]) (Either SemError) a
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
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
pure (compose s3 $ compose s2 s1, subst s3 wht)
AssStmt (VarDef k fs) e =
- infer e >>= \(s1, et)->
- applySubst s1 >>|
- changeGamma (extend k (Forall [] et)) >>| //todo: fieldselectors
- pure (s1, VoidType)
+ lookup k >>= \expected ->
+ infer e >>= \(s1, given)->
+ lift (unify expected given) >>= \s2->
+ let s = compose s2 s1 in
+ applySubst s >>|
+ 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
applySubst (compose s2 s1) >>|
pure (compose s2 s1, [v_:vs_])
-// mapM processGamma dcls//
-
-////add the infered type in Gamma to AST constructs
-//class processGamma a :: a -> Typing a//
-
-//instance processGamma VarDecl where
-// processGamma v=:(VarDecl p _ k e) =
-// gamma >>= \g -> case 'Map'.member k g of
-// False = undef
-// True = instantiate ('Map'.find k g) >>= \t->
-// pure (VarDecl p (Just t) k e)//
-
-//instance processGamma FunDecl where
-// processGamma v=:(FunDecl p k args _ vds stmts) =
-// gamma >>= \g -> case 'Map'.member k g of
-// False = undef
-// True = instantiate ('Map'.find k g) >>= \t->
-// pure (FunDecl p k args (Just t) vds stmts)
-
introduce :: String -> Typing Type
introduce k =
fresh >>= \tv ->