@@ -124,10 +124,13 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do
126 -- Lookup the type arguments and member types for the type class
126 -- Lookup the type arguments and member types for the type class
127+ (TypeClassDeclaration _ args implies tyDecls) <- lift $
127− (TypeClassDeclaration _ args implies tyDecls) <- lift $ maybe (Left $ mkErrorStack ("Type class " ++ show className ++ " is undefined") Nothing) Right
128+ maybe (Left $ mkErrorStack ("Type class " ++ show className ++ " is undefined") Nothing) Right $
128− $ M.lookup (qualify mn className) m
129+ M.lookup (qualify mn className) m
129 let instanceTys = map memberToNameAndType tyDecls
130 let instanceTys = map memberToNameAndType tyDecls
132+ let superclasses = TypedValue False (ArrayLiteral [ TypeClassDictionary (superclass, tyArgs) [] | (superclass, tyArgs) <- implies ]) (TypeApp tyArray unit)
131 -- Replace the type arguments with the appropriate types in the member types
134 -- Replace the type arguments with the appropriate types in the member types
132 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
135 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys
133 -- Create values for the type instance members
136 -- Create values for the type instance members
@@ -137,9 +140,10 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do
137 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary
140 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary
138 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no
141 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no
139 -- dependencies, we introduce an unnamed function parameter.
142 -- dependencies, we introduce an unnamed function parameter.
140− let dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, REmpty))
143+ let dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, RCons "__superclasses" (TypeApp tyArray unit) REmpty))
141 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)
144 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)
145+ memberNames' = ("__superclasses", superclasses) : memberNames
142− dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames) else ObjectLiteral memberNames
146+ dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'
143 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)
147 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)
145 unit :: Type
149 unit :: Type