implementation module sem

import qualified Data.Map as Map

from Data.Func import $
from StdFunc import o

import Control.Monad
import Data.Either
import Data.Monoid

import StdString
import StdList
import StdMisc
import StdEnum
import RWST
import GenEq

from Text import class Text(concat), instance Text String

import AST

:: Scheme = Forall [String] Type
:: Gamma :== 'Map'.Map String Scheme
:: Constraints :== [(Type, Type)]
:: Infer a :== RWST Gamma Constraints [String] (Either SemError) a
:: SemError
	= ParseError Pos String 
	| UnifyError Pos Type Type 
    | FieldSelectorError Pos Type FieldSelector 
	| OperatorError Pos Op2 Type
    | UndeclaredVariableError Pos String
    | ArgumentMisMatchError Pos String
	| Error String

variableStream :: [String]
variableStream = map toString [1..]

sem :: AST -> SemOutput
sem (AST fd) = Right $ (AST fd, 'Map'.newMap)

instance toString Scheme where
	toString (Forall x t) = concat ["Forall ": map ((+++) "\n") x] +++ toString t

instance toString Gamma where
	toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]

instance toString SemError where
	toString se = "SemError: "

uni :: Type Type -> Infer ()
uni t1 t2 = tell [(t1, t2)]

inEnv :: (String, Scheme) (Infer a) -> (Infer a)
inEnv (x, sc) m = local scope m
	where
		scope e = 'Map'.put x sc ('Map'.del x e )

class infer a :: a -> Infer Type

instance infer Expr where
	infer (VarExpr _ vd) = undef
	infer (Op2Expr _ e1 op e2) = case op of
		BiPlus = pure IntType
		BiMinus = pure IntType
		BiTimes = pure IntType
		BiDivide = pure IntType
		BiMod = pure IntType
		BiLesser = pure IntType
		BiGreater = pure IntType
		BiLesserEq = pure IntType
		BiGreaterEq = pure IntType
		BiAnd = pure BoolType
		BiOr = pure BoolType
		BiEquals = infer e1
		BiUnEqual = infer e1 // maybe check e2?
		BiCons = infer e1 >>= \it1->pure $ ListType it1
	infer (Op1Expr _ op e) = case op of
		UnMinus = pure IntType
		UnNegation = pure BoolType
	infer (IntExpr _ _) = pure IntType
	infer (CharExpr _ _) = pure CharType
	infer (BoolExpr _ _) = pure BoolType
	infer (FunExpr _ _ _ _) = undef
	infer (EmptyListExpr _) = undef
	infer (TupleExpr _ (e1, e2)) =
		infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)

//:: VarDef = VarDef String [FieldSelector]
//:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
//:: Op1 = UnNegation | UnMinus
//:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
//	BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
//:: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt]
//:: FunCall = FunCall String [Expr]
//:: Stmt 
//	= IfStmt Expr [Stmt] [Stmt]
//	| WhileStmt Expr [Stmt]
//	| AssStmt VarDef Expr
//	| FunStmt FunCall
//	| ReturnStmt (Maybe Expr)
//:: Pos = {line :: Int, col :: Int}
//:: AST = AST [VarDecl] [FunDecl]
//:: VarDecl = VarDecl Pos Type String Expr
//:: Type 
//	= TupleType (Type, Type)
//	| ListType Type
//	| IdType String 
//	| IntType 
//	| BoolType
//	| CharType
//	| VarType
//    | VoidType
//    | (->>) infixl 7 Type Type