git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
First work on desugaring instance declarations
265277ePhil Freeman
src/Language/PureScript/Parser/Declarations.hs+2−2
compare with golang
unifiedsplit
@@ -109,8 +109,8 @@ parseTypeClassDeclaration = do
109parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
109parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
110parseTypeInstanceDeclaration = do
110parseTypeInstanceDeclaration = do
111 reserved "instance"
111 reserved "instance"
112− deps <- do
112+ deps <- P.optionMaybe $ do
113− deps <- P.optionMaybe (parens (commaSep1 ((,) <$> parseQualified properName <*> parseType)))
113+ deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> parseType))
114 indented
114 indented
115 reservedOp "=>"
115 reservedOp "=>"
116 return deps
116 return deps
src/Language/PureScript/Sugar/TypeClasses.hs+24−10
@@ -29,12 +29,15 @@ desugarModule :: Module -> Module
29desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
29desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
30
30
31desugarDecl :: Declaration -> [Declaration]
31desugarDecl :: Declaration -> [Declaration]
32+desugarDecl (TypeClassDeclaration name arg members) =
32−desugarDecl (TypeClassDeclaration name arg members) = typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
33+ typeClassDictionaryDeclaration name arg members : map (typeClassMemberToDictionaryAccessor name arg) members
33−desugarDecl (TypeInstanceDeclaration deps name ty members) = []
34+desugarDecl (TypeInstanceDeclaration deps name ty members) =
35+ typeInstanceDictionaryDeclaration deps name ty members : map (typeInstanceDictionaryEntryDeclaration name ty) members
34desugarDecl other = [other]
36desugarDecl other = [other]
35
37
36typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
38typeClassDictionaryDeclaration :: ProperName -> String -> [Declaration] -> Declaration
39+typeClassDictionaryDeclaration name arg members =
37−typeClassDictionaryDeclaration name arg members = TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
40+ TypeSynonymDeclaration name [arg] (Object $ rowFromList (map memberToNameAndType members, REmpty))
38 where
41 where
39 memberToNameAndType :: Declaration -> (String, Type)
42 memberToNameAndType :: Declaration -> (String, Type)
40 memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
43 memberToNameAndType (TypeDeclaration ident ty) = (show ident, ty)
@@ -47,15 +50,26 @@ typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) =
47 (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))
50 (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))
48typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"
51typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"
49
52
50−{-
51−typeInstanceDictionaryDeclaration :: Qualified ProperName -> Type -> Declaration
53+typeInstanceDictionaryDeclaration :: [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Declaration
52−typeInstanceDictionaryDeclaration name ty decls =
54+typeInstanceDictionaryDeclaration deps name ty decls =
53− ValueDeclaration (mkDictionaryValueName name ty) [] Nothing (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) (TypeApp (TypeConstructor name) ty))
55+ ValueDeclaration (mkDictionaryValueName name ty) [] Nothing
56+ (TypedValue (ObjectLiteral $ map memberToNameAndValue decls) instanceFunctionType)
54 where
57 where
55 memberToNameAndValue :: Declaration -> (String, Value)
58 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)
57 memberToNameAndValue _ = error "Invalid declaration in type class definition"
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
58
64
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+
59−mkDictionaryValueName :: ProperName -> Type -> Ident
70+mkDictionaryValueName :: Qualified ProperName -> Type -> Ident
60mkDictionaryValueName _ _ = Ident "__dict"
71mkDictionaryValueName _ _ = 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