git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
More work on desugaring type classes into dictionaries
e0d0502Phil Freeman
src/Language/PureScript/Declarations.hs+2−2
compare with golang
unifiedsplit
@@ -43,6 +43,6 @@ data Declaration
43 | ExternDataDeclaration ProperName Kind
43 | ExternDataDeclaration ProperName Kind
44 | FixityDeclaration Fixity String
44 | FixityDeclaration Fixity String
45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
46− | TypeClassDeclaration ProperName Ident [Declaration]
46+ | TypeClassDeclaration ProperName String [Declaration]
47− | TypeInstanceDeclaration ProperName Type [Declaration]
47+ | TypeInstanceDeclaration (Qualified ProperName) Type [Declaration]
48 deriving (Show, D.Data, D.Typeable)
48 deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/Parser/Declarations.hs+2−2
@@ -100,7 +100,7 @@ parseTypeClassDeclaration :: P.Parsec String ParseState Declaration
100parseTypeClassDeclaration = do
100parseTypeClassDeclaration = do
101 reserved "class"
101 reserved "class"
102 className <- indented *> properName
102 className <- indented *> properName
103− ident <- indented *> parseIdent
103+ ident <- indented *> identifier
104 indented *> reserved "where"
104 indented *> reserved "where"
105 members <- mark (P.many (same *> parseTypeDeclaration))
105 members <- mark (P.many (same *> parseTypeDeclaration))
106 return $ TypeClassDeclaration className ident members
106 return $ TypeClassDeclaration className ident members
@@ -108,7 +108,7 @@ parseTypeClassDeclaration = do
108parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
108parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
109parseTypeInstanceDeclaration = do
109parseTypeInstanceDeclaration = do
110 reserved "instance"
110 reserved "instance"
111− className <- indented *> properName
111+ className <- indented *> parseQualified properName
112 ty <- indented *> parseType
112 ty <- indented *> parseType
113 indented *> reserved "where"
113 indented *> reserved "where"
114 members <- mark (P.many (same *> parseValueDeclaration))
114 members <- mark (P.many (same *> parseValueDeclaration))
src/Language/PureScript/Sugar/TypeClasses.hs+29
@@ -17,6 +17,9 @@ module Language.PureScript.Sugar.TypeClasses (
17) where
17) where
18
18
19import Language.PureScript.Declarations
19import Language.PureScript.Declarations
20+import Language.PureScript.Names
21+import Language.PureScript.Types
22+import Language.PureScript.Values
20
23
21desugarTypeClasses :: [Module] -> [Module]
24desugarTypeClasses :: [Module] -> [Module]
22desugarTypeClasses = map desugarModule
25desugarTypeClasses = map desugarModule
@@ -25,4 +28,30 @@ desugarModule :: Module -> Module
25desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
28desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
26
29
27desugarDecl :: Declaration -> [Declaration]
30desugarDecl :: Declaration -> [Declaration]
31+desugarDecl (TypeClassDeclaration name arg members) = typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
32+desugarDecl (TypeInstanceDeclaration name ty members) = []
28desugarDecl other = [other]
33desugarDecl other = [other]
34+
35+typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
36+typeClassDictionaryDeclaration name arg members = TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
37+ where
38+ memberToNameAndType :: Declaration -> (String, Type)
39+ memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
40+ memberToNameAndType _ = error "Invalid declaration in type class definition"
41+
42+typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration
43+typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) = ExternDeclaration ident Nothing (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))
44+typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"
45+
46+{-
47+typeInstanceDictionaryDeclaration :: Qualified ProperName -> Type -> Declaration
48+typeInstanceDictionaryDeclaration name ty decls =
49+ ValueDeclaration (mkDictionaryValueName name ty) [] Nothing (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) (TypeApp (TypeConstructor name) ty))
50+ where
51+ memberToNameAndValue :: Declaration -> (String, Value)
52+ memberToNameAndValue (ValueDeclaration ident ty) = (show ident, ty)
53+ memberToNameAndValue _ = error "Invalid declaration in type class definition"
54+
55+mkDictionaryValueName :: ProperName -> Type -> Ident
56+mkDictionaryValueName _ _ = Ident "__dict"
57+-}
src/Language/PureScript/Types.hs+1
@@ -33,6 +33,7 @@ data Type
33 | TypeApp Type Type
33 | TypeApp Type Type
34 | SaturatedTypeSynonym (Qualified ProperName) [Type]
34 | SaturatedTypeSynonym (Qualified ProperName) [Type]
35 | ForAll String Type
35 | ForAll String Type
36+ | ConstrainedType [(Qualified ProperName, Type)] Type
36 | Skolem Int
37 | Skolem Int
37 | REmpty
38 | REmpty
38 | RCons String Type Type deriving (Show, Eq, Data, Typeable)
39 | RCons String Type Type deriving (Show, Eq, Data, Typeable)