git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
More work on desugaring type classes into dictionaries
commite0d0502b63e91c6cb3cc85592c9ecf07cc2536ae authorPhil Freeman <paf31@cantab.net> dateSun 12 Jan 2014, 12:27 (13 years ago) parent0604bc1
4 files changed+34−4
compare with golang
unifiedsplit
src/Language/PureScript/Declarations.hs+2−2 src/Language/PureScript/Parser/Declarations.hs+2−2 src/Language/PureScript/Sugar/TypeClasses.hs+29 src/Language/PureScript/Types.hs+1
src/Language/PureScript/Declarations.hs+2−2
@@ -43,6 +43,6 @@ data Declaration
4343 | ExternDataDeclaration ProperName Kind
4444 | FixityDeclaration Fixity String
4545 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
46− | TypeClassDeclaration ProperName Ident [Declaration]
47− | TypeInstanceDeclaration ProperName Type [Declaration]
46+ | TypeClassDeclaration ProperName String [Declaration]
47+ | TypeInstanceDeclaration (Qualified ProperName) Type [Declaration]
4848 deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/Parser/Declarations.hs+2−2
@@ -100,7 +100,7 @@ parseTypeClassDeclaration :: P.Parsec String ParseState Declaration
100100parseTypeClassDeclaration = do
101101 reserved "class"
102102 className <- indented *> properName
103− ident <- indented *> parseIdent
103+ ident <- indented *> identifier
104104 indented *> reserved "where"
105105 members <- mark (P.many (same *> parseTypeDeclaration))
106106 return $ TypeClassDeclaration className ident members
@@ -108,7 +108,7 @@ parseTypeClassDeclaration = do
108108parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
109109parseTypeInstanceDeclaration = do
110110 reserved "instance"
111− className <- indented *> properName
111+ className <- indented *> parseQualified properName
112112 ty <- indented *> parseType
113113 indented *> reserved "where"
114114 members <- mark (P.many (same *> parseValueDeclaration))
src/Language/PureScript/Sugar/TypeClasses.hs+29
@@ -17,6 +17,9 @@ module Language.PureScript.Sugar.TypeClasses (
1717) where
1818
1919import Language.PureScript.Declarations
20+import Language.PureScript.Names
21+import Language.PureScript.Types
22+import Language.PureScript.Values
2023
2124desugarTypeClasses :: [Module] -> [Module]
2225desugarTypeClasses = map desugarModule
@@ -25,4 +28,30 @@ desugarModule :: Module -> Module
2528desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
2629
2730desugarDecl :: Declaration -> [Declaration]
31+desugarDecl (TypeClassDeclaration name arg members) = typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
32+desugarDecl (TypeInstanceDeclaration name ty members) = []
2833desugarDecl 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
3333 | TypeApp Type Type
3434 | SaturatedTypeSynonym (Qualified ProperName) [Type]
3535 | ForAll String Type
36+ | ConstrainedType [(Qualified ProperName, Type)] Type
3637 | Skolem Int
3738 | REmpty
3839 | RCons String Type Type deriving (Show, Eq, Data, Typeable)