1fbdd2a · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Changes to entails for superclass search

1fbdd2aPhil Freeman13 years ago

examples/passing/Superclasses.purs+8−1

compare with golang

unifiedsplit

@@ -6,7 +6,14 @@ class Su a where

6class (Su a) <= Cl a where

7 cl :: a -> a -> a

9+instance suNumber :: Su Number where

10+ su n = n + 1

11+

12+instance clNumber :: Cl Number where

13+ cl n m = n + m

14+

9test :: forall a. (Cl a) => a -> a

15test :: forall a. (Cl a) => a -> a

10test a = su (cl a a)

16test a = su (cl a a)

18+main = let n = test 10 in

12−main = Debug.Trace.trace "Done"

19+ Debug.Trace.trace "Done"

src/Language/PureScript/TypeChecker/Types.hs+23−1

@@ -283,6 +283,10 @@ data DictionaryValue

283 -- A dictionary which depends on other dictionaries

284 --

285 | DependentDictionaryValue (Qualified Ident) [DictionaryValue]

286+ -- |

287+ -- A subclass dictionary

288+ --

289+ | SubclassDictionaryValue DictionaryValue Integer

286 deriving (Show, Ord, Eq)

290 deriving (Show, Ord, Eq)

287

291

288-- |

292-- |

@@ -315,7 +319,21 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

315 -- Make sure the type unifies with the type in the type instance definition

319 -- Make sure the type unifies with the type in the type instance definition

316 , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)

320 , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)

317 -- Solve any necessary subgoals

321 -- Solve any necessary subgoals

318− , args <- solveSubgoals subst (tcdDependencies tcd) ]

322+ , args <- solveSubgoals subst (tcdDependencies tcd) ] ++

323+

324+ -- Look for implementations via superclasses

325+ [ SubclassDictionaryValue suDict index

326+ | tcd <- context'

327+ , (_, _, implies) <- maybeToList $ M.lookup (tcdClassName tcd) (typeClasses env)

328+ -- Try each superclass

329+ , (index, (superclass, suTyArgs)) <- zip [0..] implies

330+ -- Make sure the types unify with the types in the superclass implication

331+ , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) suTyArgs (tcdInstanceTypes tcd)

332+ -- Make sure the type class name matches the superclass name

333+ , className' == superclass

334+ -- Finally, satisfy the subclass constraint

335+ , suDict <- go (tcdClassName tcd, tys') ]

336+

319 -- Create dictionaries for subgoals which still need to be solved by calling go recursively

337 -- Create dictionaries for subgoals which still need to be solved by calling go recursively

320 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type

338 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type

321 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.

339 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.

@@ -334,6 +352,10 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

334 dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName

352 dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName

335 dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])

353 dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])

336 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)

354 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)

355+ dictionaryValueToValue (SubclassDictionaryValue dict index) =

356+ App (App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident (C.!!))))

357+ (Accessor "__superclasses" (dictionaryValueToValue dict)))

358+ (NumericLiteral (Left index))

337 -- Ensure that a substitution is valid

359 -- Ensure that a substitution is valid

338 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

360 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

339 verifySubstitution subst = do

361 verifySubstitution subst = do