92331c9 · elk · git.iko.soy

57 (name', flex', rank', alias') = combinedDescriptors desc1 desc2

58

59 merge1 :: Unify ()

60+ merge1 =

60− merge1 = liftIO $ do

61+ liftIO $ do

62+ if rank desc1 < rank desc2

61− if rank desc1 < rank desc2 then UF.union variable2 variable1

63+ then UF.union variable2 variable1

62− else UF.union variable1 variable2

64+ else UF.union variable1 variable2

63− UF.modifyDescriptor variable1 $ \desc ->

65+ UF.modifyDescriptor variable1 $ \desc ->

64− desc { structure = structure desc1

66+ desc { structure = structure desc1

65− , flex = flex'

67+ , flex = flex'

66− , name = name'

68+ , name = name'

67− , alias = alias'

69+ , alias = alias'

68− }

70+ }

69

71

70 merge2 :: Unify ()

72 merge2 :: Unify ()

73+ merge2 =

71− merge2 = liftIO $ do

74+ liftIO $ do

75+ if rank desc1 < rank desc2

72− if rank desc1 < rank desc2 then UF.union variable2 variable1

76+ then UF.union variable2 variable1

73− else UF.union variable1 variable2

77+ else UF.union variable1 variable2

74− UF.modifyDescriptor variable2 $ \desc ->

78+ UF.modifyDescriptor variable2 $ \desc ->

75− desc { structure = structure desc2

79+ desc { structure = structure desc2

80+ , flex = flex'

81+ , name = name'

82+ , alias = alias'

83+ }

84+

85+ merge =

86+ if rank desc1 < rank desc2 then merge1 else merge2

87+

88+ fresh :: Maybe (Term1 Variable) -> Unify Variable

89+ fresh structure =

90+ do v <- liftIO . UF.fresh $ Descriptor

91+ { structure = structure

92+ , rank = rank'

76 , flex = flex'

93 , flex = flex'

77 , name = name'

94 , name = name'

95+ , copy = Nothing

96+ , mark = noMark

78 , alias = alias'

97 , alias = alias'

79 }

98 }

99+ lift (TS.register v)

80

100

81− merge = if rank desc1 < rank desc2 then merge1 else merge2

82−

83− fresh :: Maybe (Term1 Variable) -> Unify Variable

84− fresh structure = do

85− v <- liftIO . UF.fresh $ Descriptor

86− { structure = structure

87− , rank = rank'

88− , flex = flex'

89− , name = name'

90− , copy = Nothing

91− , mark = noMark

92− , alias = alias'

93− }

94− lift (TS.register v)

95−

96− flexAndUnify v = do

101+ flexAndUnify v =

97− liftIO $ UF.modifyDescriptor v $ \desc -> desc { flex = Flexible }

102+ do liftIO $ UF.modifyDescriptor v $ \desc -> desc { flex = Flexible }

98− unifyHelp' variable1 variable2

103+ unifyHelp' variable1 variable2

99

104

100 unifyNumber svar (Var.Canonical home name) =

105 unifyNumber svar (Var.Canonical home name) =

101 case home of

106 case home of

127 _ -> comparableError Nothing

132 _ -> comparableError Nothing

128

133

129 unifyComparableStructure varSuper varFlex =

134 unifyComparableStructure varSuper varFlex =

130− do struct <- liftIO $ collectApps varFlex

135+ do struct <- liftIO $ collectApps varFlex

131− case struct of

136+ case struct of

137+ Other ->

132− Other -> comparableError Nothing

138+ comparableError Nothing

139+

140+ List v ->

133− List v -> do flexAndUnify varSuper

141+ do flexAndUnify varSuper

134− unifyHelp' v =<< liftIO (variable $ Is Comparable)

142+ unifyHelp' v =<< liftIO (variable $ Is Comparable)

143+

135− Tuple vs

144+ Tuple vs

136− | length vs > 6 ->

145+ | length vs > 6 ->

137− comparableError $ Just "Cannot compare a tuple with more than 6 elements."

146+ comparableError $ Just "Cannot compare a tuple with more than 6 elements."

138− | otherwise ->

147+ | otherwise ->

139− do flexAndUnify varSuper

148+ do flexAndUnify varSuper

140 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)

149 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)

141 zipWithM_ unifyHelp' vs cmpVars

150 zipWithM_ unifyHelp' vs cmpVars

142

151

143 unifyAppendable varSuper varFlex =

152 unifyAppendable varSuper varFlex =

144− do struct <- liftIO $ collectApps varFlex

153+ do struct <- liftIO $ collectApps varFlex

145− case struct of

154+ case struct of

146− List _ -> flexAndUnify varSuper

155+ List _ -> flexAndUnify varSuper

147− _ -> appendableError Nothing

156+ _ -> appendableError Nothing

148

157

149 rigidError var =

158 rigidError var =

150 typeError region (Just hint) variable1 variable2

159 typeError region (Just hint) variable1 variable2

160 | super1 == super2 -> merge

169 | super1 == super2 -> merge

161 (Is Number, Is Comparable, _, _) -> merge1

