git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Initial work on desugaring type classes into dictionaries
0604bc1Phil Freeman
purescript.cabal+1
@@ -34,6 +34,7 @@ library
34 Language.PureScript.Sugar.TypeDeclarations
34 Language.PureScript.Sugar.TypeDeclarations
35 Language.PureScript.Sugar.BindingGroups
35 Language.PureScript.Sugar.BindingGroups
36 Language.PureScript.Sugar.Operators
36 Language.PureScript.Sugar.Operators
37+ Language.PureScript.Sugar.TypeClasses
37 Language.PureScript.CodeGen
38 Language.PureScript.CodeGen
38 Language.PureScript.CodeGen.Externs
39 Language.PureScript.CodeGen.Externs
39 Language.PureScript.CodeGen.JS
40 Language.PureScript.CodeGen.JS
src/Language/PureScript/Sugar.hs+3−1
@@ -23,9 +23,11 @@ import Language.PureScript.Sugar.DoNotation as S
23import Language.PureScript.Sugar.CaseDeclarations as S
23import Language.PureScript.Sugar.CaseDeclarations as S
24import Language.PureScript.Sugar.TypeDeclarations as S
24import Language.PureScript.Sugar.TypeDeclarations as S
25import Language.PureScript.Sugar.BindingGroups as S
25import Language.PureScript.Sugar.BindingGroups as S
26+import Language.PureScript.Sugar.TypeClasses as S
26
27
27desugar :: [Module] -> Either String [Module]
28desugar :: [Module] -> Either String [Module]
29+desugar = return . desugarTypeClasses
28−desugar = rebracket
30+ >=> rebracket
29 >=> desugarDo
31 >=> desugarDo
30 >=> desugarCasesModule
32 >=> desugarCasesModule
31 >=> desugarTypeDeclarationsModule
33 >=> desugarTypeDeclarationsModule
src/Language/PureScript/Sugar/TypeClasses.hsnew file+28
@@ -0,0 +1,28 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Sugar.TypeClasses
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.Sugar.TypeClasses (
16+ desugarTypeClasses
17+) where
18+
19+import Language.PureScript.Declarations
20+
21+desugarTypeClasses :: [Module] -> [Module]
22+desugarTypeClasses = map desugarModule
23+
24+desugarModule :: Module -> Module
25+desugarModule (Module name decls) = Module name $ concatMap desugarDecl decls
26+
27+desugarDecl :: Declaration -> [Declaration]
28+desugarDecl other = [other]
src/Language/PureScript/TypeChecker.hs+4
@@ -185,6 +185,10 @@ typeCheckAll currentModule (ImportDeclaration moduleName idents : rest) = do
185 constructs (Function _ ty) pn = ty `constructs` pn
185 constructs (Function _ ty) pn = ty `constructs` pn
186 constructs (TypeApp ty _) pn = ty `constructs` pn
186 constructs (TypeApp ty _) pn = ty `constructs` pn
187 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
187 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
188+typeCheckAll moduleName (TypeClassDeclaration name arg decls : rest) = do
189+ typeCheckAll moduleName rest
190+typeCheckAll moduleName (TypeInstanceDeclaration name ty decls : rest) = do
191+ typeCheckAll moduleName rest
188
192
189qualifyAllUnqualifiedNames :: (Data d) => ModuleName -> Environment -> d -> d
193qualifyAllUnqualifiedNames :: (Data d) => ModuleName -> Environment -> d -> d
190qualifyAllUnqualifiedNames mn env = everywhere (mkT go)
194qualifyAllUnqualifiedNames mn env = everywhere (mkT go)