sem.icl

   1 implementation module sem
   2
   3 import qualified Data.Map as Map
   4
   5 from Data.Func import $
   6 from StdFunc import o
   7
   8 import Control.Monad
   9 import Data.Either
  10 import Data.Monoid
  11
  12 import StdString
  13 import StdList
  14 import StdMisc
  15 import StdEnum
  16 import RWST
  17 import GenEq
  18
  19 from Text import class Text(concat), instance Text String
  20
  21 import AST
  22
  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
  27 :: SemError
  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
  34         | Error String
  35
  36 variableStream :: [String]
  37 variableStream = map toString [1..]
  38
  39 sem :: AST -> SemOutput
  40 sem (AST fd) = Right (AST fd, 'Map'.newMap)
  41
  42 instance toString Scheme where
  43         toString (Forall x t) =
  44                 concat ["Forall ": map ((+++) "\n") x] +++ toString t
  45
  46 instance toString Gamma where
  47         toString mp =
  48                 concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
  49
  50 instance toString SemError where
  51         toString se = "SemError: "
  52
  53 uni :: Type Type -> Infer ()
  54 uni t1 t2 = tell [(t1, t2)]
  55
  56 inEnv :: (String, Scheme) (Infer a) -> (Infer a)
  57 inEnv (x, sc) m = local scope m
  58         where
  59                 scope e = 'Map'.put x sc ('Map'.del x e )
  60
  61 class infer a :: a -> Infer Type
  62
  63 instance infer Expr where
  64         infer (VarExpr _ vd) = undef
  65         infer (Op2Expr _ e1 op e2) = case op of
  66                 BiPlus = pure IntType
  67                 BiMinus = pure IntType
  68                 BiTimes = pure IntType
  69                 BiDivide = pure IntType
  70                 BiMod = pure IntType
  71                 BiLesser = pure IntType
  72                 BiGreater = pure IntType
  73                 BiLesserEq = pure IntType
  74                 BiGreaterEq = pure IntType
  75                 BiAnd = pure BoolType
  76                 BiOr = pure BoolType
  77                 BiEquals = infer e1
  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)
  90
  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]
  98 //:: Stmt
  99 //      = IfStmt Expr [Stmt] [Stmt]
 100 //      | WhileStmt Expr [Stmt]
 101 //      | AssStmt VarDef Expr
 102 //      | FunStmt FunCall
 103 //      | ReturnStmt (Maybe Expr)
 104 //:: Pos = {line :: Int, col :: Int}
 105 //:: AST = AST [VarDecl] [FunDecl]
 106 //:: VarDecl = VarDecl Pos Type String Expr
 107 //:: Type
 108 //      = TupleType (Type, Type)
 109 //      | ListType Type
 110 //      | IdType String
 111 //      | IntType
 112 //      | BoolType
 113 //      | CharType
 114 //      | VarType
 115 //    | VoidType
 116 //    | (->>) infixl 7 Type Type