170 (Is Number, Is Comparable, _, _) -> merge1

162 (Is Comparable, Is Number, _, _) -> merge2

171 (Is Comparable, Is Number, _, _) -> merge2

163−

172+

164 (Is Number, _, _, Just name) -> unifyNumber variable1 name

173 (Is Number, _, _, Just name) -> unifyNumber variable1 name

165 (_, Is Number, Just name, _) -> unifyNumber variable2 name

174 (_, Is Number, Just name, _) -> unifyNumber variable2 name

166

175

181 _ -> typeError region Nothing variable1 variable2

190 _ -> typeError region Nothing variable1 variable2

182

191

183 case (structure desc1, structure desc2) of

192 case (structure desc1, structure desc2) of

184− (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge

193+ (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible ->

194+ merge

195+

185− (Nothing, _) | flex desc1 == Flexible -> merge2

196+ (Nothing, _) | flex desc1 == Flexible ->

197+ merge2

198+

186− (_, Nothing) | flex desc2 == Flexible -> merge1

199+ (_, Nothing) | flex desc2 == Flexible ->

200+ merge1

201+

202+ (Just (Var1 v), _) ->

203+ unifyHelp' v variable2

204+

205+ (_, Just (Var1 v)) ->

206+ unifyHelp' v variable1

187

207

188− (Just (Var1 v), _) -> unifyHelp' v variable2

208+ (Nothing, _) ->

189− (_, Just (Var1 v)) -> unifyHelp' v variable1

209+ superUnify

190

210

191− (Nothing, _) -> superUnify

211+ (_, Nothing) ->

192− (_, Nothing) -> superUnify

212+ superUnify

193

213

194 (Just type1, Just type2) ->

214 (Just type1, Just type2) ->

195 case (type1,type2) of

215 case (type1,type2) of

288 -> Unify ()

308 -> Unify ()

289unifyOverlappingFields region fields1 fields2 =

309unifyOverlappingFields region fields1 fields2 =

290 Map.intersectionWith (zipWith (unifyHelp region)) fields1 fields2

310 Map.intersectionWith (zipWith (unifyHelp region)) fields1 fields2

291− |> Map.elems

311+ |> Map.elems

292 |> concat

312 |> concat

293 |> sequence_

313 |> sequence_

294

314

338 ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys

358 ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys

339

359

340

360

341−combinedDescriptors :: Descriptor -> Descriptor

361+combinedDescriptors

362+ :: Descriptor

363+ -> Descriptor

342− -> (Maybe Var.Canonical, Flex, Int, Maybe Var.Canonical)

364+ -> (Maybe Var.Canonical, Flex, Int, Maybe Var.Canonical)

343combinedDescriptors desc1 desc2 =

365combinedDescriptors desc1 desc2 =

344 (name', flex', rank', alias')

366 (name', flex', rank', alias')

345 where

367 where

346 rank' :: Int

368 rank' :: Int

369+ rank' =

347− rank' = min (rank desc1) (rank desc2)

370+ min (rank desc1) (rank desc2)

348

371

349 alias' :: Maybe Var.Canonical

372 alias' :: Maybe Var.Canonical

373+ alias' =

350− alias' = alias desc1 <|> alias desc2

374+ alias desc1 <|> alias desc2

351

375

352 name' :: Maybe Var.Canonical

376 name' :: Maybe Var.Canonical

377+ name' =

353− name' = case (name desc1, name desc2) of

378+ case (name desc1, name desc2) of

354− (Just name1, Just name2) ->

379+ (Just name1, Just name2) ->

355− case (flex desc1, flex desc2) of

380+ case (flex desc1, flex desc2) of

356− (_, Flexible) -> Just name1

381+ (_, Flexible) -> Just name1

357− (Flexible, _) -> Just name2

382+ (Flexible, _) -> Just name2

358− (Is Number, Is _) -> Just name1

383+ (Is Number, Is _) -> Just name1

359− (Is _, Is Number) -> Just name2

384+ (Is _, Is Number) -> Just name2

360− (Is _, Is _) -> Just name1

385+ (Is _, Is _) -> Just name1

361− (_, _) -> Nothing

386+ (_, _) -> Nothing

362− (Just name1, _) -> Just name1

387+ (Just name1, _) -> Just name1

363− (_, Just name2) -> Just name2

388+ (_, Just name2) -> Just name2

364− _ -> Nothing

389+ _ -> Nothing

365

390

366 flex' :: Flex

391 flex' :: Flex

392+ flex' =

367− flex' = case (flex desc1, flex desc2) of

393+ case (flex desc1, flex desc2) of

368− (f, Flexible) -> f

394+ (f, Flexible) -> f

369− (Flexible, f) -> f

395+ (Flexible, f) -> f

370− (Is Number, Is _) -> Is Number

396+ (Is Number, Is _) -> Is Number

371− (Is _, Is Number) -> Is Number

397+ (Is _, Is Number) -> Is Number

372− (Is super, Is _) -> Is super

398+ (Is super, Is _) -> Is super

373− (_, _) -> Flexible

399+ (_, _) -> Flexible