@@ -32,7 +32,7 @@ desugarDecl :: Declaration -> [Declaration]
3232desugarDecl (TypeClassDeclaration name arg members) =
3333 typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
3434desugarDecl (TypeInstanceDeclaration deps name ty members) =
35− typeInstanceDictionaryDeclaration deps name ty members : map (typeInstanceDictionaryEntryDeclaration name ty) members
35+ typeInstanceDictionaryDeclaration deps name ty members : map (typeInstanceDictionaryEntryDeclaration deps name ty) members
3636desugarDecl other = [other]
3737
3838typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
@@ -40,7 +40,7 @@ typeClassDictionaryDeclaration name arg members =
4040 TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
4141 where
4242 memberToNameAndType :: Declaration -> (String, Type)
43− memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
43+ memberToNameAndType (TypeDeclaration ident ty) = (identToString ident, ty)
4444 memberToNameAndType _ = error "Invalid declaration in type class definition"
4545
4646typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration
@@ -52,24 +52,28 @@ typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type c
5252
5353typeInstanceDictionaryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Declaration
5454typeInstanceDictionaryDeclaration deps name ty decls =
55− ValueDeclaration (mkDictionaryValueName name ty) [] Nothing
56− (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) instanceFunctionType)
55+ ExternDeclaration (mkDictionaryValueName name ty)
56+ (Just (JSObjectLiteral $ map memberToNameAndValue decls))
57+ (Function (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps) (TypeApp (TypeConstructor name) ty))
5758 where
58− memberToNameAndValue :: Declaration -> (String, Value)
59− memberToNameAndValue (ValueDeclaration ident binders guard val) =
60− (show ident, Var $ Qualified Nothing $ mkDictionaryEntryName name ty ident)
61− memberToNameAndValue _ = error "Invalid declaration in type class definition"
62− instanceFunctionType :: Type
63− instanceFunctionType = foldl (\ty (pn, ty') -> Function [TypeApp (TypeConstructor pn) ty'] ty) (TypeApp (TypeConstructor name) ty) deps
59+ memberToNameAndValue :: Declaration -> (String, JS)
60+ memberToNameAndValue (ValueDeclaration ident _ _ _) =
61+ (identToString ident, JSVar $ mkDictionaryEntryName name ty ident)
62+ memberToNameAndValue _ = error "Invalid declaration in type instance definition"
6463
65−typeInstanceDictionaryEntryDeclaration :: Qualified ProperName -> Type -> Declaration -> Declaration
66−typeInstanceDictionaryEntryDeclaration name ty (ValueDeclaration ident binders guard val) =
67− ValueDeclaration (mkDictionaryEntryName name ty ident) binders guard val
68−typeInstanceDictionaryEntryDeclaration _ _ _ = error "Invalid declaration in type class definition"
64+typeInstanceDictionaryEntryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> Declaration -> Declaration
65+typeInstanceDictionaryEntryDeclaration deps name ty (ValueDeclaration ident binders guard val) =
66+ ValueDeclaration (mkDictionaryEntryName name ty ident) binders guard
67+ (TypedValue val (ConstrainedType deps undefined))
68+typeInstanceDictionaryEntryDeclaration _ _ _ _ = error "Invalid declaration in type instance definition"
69+
70+identToString :: Ident -> String
71+identToString (Ident s) = s
72+identToString (Op _) = error "Unsupported type class instance name"
6973
7074mkDictionaryValueName :: Qualified ProperName -> Type -> Ident
7175mkDictionaryValueName _ _ = Ident "__dict"
7276
7377mkDictionaryEntryName :: Qualified ProperName -> Type -> Ident -> Ident
7478mkDictionaryEntryName name ty ident = let Ident dictName = mkDictionaryValueName name ty
75− in Ident $ dictName ++ "_" ++ show ident
79+ in Ident $ dictName ++ "_" ++ identToString ident