git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Initial work on desugaring type classes into dictionaries
commit0604bc187857c5f485e9f146a161f3ca60938bbc authorPhil Freeman <paf31@cantab.net> dateSun 12 Jan 2014, 12:02 (13 years ago) parent47eba26
4 files changed+36−1
compare with golang
unifiedsplit
purescript.cabal+1 src/Language/PureScript/Sugar.hs+3−1 src/Language/PureScript/Sugar/TypeClasses.hs+28 src/Language/PureScript/TypeChecker.hs+4
purescript.cabal+1
@@ -34,6 +34,7 @@ library
3434 Language.PureScript.Sugar.TypeDeclarations
3535 Language.PureScript.Sugar.BindingGroups
3636 Language.PureScript.Sugar.Operators
37+ Language.PureScript.Sugar.TypeClasses
3738 Language.PureScript.CodeGen
3839 Language.PureScript.CodeGen.Externs
3940 Language.PureScript.CodeGen.JS
src/Language/PureScript/Sugar.hs+3−1
@@ -23,9 +23,11 @@ import Language.PureScript.Sugar.DoNotation as S
2323import Language.PureScript.Sugar.CaseDeclarations as S
2424import Language.PureScript.Sugar.TypeDeclarations as S
2525import Language.PureScript.Sugar.BindingGroups as S
26+import Language.PureScript.Sugar.TypeClasses as S
2627
2728desugar :: [Module] -> Either String [Module]
28−desugar = rebracket
29+desugar = return . desugarTypeClasses
30+ >=> rebracket
2931 >=> desugarDo
3032 >=> desugarCasesModule
3133 >=> 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
185185 constructs (Function _ ty) pn = ty `constructs` pn
186186 constructs (TypeApp ty _) pn = ty `constructs` pn
187187 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
188192
189193qualifyAllUnqualifiedNames :: (Data d) => ModuleName -> Environment -> d -> d
190194qualifyAllUnqualifiedNames mn env = everywhere (mkT go)