implementation module sem

import qualified Data.Map as Map
from Data.Func import $
import Data.Maybe
import Data.Either
import Data.Functor
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Identity
import StdMisc
from StdFunc import id, const
import StdString
import StdList

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

import AST
from parse import :: ParserOutput, :: Error

:: Gamma :== 'Map'.Map String Type
:: Env a :== (State Gamma (Either SemError a))

instance toString SemError where
	toString (ParseError p e) = concat [
		toString p,"SemError: ParseError: ", e]
	toString (Error e) = "SemError: " +++ e
	toString (UnifyError p t1 t2) = concat [
		toString p,
		"SemError: Cannot unify types. Expected: ",
		toString t1, ". Given: ", toString t2]

sem :: AST -> SemOutput
sem (AST vd fd)
# (eithervds, gamma) = runState (mapM semVarDecl vd) 'Map'.newMap
# (eitherfds, gamma) = runState (mapM semFunDecl fd) gamma
= case splitEithers eithervds of
	(Left errs) = Left $ errs ++ [x\\(Left x)<-eitherfds]
	(Right vds) = case splitEithers eitherfds of
		(Left errs) = Left errs
		(Right fds) = Right $ AST vds fds

splitEithers :: [Either a b] -> Either [a] [b]
splitEithers [] = Right []
splitEithers [Right x:xs] = splitEithers xs >>= \rest->Right [x:rest]
splitEithers xs = Left $ [x\\(Left x)<-xs]

semFunDecl :: FunDecl -> Env FunDecl
semFunDecl f = pure $ Right f

semVarDecl :: VarDecl -> Env VarDecl
semVarDecl v = pure $ Right v
//Right v
//semVarDecl vd=:(VarDecl pos type ident expr) = case unify type expr of
//	Left e = Left e
//	//TODO ident in de environment
//	Right e = Right $ pure vd
//
//typeExpr :: Expr -> Env Type
//typeExpr (IntExpr _ _) = Right $ pure IntType
//typeExpr (CharExpr _ _) = Right $ pure CharType
//typeExpr (BoolExpr _ _) = Right $ pure BoolType
//typeExpr (Op1Expr p UnNegation expr) = undef//typeExpr expr 
////	>>= \exprtype->case exprtype of
////		Right BoolType = Right $ pure BoolType
////		t = Left $ UnifyError p BoolType exprtype
//typeExpr (Op1Expr p UnMinus expr) = undef// typeExpr expr 
////	>>= \exprtype->case exprtype of
////		IntType = Right $ pure IntType
////		t = Left $ UnifyError p IntType exprtype
//// typeExpr (Op2Expr Pos Expr Op2 Expr) = undef
////typeExpr (FunExpr Pos FunCall
////typeExpr (EmptyListExpr Pos 
////typeExpr (TupleExpr Pos (Expr, Expr)
////typeExpr (VarExpr Pos VarDef) = undef
////
//class unify a :: Type a -> Env a
//
//instance unify Type where
//	unify IntType IntType = Right $ pure IntType
//	unify BoolType BoolType = Right $ pure BoolType
//	unify CharType CharType = Right $ pure CharType
//	unify _ _ = undef
//
//instance unify Expr where
//	unify type expr = case type of
//		_ ->> _ = Left $ ParseError (extrPos expr)
//			"Expression cannot be a higher order function. Yet..."
//		VoidType = Left $ ParseError (extrPos expr)
//			"Expression cannot be a Void type."
//		IdType _ = Left $ ParseError (extrPos expr)
//			"Expression cannot be an polymorf type."
//		TupleType (_, _) = undef
//		ListType _ = undef
//		IntType = undef
//		BoolType = undef
//		CharType = undef
//		VarType = undef
//
//extrPos :: Expr -> Pos
//extrPos (VarExpr p _) = p
//extrPos (Op2Expr p _ _ _) = p
//extrPos (Op1Expr p _ _) = p
//extrPos (IntExpr p _) = p
//extrPos (CharExpr p _) = p
//extrPos (BoolExpr p _) = p
//extrPos (FunExpr p _) = p
//extrPos (EmptyListExpr p) = p
//extrPos (TupleExpr p _) = p