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) = concat ["Forall ": map ((+++) "\n") x] +++ toString t
  44
  45 instance toString Gamma where
  46         toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
  47
  48 instance toString SemError where
  49         toString se = "SemError: "
  50
  51 uni :: Type Type -> Infer ()
  52 uni t1 t2 = tell [(t1, t2)]
  53
  54 inEnv :: (String, Scheme) (Infer a) -> (Infer a)
  55 inEnv (x, sc) m = local scope m
  56         where
  57                 scope e = 'Map'.put x sc ('Map'.del x e )
  58
  59 class infer a :: a -> Infer Type
  60
  61 instance infer Expr where
  62         infer (VarExpr _ vd) = undef
  63         infer (Op2Expr _ e1 op e2) = case op of
  64                 BiPlus = pure IntType
  65                 BiMinus = pure IntType
  66                 BiTimes = pure IntType
  67                 BiDivide = pure IntType
  68                 BiMod = pure IntType
  69                 BiLesser = pure IntType
  70                 BiGreater = pure IntType
  71                 BiLesserEq = pure IntType
  72                 BiGreaterEq = pure IntType
  73                 BiAnd = pure BoolType
  74                 BiOr = pure BoolType
  75                 BiEquals = infer e1
  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 _ _ _ _) = undef
  85         infer (EmptyListExpr _) = undef
  86         infer (TupleExpr _ (e1, e2)) =
  87                 infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)
  88
  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]
  96 //:: Stmt
  97 //      = IfStmt Expr [Stmt] [Stmt]
  98 //      | WhileStmt Expr [Stmt]
  99 //      | AssStmt VarDef Expr
 100 //      | FunStmt FunCall
 101 //      | ReturnStmt (Maybe Expr)
 102 //:: Pos = {line :: Int, col :: Int}
 103 //:: AST = AST [VarDecl] [FunDecl]
 104 //:: VarDecl = VarDecl Pos Type String Expr
 105 //:: Type
 106 //      = TupleType (Type, Type)
 107 //      | ListType Type
 108 //      | IdType String
 109 //      | IntType
 110 //      | BoolType
 111 //      | CharType
 112 //      | VarType
 113 //    | VoidType
 114 //    | (->>) infixl 7 Type Type