type Symbol = String data FAE = Number Integer| Boolean Bool| Add FAE FAE| Sub FAE FAE| Id Symbol| Fun { funParam::Symbol, argType:: TE, funBody::FAE }| App { funExp::FAE, argExp::FAE}| If { testExp::FAE, thenExp::FAE, elseExp::FAE } deriving (Show, Eq) data TE = NumTE | BoolTE | ArrowTE {arg :: TE, result :: TE} deriving (Show,Eq) data Type = NumT | BoolT | ArrowT {argT :: Type, resultT :: Type} deriving (Show,Eq) data TypeBind = Bind { bName :: Symbol, bType :: Type } type TypeEnv = [TypeBind] get_type name [] = error "free variable, no type" get_type name (x:xs) | name == (bName x) = (bType x) | otherwise = get_type name xs parse_type NumTE = NumT parse_type BoolTE = BoolT parse_type (ArrowTE l r) = ArrowT (parse_type l) (parse_type r) typecheck::FAE->TypeEnv->Type typecheck (Number _) _ = NumT typecheck (Boolean _) _ = BoolT typecheck (Add l r) env = let ltype = typecheck l env rtype = typecheck r env in if ltype == NumT && rtype == NumT then NumT else error "num num!" typecheck (Id name) env = get_type name env typecheck (Fun name te body) env = let arg_type = parse_type te in ArrowT arg_type (typecheck body $ Bind name arg_type : env) typecheck (App fn arg) env = let fntype = typecheck fn env argtype = typecheck arg env in case fntype of ArrowT fnarg_type result_type |argtype==fnarg_type -> result_type |otherwise -> error "arg type mismatch" _ -> error "wth?" result1 = typecheck (App (Fun "x" NumTE (Add (Id "x") (Number 12))) (Add (Number 1) (Number 17))) [] --