1 implementation module sem
3 import qualified Data.Map as Map
5 from Data.Func import $
6 from StdFunc import o, id
20 from Text import class Text(concat), instance Text String
24 :: Scheme = Forall [String] Type
25 :: Gamma :== 'Map'.Map String Scheme
26 :: Constraints :== [(Type, Type)]
27 :: Infer a :== RWST Gamma Constraints [String] (Either SemError) a
29 = ParseError Pos String
30 | UnifyError Pos Type Type
31 | FieldSelectorError Pos Type FieldSelector
32 | OperatorError Pos Op2 Type
33 | UndeclaredVariableError Pos String
34 | ArgumentMisMatchError Pos String
37 variableStream :: [String]
38 variableStream = map toString [1..]
40 sem :: AST -> SemOutput
41 sem (AST fd) = Right (AST fd, 'Map'.newMap)
43 instance toString Scheme where
44 toString (Forall x t) =
45 concat ["Forall ": map ((+++) "\n") x] +++ toString t
47 instance toString Gamma where
49 concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
51 instance toString SemError where
52 toString se = "SemError: "
54 uni :: Type Type -> Infer ()
55 uni t1 t2 = tell [(t1, t2)]
57 inEnv :: (String, Scheme) (Infer a) -> (Infer a)
58 inEnv (x, sc) m = local scope m
60 scope e = 'Map'.put x sc ('Map'.del x e )
63 fresh = (gets id) >>= \vars-> (put $ tail vars) >>| (pure $ IdType $ head vars)
65 class infer a :: a -> Infer Type
67 op2Type :: Op2 -> Infer Type
68 op2Type op | elem op [BiPlus, BiMinus, BiTimes, BiDivide, BiMod]
69 = pure (IntType ->> IntType ->> IntType)
70 | elem op [BiEquals, BiUnEqual]
71 = fresh >>= \t1-> fresh >>= \t2-> pure (t1 ->> t2 ->> BoolType)
72 | elem op [BiLesser, BiGreater, BiLesserEq, BiGreaterEq]
73 = pure (IntType ->> IntType ->> BoolType)
74 | elem op [BiAnd, BiOr]
75 = pure (BoolType ->> BoolType ->> BoolType)
77 = fresh >>= \t1-> pure (t1 ->> ListType t1 ->> ListType t1)
79 instance infer Expr where
80 infer (VarExpr _ vd) = undef
81 infer (Op2Expr _ e1 op e2) = case op of
83 BiMinus = pure IntType
84 BiTimes = pure IntType
85 BiDivide = pure IntType
87 BiLesser = pure IntType
88 BiGreater = pure IntType
89 BiLesserEq = pure IntType
90 BiGreaterEq = pure IntType
94 BiUnEqual = infer e1 // maybe check e2?
95 BiCons = infer e1 >>= \it1->pure $ ListType it1
96 infer (Op1Expr _ op e) = case op of
97 UnMinus = pure IntType
98 UnNegation = pure BoolType
99 infer (IntExpr _ _) = pure IntType
100 infer (CharExpr _ _) = pure CharType
101 infer (BoolExpr _ _) = pure BoolType
102 infer (FunExpr _ _ _ _) = undef
103 infer (EmptyListExpr _) = undef
104 infer (TupleExpr _ (e1, e2)) =
105 infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)
107 //:: VarDef = VarDef String [FieldSelector]
108 //:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
109 //:: Op1 = UnNegation | UnMinus
110 //:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
111 // BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
112 //:: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt]
113 //:: FunCall = FunCall String [Expr]
115 // = IfStmt Expr [Stmt] [Stmt]
116 // | WhileStmt Expr [Stmt]
117 // | AssStmt VarDef Expr
119 // | ReturnStmt (Maybe Expr)
120 //:: Pos = {line :: Int, col :: Int}
121 //:: AST = AST [VarDecl] [FunDecl]
122 //:: VarDecl = VarDecl Pos Type String Expr
124 // = TupleType (Type, Type)
132 // | (->>) infixl 7 Type Type