git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Free variables calculation, better quantify function.
7604b66Phil Freeman
src/Language/PureScript/Sugar/TypeClasses.hs+38−7
compare with golang
unifiedsplit
@@ -50,6 +50,44 @@ desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule
50desugarModule :: Module -> Desugar Module
50desugarModule :: Module -> Desugar Module
51desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl (ModuleName name)) decls
51desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl (ModuleName name)) decls
52
52
53+-- |
54+-- Desugar type class and type class instance declarations
55+--
56+-- Type classes become type synonyms for their dictionaries, and type instances become dictionary declarations.
57+-- Additional values are generated to access individual members of a dictionary, with the appropriate type.
58+--
59+-- E.g. the following
60+--
61+-- module Test where
62+--
63+-- class Foo a where
64+-- foo :: a -> a
65+--
66+-- instance Foo String where
67+-- foo s = s ++ s
68+--
69+-- instance (Foo a) => Foo [a] where
70+-- foo = map foo
71+--
72+-- becomes
73+--
74+-- type Foo a = { foo :: a -> a }
75+--
76+-- foreign import foo "function foo(dict) {\
77+-- \ return dict.foo;\
78+-- \}" :: forall a. (Foo a) => a -> a
79+--
80+-- __Test_Foo_string_foo = (\s -> s ++ s) :: String -> String
81+--
82+-- __Test_Foo_string :: Foo String
83+-- __Test_Foo_string = { foo: __Test_Foo_string_foo :: String -> String (unchecked) }
84+--
85+-- __Test_Foo_array_foo :: forall a. (Foo a) => [a] -> [a]
86+-- __Test_Foo_array_foo _1 = map (foo _1)
87+--
88+-- __Test_Foo_array :: forall a. Foo a -> Foo [a]
89+-- __Test_Foo_array _1 = { foo: __Test_Foo_array_foo _1 :: [a] -> [a] (unchecked) }
90+--
53desugarDecl :: ModuleName -> Declaration -> Desugar [Declaration]
91desugarDecl :: ModuleName -> Declaration -> Desugar [Declaration]
54desugarDecl mn d@(TypeClassDeclaration name arg members) = do
92desugarDecl mn d@(TypeClassDeclaration name arg members) = do
55 let tys = map memberToNameAndType members
93 let tys = map memberToNameAndType members
@@ -119,13 +157,6 @@ qualifiedToString :: ModuleName -> Qualified ProperName -> String
119qualifiedToString mn (Qualified Nothing pn) = qualifiedToString mn (Qualified (Just mn) pn)
157qualifiedToString mn (Qualified Nothing pn) = qualifiedToString mn (Qualified (Just mn) pn)
120qualifiedToString _ (Qualified (Just (ModuleName mn)) pn) = runProperName mn ++ "_" ++ runProperName pn
158qualifiedToString _ (Qualified (Just (ModuleName mn)) pn) = runProperName mn ++ "_" ++ runProperName pn
121
159
122−quantify :: Type -> Type
123−quantify ty' = foldr (\arg t -> ForAll arg t Nothing) ty' tyVars
124− where
125− tyVars = nub $ everything (++) (mkQ [] collect) ty'
126− collect (TypeVar v) = [v]
127− collect _ = []
128−
129-- |
160-- |
130-- Generate a name for a type class dictionary, based on the module name, class name and type name
161-- Generate a name for a type class dictionary, based on the module name, class name and type name
131--
162--
src/Language/PureScript/Types.hs+22
@@ -166,3 +166,25 @@ replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replaceTypeVa
166 replaceTypeVar other = other
166 replaceTypeVar other = other
167 isShadowed (ForAll v _ _) | v == name = True
167 isShadowed (ForAll v _ _) | v == name = True
168 isShadowed _ = False
168 isShadowed _ = False
169+
170+-- |
171+-- Collect all free type variables appearing in a type
172+--
173+freeTypeVariables :: Type -> [String]
174+freeTypeVariables = go []
175+ where
176+ go :: [String] -> Type -> [String]
177+ go bound (Object r) = go bound r
178+ go bound (TypeVar v) | v `notElem` bound = [v]
179+ go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2
180+ go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts
181+ go bound (ForAll v t _) = go (v : bound) t
182+ go bound (ConstrainedType cs t) = concatMap (go bound . snd) cs ++ go bound t
183+ go bound (RCons _ t r) = go bound t ++ go bound r
184+ go _ _ = []
185+
186+-- |
187+-- Universally quantify over all type variables appearing free in a type
188+--
189+quantify :: Type -> Type
190+quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty