2013-07-07 10:54:05 +00:00
|
|
|
module Type.Fragment where
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
import qualified Data.List as List
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
|
|
|
|
import Type.Type
|
|
|
|
import SourceSyntax.Pattern
|
2013-07-30 23:01:20 +00:00
|
|
|
import SourceSyntax.Location (none)
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
data Fragment = Fragment {
|
|
|
|
typeEnv :: Map.Map String Type,
|
|
|
|
vars :: [Variable],
|
|
|
|
typeConstraint :: TypeConstraint
|
|
|
|
} deriving Show
|
|
|
|
|
2013-07-30 23:01:20 +00:00
|
|
|
emptyFragment = Fragment Map.empty [] (none CTrue)
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
joinFragment f1 f2 = Fragment {
|
|
|
|
typeEnv = Map.union (typeEnv f1) (typeEnv f2),
|
|
|
|
vars = vars f1 ++ vars f2,
|
|
|
|
typeConstraint = typeConstraint f1 /\ typeConstraint f2
|
2013-07-23 12:59:53 +00:00
|
|
|
}
|
2013-07-03 12:35:51 +00:00
|
|
|
|
|
|
|
joinFragments = List.foldl' (flip joinFragment) emptyFragment
|
2013-07-23 12:59:53 +00:00
|
|
|
|
|
|
|
|
|
|
|
toScheme fragment =
|
|
|
|
Scheme [] (vars fragment) (typeConstraint fragment) (typeEnv fragment)
|