2013-07-07 10:54:05 +00:00
|
|
|
module Type.Environment where
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import Data.Map ((!))
|
|
|
|
import qualified Data.UnionFind.IO as UF
|
|
|
|
|
|
|
|
import Type.Type
|
|
|
|
|
|
|
|
data Environment = Environment {
|
|
|
|
constructor :: Map.Map String ([Variable], Type),
|
|
|
|
builtin :: Map.Map String Type,
|
|
|
|
value :: Map.Map String Type
|
|
|
|
}
|
|
|
|
|
|
|
|
initialEnvironment :: IO Environment
|
|
|
|
initialEnvironment = do
|
|
|
|
let mkPair name = fmap ((,) name . VarN) (namedVar name)
|
2013-07-08 14:47:44 +00:00
|
|
|
list <- mkPair "[_]"
|
|
|
|
int <- mkPair "Int"
|
|
|
|
prims <- mapM mkPair ["Float","Char","Bool","Element"]
|
|
|
|
let builtins = list : int : prims
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
cons <- do v <- flexibleVar
|
|
|
|
let vlist = TermN (App1 (snd list) (VarN v))
|
|
|
|
return ([v], VarN v ==> vlist ==> vlist)
|
|
|
|
|
2013-07-08 14:47:44 +00:00
|
|
|
nil <- do v <- flexibleVar
|
|
|
|
return ([v], TermN (App1 (snd list) (VarN v)))
|
|
|
|
|
|
|
|
let add = snd int ==> snd int ==> snd int
|
|
|
|
|
2013-07-03 12:35:51 +00:00
|
|
|
return $ Environment {
|
2013-07-08 14:47:44 +00:00
|
|
|
constructor = Map.fromList [("::", cons), ("[]", nil)],
|
2013-07-03 12:35:51 +00:00
|
|
|
builtin = Map.fromList builtins,
|
2013-07-08 14:47:44 +00:00
|
|
|
value = Map.empty -- Map.fromList [("+", add)]
|
2013-07-03 12:35:51 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
get :: Environment -> (Environment -> Map.Map String a) -> String -> a
|
2013-07-08 14:47:44 +00:00
|
|
|
get env subDict key = Map.findWithDefault err key (subDict env)
|
|
|
|
where
|
|
|
|
err = error $ "Could not find '" ++ key ++ "' in the type environment."
|