@@ -32,7 +32,7 @@ desugarDecl :: Declaration -> [Declaration]
32desugarDecl (TypeClassDeclaration name arg members) =
32desugarDecl (TypeClassDeclaration name arg members) =
33 typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
33 typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
34desugarDecl (TypeInstanceDeclaration deps name ty members) =
34desugarDecl (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
36desugarDecl other = [other]
36desugarDecl other = [other]
38typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
38typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
@@ -40,7 +40,7 @@ typeClassDictionaryDeclaration name arg members =
40 TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
40 TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
42 memberToNameAndType :: Declaration -> (String, Type)
42 memberToNameAndType :: Declaration -> (String, Type)
43− memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
43+ memberToNameAndType (TypeDeclaration ident ty) = (identToString ident, ty)
44 memberToNameAndType _ = error "Invalid declaration in type class definition"
44 memberToNameAndType _ = error "Invalid declaration in type class definition"
46typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration
46typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration
@@ -52,24 +52,28 @@ typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type c
53typeInstanceDictionaryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Declaration
53typeInstanceDictionaryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Declaration
54typeInstanceDictionaryDeclaration deps name ty decls =
54typeInstanceDictionaryDeclaration deps name ty decls =
55− ValueDeclaration (mkDictionaryValueName name ty) [] Nothing
55+ ExternDeclaration (mkDictionaryValueName name ty)
56− (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) instanceFunctionType)
56+ (Just (JSObjectLiteral $ map memberToNameAndValue decls))
57+ (Function (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps) (TypeApp (TypeConstructor name) ty))
58− memberToNameAndValue :: Declaration -> (String, Value)
59+ memberToNameAndValue :: Declaration -> (String, JS)
59− memberToNameAndValue (ValueDeclaration ident binders guard val) =
60+ memberToNameAndValue (ValueDeclaration ident _ _ _) =
60− (show ident, Var $ Qualified Nothing $ mkDictionaryEntryName name ty ident)
61+ (identToString ident, JSVar $ mkDictionaryEntryName name ty ident)
61− memberToNameAndValue _ = error "Invalid declaration in type class definition"
62+ memberToNameAndValue _ = error "Invalid declaration in type instance definition"
62− instanceFunctionType :: Type
63− instanceFunctionType = foldl (\ty (pn, ty') -> Function [TypeApp (TypeConstructor pn) ty'] ty) (TypeApp (TypeConstructor name) ty) deps
65−typeInstanceDictionaryEntryDeclaration :: Qualified ProperName -> Type -> Declaration -> Declaration
64+typeInstanceDictionaryEntryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> Declaration -> Declaration
66−typeInstanceDictionaryEntryDeclaration name ty (ValueDeclaration ident binders guard val) =
65+typeInstanceDictionaryEntryDeclaration deps name ty (ValueDeclaration ident binders guard val) =
67− ValueDeclaration (mkDictionaryEntryName name ty 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 class definition"
68+typeInstanceDictionaryEntryDeclaration _ _ _ _ = error "Invalid declaration in type instance definition"
70+identToString :: Ident -> String
71+identToString (Ident s) = s
72+identToString (Op _) = error "Unsupported type class instance name"
70mkDictionaryValueName :: Qualified ProperName -> Type -> Ident
74mkDictionaryValueName :: Qualified ProperName -> Type -> Ident
71mkDictionaryValueName _ _ = Ident "__dict"
75mkDictionaryValueName _ _ = Ident "__dict"
73mkDictionaryEntryName :: Qualified ProperName -> Type -> Ident -> Ident
77mkDictionaryEntryName :: Qualified ProperName -> Type -> Ident -> Ident
74mkDictionaryEntryName name ty ident = let Ident dictName = mkDictionaryValueName name ty
78mkDictionaryEntryName name ty ident = let Ident dictName = mkDictionaryValueName name ty
75− in Ident $ dictName ++ "_" ++ show ident
79+ in Ident $ dictName ++ "_" ++ identToString ident