git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
First work on desugaring instance declarations
commit265277e066694efe2e74eb17b50fc7d60fa180f7 authorPhil Freeman <paf31@cantab.net> dateSun 12 Jan 2014, 19:55 (13 years ago) parenta7e6d2c
2 files changed+26−12
compare with golang
unifiedsplit
src/Language/PureScript/Parser/Declarations.hs+2−2 src/Language/PureScript/Sugar/TypeClasses.hs+24−10
src/Language/PureScript/Parser/Declarations.hs+2−2
@@ -109,8 +109,8 @@ parseTypeClassDeclaration = do
109109parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
110110parseTypeInstanceDeclaration = do
111111 reserved "instance"
112− deps <- do
113− deps <- P.optionMaybe (parens (commaSep1 ((,) <$> parseQualified properName <*> parseType)))
112+ deps <- P.optionMaybe $ do
113+ deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> parseType))
114114 indented
115115 reservedOp "=>"
116116 return deps
src/Language/PureScript/Sugar/TypeClasses.hs+24−10
@@ -29,12 +29,15 @@ desugarModule :: Module -> Module
2929desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
3030
3131desugarDecl :: Declaration -> [Declaration]
32−desugarDecl (TypeClassDeclaration name arg members) = typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
33−desugarDecl (TypeInstanceDeclaration deps name ty members) = []
32+desugarDecl (TypeClassDeclaration name arg members) =
33+ typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
34+desugarDecl (TypeInstanceDeclaration deps name ty members) =
35+ typeInstanceDictionaryDeclaration deps name ty members : map (typeInstanceDictionaryEntryDeclaration name ty) members
3436desugarDecl other = [other]
3537
3638typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
37−typeClassDictionaryDeclaration name arg members = TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
39+typeClassDictionaryDeclaration name arg members =
40+ TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
3841 where
3942 memberToNameAndType :: Declaration -> (String, Type)
4043 memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
@@ -47,15 +50,26 @@ typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) =
4750 (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))
4851typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"
4952
50−{-
51−typeInstanceDictionaryDeclaration :: Qualified ProperName -> Type -> Declaration
52−typeInstanceDictionaryDeclaration name ty decls =
53− ValueDeclaration (mkDictionaryValueName name ty) [] Nothing (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) (TypeApp (TypeConstructor name) ty))
53+typeInstanceDictionaryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Declaration
54+typeInstanceDictionaryDeclaration deps name ty decls =
55+ ValueDeclaration (mkDictionaryValueName name ty) [] Nothing
56+ (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) instanceFunctionType)
5457 where
5558 memberToNameAndValue :: Declaration -> (String, Value)
56− memberToNameAndValue (ValueDeclaration ident ty) = (show ident, ty)
59+ memberToNameAndValue (ValueDeclaration ident binders guard val) =
60+ (show ident, Var $ Qualified Nothing $ mkDictionaryEntryName name ty ident)
5761 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
5864
59−mkDictionaryValueName :: ProperName -> Type -> Ident
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"
69+
70+mkDictionaryValueName :: Qualified ProperName -> Type -> Ident
6071mkDictionaryValueName _ _ = Ident "__dict"
61−-}
72+
73+mkDictionaryEntryName :: Qualified ProperName -> Type -> Ident -> Ident
74+mkDictionaryEntryName name ty ident = let Ident dictName = mkDictionaryValueName name ty
75+ in Ident $ dictName ++ "_" ++ show ident