2012-05-12 04:27:59 +00:00
|
|
|
|
2012-08-09 14:38:18 +00:00
|
|
|
module Types.Constrain (constrain) where
|
2012-05-11 10:28:56 +00:00
|
|
|
|
2012-08-01 23:37:37 +00:00
|
|
|
import Control.Arrow (second)
|
2012-08-09 14:38:18 +00:00
|
|
|
import Control.Monad (liftM,mapM,zipWithM,foldM)
|
2012-05-12 04:27:59 +00:00
|
|
|
import Control.Monad.State (evalState)
|
2013-04-04 08:09:35 +00:00
|
|
|
import Data.Char (isDigit)
|
2012-12-25 08:39:18 +00:00
|
|
|
import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf)
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import qualified Data.Set as Set
|
2012-11-23 04:30:37 +00:00
|
|
|
|
|
|
|
import Ast
|
2013-05-29 23:20:38 +00:00
|
|
|
import Located
|
2012-05-12 04:27:59 +00:00
|
|
|
import Guid
|
2012-11-23 04:30:37 +00:00
|
|
|
|
|
|
|
import Types.Types
|
2013-04-10 02:50:56 +00:00
|
|
|
import qualified Types.Substitutions as Subs
|
2012-08-09 14:38:18 +00:00
|
|
|
|
2013-05-28 13:48:25 +00:00
|
|
|
import System.IO.Unsafe
|
|
|
|
|
2012-05-11 10:28:56 +00:00
|
|
|
beta = VarT `liftM` guid
|
|
|
|
unionA = Map.unionWith (++)
|
|
|
|
unionsA = Map.unionsWith (++)
|
|
|
|
|
2013-05-28 22:59:22 +00:00
|
|
|
getAliases :: [(String,ImportMethod)] -> [(String,Scheme)] -> [(String,Scheme)]
|
2013-04-08 00:55:34 +00:00
|
|
|
getAliases imports hints = concatMap aliasesFrom imports
|
2013-05-28 22:59:22 +00:00
|
|
|
where
|
|
|
|
-- Get the names of values that are now in scope after a particular
|
|
|
|
-- import statement.
|
|
|
|
aliasesFrom :: (String,ImportMethod) -> [(String,Scheme)]
|
|
|
|
aliasesFrom (name,method) =
|
|
|
|
let values = concatMap (getValue name) hints
|
|
|
|
prefixed name = map (\(n,t) -> (name ++ "." ++ n, t)) values
|
|
|
|
in case method of
|
|
|
|
As alias -> prefixed alias
|
|
|
|
Hiding vs -> prefixed name ++ filter (\(n,t) -> n `notElem` vs) values
|
|
|
|
Importing vs -> prefixed name ++ filter (\(n,t) -> n `elem` vs) values
|
|
|
|
|
|
|
|
-- Take a module name and a type annotation. Return the unprefxed
|
|
|
|
-- type annotation: getValue "List" ("List.map",t) == [("map",t)]
|
|
|
|
getValue :: String -> (String,Scheme) -> [(String,Scheme)]
|
|
|
|
getValue inModule (name,tipe) =
|
|
|
|
case inModule `isPrefixOf` name of
|
|
|
|
True -> [ (drop (length inModule + 1) name, tipe) ]
|
|
|
|
False -> []
|
2012-10-21 11:50:40 +00:00
|
|
|
|
2013-04-08 00:55:34 +00:00
|
|
|
findAmbiguous hints assumptions continue =
|
|
|
|
let potentialDups = map head . filter (\g -> length g > 1) . group . sort $
|
|
|
|
filter (elem '.') hints
|
|
|
|
dups = filter (\k -> Map.member k assumptions) potentialDups
|
|
|
|
in case dups of
|
|
|
|
n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++
|
|
|
|
"' could refer to " ++
|
|
|
|
intercalate ", " (filter (isSuffixOf n) hints)
|
|
|
|
_ -> continue
|
2012-10-21 11:50:40 +00:00
|
|
|
|
2013-02-05 11:20:55 +00:00
|
|
|
mergeSchemes :: [Map.Map String Scheme]
|
|
|
|
-> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)
|
|
|
|
mergeSchemes schmss = do (ass,css,sss) <- unzip3 `liftM` mapM split kvs
|
|
|
|
return (Map.unions ass, Set.unions css, Map.unions sss)
|
|
|
|
where
|
|
|
|
kvs = Map.toList $ Map.unionsWith (++) (map (Map.map (:[])) schmss)
|
|
|
|
split (k,vs) =
|
|
|
|
let ps = zipWith (\s v -> (s++k,v)) (map (flip replicate '_') [0..]) vs
|
2013-05-29 23:20:38 +00:00
|
|
|
eq t u = L (Just $ msg ++ k) NoSpan (VarT t :=: VarT u)
|
2013-02-05 11:20:55 +00:00
|
|
|
msg = "the definition of "
|
|
|
|
in do xs <- mapM (\_ -> guid) vs
|
|
|
|
return ( Map.fromList $ zip (map fst ps) (map (:[]) xs)
|
|
|
|
, case xs of
|
|
|
|
t:ts -> Set.fromList $ zipWith eq (t:ts) ts
|
|
|
|
[] -> Set.empty
|
|
|
|
, Map.fromList ps )
|
|
|
|
|
2012-10-21 11:50:40 +00:00
|
|
|
constrain typeHints (Module _ _ imports stmts) = do
|
|
|
|
(ass,css,schemess) <- unzip3 `liftM` mapM stmtGen stmts
|
2013-04-08 00:55:34 +00:00
|
|
|
aliasHints <- getAliases imports `liftM` typeHints
|
2013-02-05 11:20:55 +00:00
|
|
|
(as', cs', schemes) <- mergeSchemes schemess
|
|
|
|
let constraints = Set.unions (cs':css)
|
|
|
|
as = unionsA (as':ass)
|
|
|
|
allHints = Map.union schemes (Map.fromList aliasHints)
|
|
|
|
insert as n = do v <- guid; return $ Map.insertWith' (\_ x -> x) n [v] as
|
|
|
|
assumptions <- foldM insert as (Map.keys schemes)
|
2013-04-08 00:55:34 +00:00
|
|
|
findAmbiguous (map fst aliasHints) assumptions $ do
|
2013-05-29 23:20:38 +00:00
|
|
|
let f k s vs = map (\v -> L (Just k) NoSpan $ v :<<: s) vs
|
2012-12-02 04:42:28 +00:00
|
|
|
cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions
|
|
|
|
escapees = Map.keys $ Map.difference assumptions allHints
|
2013-05-28 22:59:22 +00:00
|
|
|
msg = "Warning! Type-checker could not find variables:\n" ++ intercalate ", " escapees
|
2013-02-27 07:33:47 +00:00
|
|
|
return $ case escapees of
|
2013-05-28 13:48:25 +00:00
|
|
|
[] -> Right (Set.toList constraints ++ cs)
|
2013-05-28 22:59:22 +00:00
|
|
|
_ -> unsafePerformIO (putStrLn msg) `seq` Right (Set.toList constraints ++ cs)
|
|
|
|
--_ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)
|
2012-05-11 10:28:56 +00:00
|
|
|
|
2012-12-25 08:39:18 +00:00
|
|
|
type TVarMap = Map.Map String [X]
|
2013-05-29 23:20:38 +00:00
|
|
|
type ConstraintSet = Set.Set (Located Constraint)
|
2012-12-25 08:39:18 +00:00
|
|
|
|
2013-05-29 23:20:38 +00:00
|
|
|
loc e span = L (Just $ show e) span
|
2012-12-25 08:39:18 +00:00
|
|
|
|
|
|
|
gen :: CExpr -> GuidCounter (TVarMap, ConstraintSet, Type)
|
2013-05-29 23:20:38 +00:00
|
|
|
gen (L _ span expr) =
|
|
|
|
let loc' = L (Just $ show expr) span in
|
2012-12-25 08:39:18 +00:00
|
|
|
case expr of
|
|
|
|
Var x ->
|
|
|
|
do b <- guid
|
|
|
|
return (Map.singleton x [b], Set.empty, VarT b)
|
|
|
|
|
|
|
|
App e1 e2 ->
|
|
|
|
do (a1,c1,t1) <- gen e1
|
|
|
|
(a2,c2,t2) <- gen e2
|
|
|
|
b <- beta
|
|
|
|
return ( unionA a1 a2
|
|
|
|
, Set.unions [c1,c2
|
2013-05-29 23:20:38 +00:00
|
|
|
,Set.singleton . loc' $ t1 :=: (LambdaT t2 b)]
|
2012-12-25 08:39:18 +00:00
|
|
|
, b )
|
|
|
|
|
|
|
|
Lambda x e ->
|
|
|
|
do (a,c,t) <- gen e
|
|
|
|
b <- beta
|
|
|
|
v <- guid
|
|
|
|
return ( Map.delete x a
|
|
|
|
, Set.union c . Set.fromList .
|
2013-05-29 23:20:38 +00:00
|
|
|
map (\x -> loc' $ VarT x :=: b) $
|
2012-12-25 08:39:18 +00:00
|
|
|
Map.findWithDefault [v] x a
|
|
|
|
, LambdaT b t )
|
|
|
|
|
|
|
|
Let defs e ->
|
|
|
|
do (as,cs,t) <- gen e
|
|
|
|
(ass, schemes) <- liftM unzip (mapM defScheme defs)
|
|
|
|
let assumptions = unionsA (as:ass)
|
|
|
|
getName d = case d of FnDef f _ _ -> f
|
|
|
|
OpDef op _ _ _ -> op
|
2013-06-03 07:44:45 +00:00
|
|
|
TypeAnnotation n _ -> n
|
2012-12-25 08:39:18 +00:00
|
|
|
names = map getName defs
|
|
|
|
genCs name s = do
|
|
|
|
v <- guid
|
|
|
|
let vs = Map.findWithDefault [v] name assumptions
|
2013-05-29 23:20:38 +00:00
|
|
|
return $ map (\x -> loc name span $ x :<<: s) vs
|
2012-12-25 08:39:18 +00:00
|
|
|
cs' <- zipWithM genCs names schemes
|
|
|
|
return ( foldr Map.delete assumptions names
|
|
|
|
, Set.union (Set.fromList . concat $ cs') cs
|
|
|
|
, t )
|
|
|
|
|
|
|
|
Case e cases ->
|
|
|
|
do (as,cs,t) <- gen e
|
|
|
|
(ass,css,ts) <- liftM unzip3 $ mapM (caseGen t) cases
|
|
|
|
return ( unionsA $ as:ass
|
|
|
|
, let cases' = map snd cases
|
2013-05-29 23:20:38 +00:00
|
|
|
locs = zipWith epos cases' (tail cases')
|
2012-12-25 08:39:18 +00:00
|
|
|
csts = zipWith (:=:) ts (tail ts)
|
2013-05-29 23:20:38 +00:00
|
|
|
cs' = Set.fromList (zipWith ($) locs csts)
|
2012-12-25 08:39:18 +00:00
|
|
|
in Set.unions $ cs' : cs : css
|
|
|
|
, head ts)
|
|
|
|
|
|
|
|
If e1 e2 e3 ->
|
|
|
|
do (a1,c1,t1) <- gen e1
|
|
|
|
(a2,c2,t2) <- gen e2
|
|
|
|
(a3,c3,t3) <- gen e3
|
|
|
|
return ( unionsA [a1,a2,a3]
|
2013-05-29 23:20:38 +00:00
|
|
|
, let c4 = Set.fromList [ loc e1 span (t1 :=: bool)
|
|
|
|
, loc' (t2 :=: t3) ]
|
2012-12-25 08:39:18 +00:00
|
|
|
in Set.unions [c1,c2,c3,c4]
|
|
|
|
, t2 )
|
|
|
|
|
|
|
|
Data name es ->
|
2013-05-29 23:20:38 +00:00
|
|
|
gen $ foldl' (\f x -> epos f x $ App f x) (loc' $ Var name) es
|
2012-12-25 08:39:18 +00:00
|
|
|
|
|
|
|
Binop op e1 e2 ->
|
2013-05-29 23:20:38 +00:00
|
|
|
gen $ loc' (App (loc' $ App (loc' $ Var op) e1) e2)
|
2012-12-25 08:39:18 +00:00
|
|
|
|
|
|
|
Access e label ->
|
|
|
|
do (as,cs,rtype) <- gen e
|
|
|
|
t <- beta
|
|
|
|
rtype' <- beta
|
|
|
|
let fs = Map.singleton label [t]
|
2013-05-29 23:20:38 +00:00
|
|
|
c = (loc' (RecordT fs rtype' :=: rtype))
|
2012-12-25 08:39:18 +00:00
|
|
|
return (as, Set.insert c cs, t)
|
|
|
|
|
2012-12-26 22:07:09 +00:00
|
|
|
Remove e x ->
|
|
|
|
do (as,cs,rtype) <- gen e
|
2012-12-25 09:45:02 +00:00
|
|
|
t <- beta
|
|
|
|
rtype' <- beta
|
2013-05-29 23:20:38 +00:00
|
|
|
let c = (loc' (RecordT (Map.singleton x [t]) rtype' :=: rtype))
|
2012-12-26 22:07:09 +00:00
|
|
|
return (as, Set.insert c cs, rtype')
|
|
|
|
|
|
|
|
Insert e x v ->
|
|
|
|
do (eas,ecs,etype) <- gen e
|
|
|
|
(vas,vcs,vtype) <- gen v
|
|
|
|
return ( unionA eas vas
|
|
|
|
, Set.union ecs vcs
|
|
|
|
, RecordT (Map.singleton x [vtype]) etype )
|
|
|
|
|
|
|
|
Modify record fields ->
|
|
|
|
do (ras,rcs,rtype) <- gen record
|
|
|
|
(ass,css,newTs) <- unzip3 `liftM` mapM gen (map snd fields)
|
|
|
|
oldTs <- mapM (\_ -> beta) fields
|
|
|
|
rtype' <- beta
|
|
|
|
let rT ts = RecordT (recordT (zip (map fst fields) ts)) rtype'
|
2013-05-29 23:20:38 +00:00
|
|
|
c = Set.singleton (loc' (rtype :=: rT oldTs))
|
2012-12-26 22:07:09 +00:00
|
|
|
return ( unionsA (ras:ass), Set.unions (c : rcs : css), rT newTs )
|
2012-12-25 09:45:02 +00:00
|
|
|
|
2012-12-25 08:39:18 +00:00
|
|
|
Record fields ->
|
|
|
|
let insert label tipe = Map.insertWith (++) label [tipe]
|
|
|
|
getScheme (f,args,e) = do
|
|
|
|
(as, _, (label, Forall _ cs tipe)) <- defGenHelp f args e
|
|
|
|
return (as, cs, insert label tipe)
|
|
|
|
in do (ass, css, fs) <- unzip3 `liftM` mapM getScheme fields
|
|
|
|
return ( unionsA ass
|
|
|
|
, Set.fromList (concat css)
|
|
|
|
, RecordT (foldr ($) Map.empty fs) EmptyRecord )
|
|
|
|
|
2013-05-29 23:20:38 +00:00
|
|
|
Range e1@(L w1 s1 _) e2@(L w2 s2 _) ->
|
2012-12-25 08:39:18 +00:00
|
|
|
do (a1,c1,t1) <- gen e1
|
|
|
|
(a2,c2,t2) <- gen e2
|
|
|
|
return ( unionsA [a1,a2]
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.unions [ c1, c2, Set.fromList [ L w1 s1 (t1 :=: int)
|
|
|
|
, L w1 s2 (t2 :=: int) ] ]
|
2012-12-25 08:39:18 +00:00
|
|
|
, listOf int )
|
|
|
|
|
|
|
|
MultiIf ps -> do (ass,css,t:ts) <- unzip3 `liftM` mapM genPair ps
|
2013-05-29 23:20:38 +00:00
|
|
|
let cs = Set.fromList (map (loc' . (t :=:)) ts)
|
2012-12-25 08:39:18 +00:00
|
|
|
return (unionsA ass, Set.unions (cs:css), t)
|
2013-05-29 23:20:38 +00:00
|
|
|
where genPair (b@(L t s _),e) = do
|
2012-12-25 08:39:18 +00:00
|
|
|
(a1,c1,t1) <- gen b
|
|
|
|
(a2,c2,t2) <- gen e
|
|
|
|
return ( unionsA [a1,a2]
|
|
|
|
, Set.unions [ c1, c2
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.singleton (L t s (t1 :=: bool)) ]
|
2012-12-25 08:39:18 +00:00
|
|
|
, t2 )
|
|
|
|
|
|
|
|
IntNum _ -> do t <- beta
|
2013-05-29 23:20:38 +00:00
|
|
|
return (Map.empty, Set.singleton (loc' $ t :<: number), t)
|
2012-12-25 08:39:18 +00:00
|
|
|
|
|
|
|
FloatNum _ -> primitive float
|
|
|
|
Chr _ -> primitive char
|
|
|
|
Str _ -> primitive string
|
|
|
|
Boolean _ -> primitive bool
|
|
|
|
Markdown _ -> primitive element
|
2013-02-04 10:56:22 +00:00
|
|
|
|
2012-05-11 10:28:56 +00:00
|
|
|
|
2012-12-25 08:39:18 +00:00
|
|
|
primitive :: Type -> GuidCounter (TVarMap, ConstraintSet, Type)
|
2012-05-11 10:28:56 +00:00
|
|
|
primitive t = return (Map.empty, Set.empty, t)
|
2012-07-21 23:48:51 +00:00
|
|
|
|
2012-12-25 08:39:18 +00:00
|
|
|
caseGen :: Type
|
|
|
|
-> (Pattern, CExpr)
|
|
|
|
-> GuidCounter (TVarMap, ConstraintSet, Type)
|
2013-05-29 23:20:38 +00:00
|
|
|
caseGen tipe (p, ce@(L _ span e)) = do
|
2013-02-05 11:20:55 +00:00
|
|
|
(as ,cs ,t) <- gen ce
|
2013-05-29 23:20:38 +00:00
|
|
|
(as',cs',_) <- patternGen (loc p span) tipe as p
|
2013-02-05 11:20:55 +00:00
|
|
|
return ( as', Set.union cs cs', t )
|
2012-08-09 14:38:18 +00:00
|
|
|
|
2013-05-29 23:20:38 +00:00
|
|
|
patternGen :: (Constraint -> Located Constraint)
|
2013-04-07 13:46:46 +00:00
|
|
|
-> Type -- Type of e in `case e of ...`
|
2013-02-05 11:20:55 +00:00
|
|
|
-> TVarMap
|
2012-12-25 08:39:18 +00:00
|
|
|
-> Pattern
|
2013-02-05 11:20:55 +00:00
|
|
|
-> GuidCounter (TVarMap, ConstraintSet, Type)
|
2013-05-29 23:20:38 +00:00
|
|
|
patternGen loc tipe as pattern =
|
2013-02-05 11:20:55 +00:00
|
|
|
case pattern of
|
2013-04-07 13:46:46 +00:00
|
|
|
PAnything -> do b <- beta ; return ( as, Set.empty, b )
|
2013-02-05 11:20:55 +00:00
|
|
|
PVar v -> do
|
|
|
|
b <- beta
|
2013-05-29 23:20:38 +00:00
|
|
|
let cs = map (loc . (b :=:) . VarT) (Map.findWithDefault [] v as)
|
|
|
|
return ( Map.delete v as, Set.fromList (loc (b :=: tipe) : cs), b )
|
2013-02-05 11:20:55 +00:00
|
|
|
PData name ps -> do
|
|
|
|
constr <- guid
|
|
|
|
output <- beta
|
|
|
|
let step (as,cs,tipe) p = do b <- beta
|
2013-05-29 23:20:38 +00:00
|
|
|
(as',cs',t) <- patternGen loc b as p
|
2013-02-05 11:20:55 +00:00
|
|
|
return (as', Set.union cs cs', t ==> tipe)
|
|
|
|
(as',cs, t) <- foldM step (as,Set.empty,tipe) (reverse ps)
|
|
|
|
return ( Map.insert name [constr] as'
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.insert (loc (VarT constr :=: t)) cs
|
2013-02-05 11:20:55 +00:00
|
|
|
, output )
|
2013-04-07 13:46:46 +00:00
|
|
|
PRecord fs ->
|
|
|
|
do pairs <- mapM (\f -> do b <- beta; return (f,b)) fs
|
|
|
|
b <- beta
|
|
|
|
let t = RecordT (Map.fromList $ map (second (:[])) pairs) b
|
2013-05-29 23:20:38 +00:00
|
|
|
mkCs (name,tipe) = map (loc . (tipe :=:) . VarT)
|
2013-04-07 13:46:46 +00:00
|
|
|
(Map.findWithDefault [] name as)
|
|
|
|
return ( foldr Map.delete as fs
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.fromList (loc (t :=: tipe) : concatMap mkCs pairs)
|
2013-04-07 13:46:46 +00:00
|
|
|
, t )
|
2012-08-09 14:38:18 +00:00
|
|
|
|
|
|
|
|
2012-11-23 03:48:54 +00:00
|
|
|
defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme)
|
|
|
|
defScheme def = do (as,cs,hint) <- defGen def
|
|
|
|
return ( as, snd hint )
|
|
|
|
|
2012-12-25 08:39:18 +00:00
|
|
|
defGen def = case def of
|
|
|
|
FnDef f args e -> defGenHelp f args e
|
|
|
|
OpDef op a1 a2 e -> defGenHelp op [a1,a2] e
|
2013-06-03 07:44:45 +00:00
|
|
|
TypeAnnotation name tipe -> do
|
|
|
|
schm <- Subs.generalize [] =<< Subs.superize name tipe
|
|
|
|
return (Map.empty, Set.empty, (name, schm))
|
2012-12-25 08:39:18 +00:00
|
|
|
|
|
|
|
defGenHelp name args e = do
|
|
|
|
argDict <- mapM (\a -> liftM ((,) a) guid) args
|
|
|
|
(as,cs,t) <- gen e
|
|
|
|
let as' = foldr Map.delete as args
|
|
|
|
tipe = foldr (==>) t $ map (VarT . snd) argDict
|
|
|
|
genCs (arg,x) = do
|
|
|
|
v <- guid
|
|
|
|
let as' = Map.findWithDefault [v] arg as
|
2013-05-29 23:20:38 +00:00
|
|
|
return $ map (\y -> loc arg NoSpan $ VarT x :=: VarT y) as'
|
2012-12-25 08:39:18 +00:00
|
|
|
cs' <- concat `liftM` mapM genCs argDict
|
2013-04-10 02:50:56 +00:00
|
|
|
scheme <- Subs.generalize (concat $ Map.elems as') $
|
2012-12-25 08:39:18 +00:00
|
|
|
Forall (map snd argDict) (cs' ++ Set.toList cs) tipe
|
|
|
|
return ( as', Set.empty, (name, scheme) )
|
2012-11-23 03:48:54 +00:00
|
|
|
|
2012-08-01 23:37:37 +00:00
|
|
|
|
2013-02-05 11:20:55 +00:00
|
|
|
stmtGen :: Statement
|
|
|
|
-> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)
|
2013-02-04 10:56:22 +00:00
|
|
|
stmtGen stmt =
|
|
|
|
case stmt of
|
|
|
|
Definition def -> do (as,cs,hint) <- defGen def
|
2013-02-05 11:20:55 +00:00
|
|
|
return ( as, cs, uncurry Map.singleton hint )
|
2013-02-04 10:56:22 +00:00
|
|
|
|
|
|
|
Datatype name xs tcs ->
|
2013-02-05 11:20:55 +00:00
|
|
|
let toScheme ts = Forall xs [] (foldr (==>) (ADT name $ map VarT xs) ts)
|
|
|
|
in return (Map.empty, Set.empty, Map.fromList (map (second toScheme) tcs))
|
2013-02-04 10:56:22 +00:00
|
|
|
|
|
|
|
ExportEvent js elm tipe ->
|
|
|
|
do x <- guid
|
|
|
|
return ( Map.singleton elm [x]
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.singleton . loc elm NoSpan $ VarT x :=: tipe
|
2013-02-05 11:20:55 +00:00
|
|
|
, Map.empty )
|
2013-02-04 10:56:22 +00:00
|
|
|
|
2013-05-29 23:20:38 +00:00
|
|
|
ImportEvent js e@(L txt span base) elm tipe ->
|
2013-02-04 10:56:22 +00:00
|
|
|
do (as,cs,t) <- gen e
|
|
|
|
return ( as
|
2013-05-29 23:20:38 +00:00
|
|
|
, Set.insert (L txt span (signalOf t :=: tipe)) cs
|
2013-02-05 11:20:55 +00:00
|
|
|
, Map.singleton elm (Forall [] [] tipe) )
|
|
|
|
|
2013-02-06 11:04:55 +00:00
|
|
|
TypeAlias _ _ _ -> return (Map.empty, Set.empty, Map.empty)
|