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 fd) = Right (AST fd, 'Map'.newMap)
42 instance toString Scheme where
43 toString (Forall x t) =
44 concat ["Forall ": map ((+++) "\n") x] +++ toString t
46 instance toString Gamma where
48 concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
50 instance toString SemError where
51 toString se = "SemError: "
53 uni :: Type Type -> Infer ()
54 uni t1 t2 = tell [(t1, t2)]
56 inEnv :: (String, Scheme) (Infer a) -> (Infer a)
57 inEnv (x, sc) m = local scope m
59 scope e = 'Map'.put x sc ('Map'.del x e )
61 class infer a :: a -> Infer Type
63 instance infer Expr where
64 infer (VarExpr _ vd) = undef
65 infer (Op2Expr _ e1 op e2) = case op of
67 BiMinus = pure IntType
68 BiTimes = pure IntType
69 BiDivide = pure IntType
71 BiLesser = pure IntType
72 BiGreater = pure IntType
73 BiLesserEq = pure IntType
74 BiGreaterEq = pure IntType
78 BiUnEqual = infer e1 // maybe check e2?
79 BiCons = infer e1 >>= \it1->pure $ ListType it1
80 infer (Op1Expr _ op e) = case op of
81 UnMinus = pure IntType
82 UnNegation = pure BoolType
83 infer (IntExpr _ _) = pure IntType
84 infer (CharExpr _ _) = pure CharType
85 infer (BoolExpr _ _) = pure BoolType
86 infer (FunExpr _ _ _ _) = undef
87 infer (EmptyListExpr _) = undef
88 infer (TupleExpr _ (e1, e2)) =
89 infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)
91 //:: VarDef = VarDef String [FieldSelector]
92 //:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
93 //:: Op1 = UnNegation | UnMinus
94 //:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
95 // BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
96 //:: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt]
97 //:: FunCall = FunCall String [Expr]
99 // = IfStmt Expr [Stmt] [Stmt]
100 // | WhileStmt Expr [Stmt]
101 // | AssStmt VarDef Expr
103 // | ReturnStmt (Maybe Expr)
104 //:: Pos = {line :: Int, col :: Int}
105 //:: AST = AST [VarDecl] [FunDecl]
106 //:: VarDecl = VarDecl Pos Type String Expr
108 // = TupleType (Type, Type)
116 // | (->>) infixl 7 Type Type