0140873 · elk · git.iko.soy

127 TermN maybeAlias t ->

128 do flatStructure <- traverseTerm flatten t

129 pool <- getPool

130+ var <-

130− var <- liftIO . UF.fresh $ Descriptor

131+ liftIO . UF.fresh $ Descriptor

131− { structure = Just flatStructure

132+ { structure = Just flatStructure

132− , rank = maxRank pool

133+ , rank = maxRank pool

133− , flex = Flexible

134+ , flex = Flexible

134− , name = Nothing

135+ , name = Nothing

135− , copy = Nothing

136+ , copy = Nothing

136− , mark = noMark

137+ , mark = noMark

137− , alias = maybeAlias

138+ , alias = maybeAlias

138− }

139+ }

139 register var

140 register var

140

141

142

151makeCopy alreadyCopied variable = do

152makeCopy alreadyCopied variable = do

152 desc <- liftIO $ UF.descriptor variable

153 desc <- liftIO $ UF.descriptor variable

153 case () of

154 case () of

154− () | mark desc == alreadyCopied ->

155+ () | mark desc == alreadyCopied ->

155− case copy desc of

156+ case copy desc of

157+ Just v ->

156− Just v -> return v

158+ return v

159+ Nothing ->

160+ error $

157− Nothing -> error $ "Error copying type variable. This should be impossible." ++

161+ "Error copying type variable. This should be impossible." ++

158− " Please report an error to the github repo!"

162+ " Please report an error to the github repo!"

159−

163+

160− | rank desc /= noRank || flex desc == Constant ->

164+ | rank desc /= noRank || flex desc == Constant ->

161− return variable

165+ return variable

162−

166+

163− | otherwise -> do

167+ | otherwise ->

164− pool <- getPool

168+ do pool <- getPool

169+ newVar <-

165− newVar <- liftIO $ UF.fresh $ Descriptor

170+ liftIO $ UF.fresh $ Descriptor

166− { structure = Nothing

171+ { structure = Nothing

167− , rank = maxRank pool

172+ , rank = maxRank pool

168− , mark = noMark

173+ , mark = noMark

174+ , flex =

169− , flex = case flex desc of

175+ case flex desc of

170− Is s -> Is s

176+ Is s -> Is s

171− _ -> Flexible

177+ _ -> Flexible

172− , copy = Nothing

178+ , copy = Nothing

179+ , name =

173− , name = case flex desc of

180+ case flex desc of

174− Rigid -> Nothing

181+ Rigid -> Nothing

175− _ -> name desc

182+ _ -> name desc

176− , alias = Nothing

183+ , alias = Nothing

177− }

184+ }

178− register newVar

185+ register newVar

179−

186+

180− -- Link the original variable to the new variable. This lets us

187+ -- Link the original variable to the new variable. This lets us

181− -- avoid making multiple copies of the variable we are instantiating.

188+ -- avoid making multiple copies of the variable we are instantiating.

182− --

189+ --

183− -- Need to do this before recursively copying the structure of

190+ -- Need to do this before recursively copying the structure of

184− -- the variable to avoid looping on cyclic terms.

191+ -- the variable to avoid looping on cyclic terms.

185− liftIO $ UF.modifyDescriptor variable $ \desc ->

192+ liftIO $ UF.modifyDescriptor variable $ \desc ->

186− desc { mark = alreadyCopied, copy = Just newVar }

193+ desc { mark = alreadyCopied, copy = Just newVar }

187−

194+

188− -- Now we recursively copy the structure of the variable.

195+ -- Now we recursively copy the structure of the variable.

189− -- We have already marked the variable as copied, so we

196+ -- We have already marked the variable as copied, so we

190− -- will not repeat this work or crawl this variable again.

197+ -- will not repeat this work or crawl this variable again.

191− case structure desc of

198+ case structure desc of

199+ Nothing ->

192− Nothing -> return newVar

200+ return newVar

201+

193− Just term -> do

202+ Just term ->

194− newTerm <- traverseTerm (makeCopy alreadyCopied) term

203+ do newTerm <- traverseTerm (makeCopy alreadyCopied) term

195− liftIO $ UF.modifyDescriptor newVar $ \desc ->

204+ liftIO $ UF.modifyDescriptor newVar $ \desc ->

196− desc { structure = Just newTerm }

205+ desc { structure = Just newTerm }

197− return newVar

206+ return newVar

198

207

199

208

200restore :: Int -> Variable -> StateT SolverState IO Variable

209restore :: Int -> Variable -> StateT SolverState IO Variable

213traverseTerm :: (Monad f, Applicative f) => (a -> f b) -> Term1 a -> f (Term1 b)

222traverseTerm :: (Monad f, Applicative f) => (a -> f b) -> Term1 a -> f (Term1 b)

214traverseTerm f term =

223traverseTerm f term =

215 case term of

224 case term of

216− App1 a b -> App1 <$> f a <*> f b

225+ App1 a b ->

217− Fun1 a b -> Fun1 <$> f a <*> f b

226+ App1 <$> f a <*> f b

218− Var1 x -> Var1 <$> f x

219− EmptyRecord1 -> return EmptyRecord1

220− Record1 fields ext ->

221− Record1 <$> Traversable.traverse (mapM f) fields <*> f ext

222

227

228+ Fun1 a b ->

229+ Fun1 <$> f a <*> f b

230+

231+ Var1 x ->

232+ Var1 <$> f x

233+

234+ EmptyRecord1 ->

235+ return EmptyRecord1

236+

237+ Record1 fields ext ->

238+ Record1

239+ <$> Traversable.traverse (mapM f) fields

240+ <*> f ext