@@ -88,16 +88,12 @@ outermostRank = 0 :: Int
8888noMark = 0
8989initialMark = 1
9090
91−data Flex = Rigid | Flexible | Constant | IsIn SuperType
91+data Flex = Rigid | Flexible | Constant | Is SuperType
9292 deriving (Show, Eq)
9393
9494data SuperType = Number | Comparable | Appendable
9595 deriving (Show, Eq)
9696
97−number = namedVar (IsIn Number) "number"
98−comparable = namedVar (IsIn Comparable) "comparable"
99−appendable = namedVar (IsIn Appendable) "appendable"
100−
10197namedVar flex name = UF.fresh $ Descriptor {
10298 structure = Nothing,
10399 rank = noRank,
@@ -107,23 +103,15 @@ namedVar flex name = UF.fresh $ Descriptor {
107103 mark = noMark
108104 }
109105
110−flexibleVar = UF.fresh $ Descriptor {
106+var flex = UF.fresh $ Descriptor {
111107 structure = Nothing,
112108 rank = noRank,
113− flex = Flexible,
109+ flex = flex,
114110 name = Nothing,
115111 copy = Nothing,
116112 mark = noMark
117113 }
118114
119−rigidVar = UF.fresh $ Descriptor {
120− structure = Nothing,
121− rank = noRank,
122− flex = Rigid,
123− name = Nothing,
124− copy = Nothing,
125− mark = noMark
126− }
127115
128116-- ex qs constraint == exists qs. constraint
129117ex :: [Variable] -> TypeConstraint -> TypeConstraint
@@ -135,7 +123,7 @@ fl rqs constraint = CLet [Scheme rqs [] constraint Map.empty] CTrue
135123
136124exists :: (Type -> IO TypeConstraint) -> IO TypeConstraint
137125exists f = do
138− v <- flexibleVar
126+ v <- var Flexible
139127 ex [v] <$> f (VarN v)
140128
141129
@@ -252,31 +240,39 @@ extraPretty t = pretty Never <$> addNames t
252240
253241addNames :: (Crawl t) => t -> IO t
254242addNames value = do
255− (_, rawVars) <- runStateT (crawl getNames value) []
243+ (rawVars, _, _, _) <- execStateT (crawl getNames value) ([], 0, 0, 0)
256244 let vars = map head . List.group $ List.sort rawVars
257245 suffix s = map (++s) (map (:[]) ['a'..'z'])
258246 allVars = concatMap suffix $ ["","'","_"] ++ map show [0..]
259247 okayVars = filter (`notElem` vars) allVars
260− runStateT (crawl rename value) okayVars
248+ runStateT (crawl rename value) (okayVars, 0, 0, 0)
261249 return value
262250 where
263− getNames name vars =
264− case name of
265− Just var -> (name, var:vars)
266− Nothing -> (name, vars)
251+ getNames desc state@(vars, a, b, c) =
252+ let name' = name desc in
253+ case name' of
254+ Just var -> (name', (var:vars, a, b, c))
255+ Nothing -> (name', state)
256+
257+ rename desc state@(vars, a, b, c) =
258+ case name desc of
259+ Just var -> (Just var, state)
260+ Nothing ->
261+ case flex desc of
262+ Is Number -> (Just $ "number" ++ replicate a '\'', (vars, a+1, b, c))
263+ Is Comparable -> (Just $ "comparable" ++ replicate b '\'', (vars, a, b+1, c))
264+ Is Appendable -> (Just $ "appendable" ++ replicate c '\'', (vars, a, b, c+1))
265+ _ -> (Just $ head vars, (tail vars, a, b, c))
267266
268− rename name vars =
269− case name of
270− Just var -> (name, vars)
271− Nothing -> (Just (head vars), tail vars)
272267
268+type CrawlState = ([String], Int, Int, Int)
273269
274270-- Code for traversing all the type data-structures and giving
275271-- names to the variables embedded deep in there.
276272class Crawl t where
277− crawl :: (Maybe TypeName -> [String] -> (Maybe TypeName, [String]))
273+ crawl :: (Descriptor -> CrawlState -> (Maybe TypeName, CrawlState))
278274 -> t
279− -> StateT [String] IO t
275+ -> StateT CrawlState IO t
280276
281277instance (Crawl t, Crawl v) => Crawl (Constraint t v) where
282278 crawl nextState constraint =
@@ -324,7 +320,7 @@ instance Crawl a => Crawl (UF.Point a) where
324320instance Crawl Descriptor where
325321 crawl nextState desc = do
326322 state <- get
327− let (name', state') = nextState (name desc) state
323+ let (name', state') = nextState desc state
328324 structure' <- traverse (crawl nextState) (structure desc)
329325 put state'
330326 return $ desc { name = name', structure = structure' }