xilocaml / TypeEnvironment.hs

module TypeEnvironment where
import qualified Data.Map as Map
import Control.Monad.State
import Data.Maybe
import ErrM
import AbsXilocaml
import Common

-- Extended type system with two types of polymorphic values
-- UPoly is polymorphic type
-- UTerm is yet unspecified type and will become another type
-- (possibly UPoly) after type inference process
data UType =
	UFun { argType :: UType, resType :: UType }
	| UList { elemType :: UType }
	| UInt
	| UFloat
	| UBool
	| UPoly Int
	| UTerm Int
	deriving (Eq,Ord,Show)


type ResultType = Err Type

-- Environment consists of:
-- * map: all visible identifiers -> their current UType.
-- * map: currently used UTerms -> their computed type
--   This map doesn't have UTerms for which no value was computed.
--   It might contain other UTypes only in internals of some functions,
--   for example to remember which UTerm is created from which UPoly.
-- * number for next fresh UTerm
data TypeEnvironment = TypeEnvironment { idEnv :: Map.Map Ident UType, tEnv :: Map.Map UType UType, nextN :: Int }
	deriving (Eq,Ord,Show)
type EnvType = StateT TypeEnvironment Err


startTEnv :: TypeEnvironment
startTEnv = TypeEnvironment Map.empty Map.empty 0


assignId :: Ident -> UType -> EnvType UType
assignId k v = do
	modify $ \s -> TypeEnvironment (Map.insert k v $ idEnv s) (tEnv s) (nextN s)
	return v

assignType :: UType -> UType -> EnvType UType
assignType k v = do
	modify $ \s -> TypeEnvironment (idEnv s) (Map.insert k v $ tEnv s) (nextN s)
	return v


simpleLookupType :: UType -> EnvType (Maybe UType)
simpleLookupType k = gets $ Map.lookup k . tEnv

lookupId :: Ident -> EnvType (Maybe UType)
lookupId k = do
	t <- gets $ Map.lookup k . idEnv
	case t of
		Nothing -> return t
		Just x -> liftM Just $ lookupType x

-- Looks up type of variable while compressing paths of term equations
lookupType :: UType -> EnvType UType
lookupType t = case t of
	UTerm _ -> do
		t' <- simpleLookupType t
		case t' of
			Nothing -> return t
			Just x -> lookupType x >>= assignType t
	UList t' -> liftM UList $ lookupType t'
	UFun t1 t2 -> liftM2 UFun (lookupType t1) (lookupType t2)
	_ -> return t


nextTerm :: EnvType UType
nextTerm = do
	TypeEnvironment i t n <- get
	put $ TypeEnvironment i t (n+1)
	return (UTerm n)


getIdentifiers :: EnvType (Map.Map Ident UType)
getIdentifiers = gets idEnv

putIdentifiers :: Map.Map Ident UType -> EnvType ()
putIdentifiers i = modify $ \s -> TypeEnvironment i (tEnv s) (nextN s)

assignNewId :: Ident -> EnvType UType
assignNewId ident = nextTerm >>= assignId ident


-- Converts UTerm's to UPoly's using the same numeration.
convertTermToPoly :: UType -> EnvType UType
convertTermToPoly t = case t of
	UFun t1 t2 ->
		liftM2 UFun (convertTermToPoly t1) (convertTermToPoly t2)
	UList tl ->
		liftM UList (convertTermToPoly tl)
	UTerm term -> assignType t $ UPoly term
	_ -> return t


-- Converts terms in type of identifier into UPoly's.
convertIdTypeToPoly :: Ident -> EnvType UType
convertIdTypeToPoly ident = do
	t <- liftM fromJust $ lookupId ident
	t' <- convertTermToPoly t
	assignId ident t'


cleanEnvOfNonTerms :: EnvType ()
cleanEnvOfNonTerms = modify $ \s -> TypeEnvironment (idEnv s) (Map.filterWithKey isUTerm $ tEnv s) (nextN s)
	where
		isUTerm :: UType -> t -> Bool
		isUTerm (UTerm _) _ = True
		isUTerm _ _ = False


convertPolyToTerm :: UType -> EnvType UType
convertPolyToTerm t = do
		v <- lookupType t >>= convertPolyToTermImpl
		cleanEnvOfNonTerms
		return v
	where
		convertPolyToTermImpl :: UType -> EnvType UType
		convertPolyToTermImpl t = case t of
			UFun t1 t2 -> liftM2 UFun (convertPolyToTermImpl t1) (convertPolyToTermImpl t2)
			UList tl -> liftM UList (convertPolyToTermImpl tl)
			UPoly _ -> do
				t' <- simpleLookupType t
				case t' of
					Nothing -> nextTerm >>= assignType t
					Just x -> return x
			_ -> return t


-- Converts Type to UType. TPoly are changed to fresh UTerm's.
convertTypeToUType :: Type -> EnvType UType
convertTypeToUType t = let
		t' = evalState (convertTypeToPolyUType t) startMapEnv
	in convertPolyToTerm t'

type TypeToPolyEnvironment = Map.Map OPolyIdent UType
convertTypeToPolyUType :: Type -> State TypeToPolyEnvironment UType
convertTypeToPolyUType t = case t of
	TFun t1 t2 ->
		liftM2 UFun (convertTypeToPolyUType t1) (convertTypeToPolyUType t2)
	TList t' ->
		liftM UList (convertTypeToPolyUType t')
	TInt -> return UInt
	TFloat -> return UFloat
	TBool -> return UBool
	TPoly p -> do
		s <- get
		t' <- lookupVar p
		case t' of
			Nothing -> assignVar p (UPoly $ Map.size s)
			Just x -> return x


-- Converts UType to Type. Both UTerm's and UPoly's are changed to TPoly.
convertUTypeToType :: UType -> Type
convertUTypeToType t = case t of
	UFun t1 t2 -> TFun (convertUTypeToType t1) (convertUTypeToType t2)
	UList t' -> TList $ convertUTypeToType t'
	UInt -> TInt
	UFloat -> TFloat
	UBool -> TBool
	UPoly p -> TPoly $ OPolyIdent $ show p
	UTerm p -> TPoly $ OPolyIdent $ show p
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.