1 implementation module sem
3 import qualified Data.Map as Map
5 from Data.Func import $
19 from Text import class Text(concat), instance Text String
23 :: Scheme = Forall [String] Type
24 :: Gamma :== 'Map'.Map String Scheme
25 :: Constraints :== [(Type, Type)]
26 :: Infer a :== RWST Gamma Constraints [String] (Either SemError) a
28 = ParseError Pos String
29 | UnifyError Pos Type Type
30 | FieldSelectorError Pos Type FieldSelector
31 | OperatorError Pos Op2 Type
32 | UndeclaredVariableError Pos String
33 | ArgumentMisMatchError Pos String
36 variableStream :: [String]
37 variableStream = map toString [1..]
39 sem :: AST -> SemOutput
40 sem (AST vd fd) = Right $ (AST vd fd, 'Map'.newMap)
42 instance toString Scheme where
43 toString (Forall x t) = concat ["Forall ": map ((+++) "\n") x] +++ toString t
45 instance toString Gamma where
46 toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
48 instance toString SemError where
49 toString se = "SemError: "
51 uni :: Type Type -> Infer ()
52 uni t1 t2 = tell [(t1, t2)]
54 inEnv :: (String, Scheme) (Infer a) -> (Infer a)
55 inEnv (x, sc) m = local scope m
57 scope e = 'Map'.put x sc ('Map'.del x e )
59 class infer a :: a -> Infer Type
61 instance infer Expr where
62 infer (VarExpr _ vd) = undef
63 infer (Op2Expr _ e1 op e2) = case op of
65 BiMinus = pure IntType
66 BiTimes = pure IntType
67 BiDivide = pure IntType
69 BiLesser = pure IntType
70 BiGreater = pure IntType
71 BiLesserEq = pure IntType
72 BiGreaterEq = pure IntType
76 BiUnEqual = infer e1 // maybe check e2?
77 BiCons = infer e1 >>= \it1->pure $ ListType it1
78 infer (Op1Expr _ op e) = case op of
79 UnMinus = pure IntType
80 UnNegation = pure BoolType
81 infer (IntExpr _ _) = pure IntType
82 infer (CharExpr _ _) = pure CharType
83 infer (BoolExpr _ _) = pure BoolType
84 infer (FunExpr _ fc) = undef
85 infer (EmptyListExpr _) = undef
86 infer (TupleExpr _ (e1, e2)) =
87 infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)
89 //:: VarDef = VarDef String [FieldSelector]
90 //:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
91 //:: Op1 = UnNegation | UnMinus
92 //:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
93 // BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
94 //:: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt]
95 //:: FunCall = FunCall String [Expr]
97 // = IfStmt Expr [Stmt] [Stmt]
98 // | WhileStmt Expr [Stmt]
99 // | AssStmt VarDef Expr
101 // | ReturnStmt (Maybe Expr)
102 //:: Pos = {line :: Int, col :: Int}
103 //:: AST = AST [VarDecl] [FunDecl]
104 //:: VarDecl = VarDecl Pos Type String Expr
106 // = TupleType (Type, Type)
114 // | (->>) infixl 7 Type Type