git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Work so far on binding groups
commit37a94cd2c05169cd137c234e8f85296c7e4998cd authorPhil Freeman <paf31@cantab.net> dateSun 29 Dec 2013, 13:18 (13 years ago) parent8877913
5 files changed+38−4
compare with golang
unifiedsplit
examples/passing/MutRec.purs+4 src/Language/PureScript.hs+2−1 src/Language/PureScript/BindingGroups.hs+30−3 src/Language/PureScript/Declarations.hs+1 src/Language/PureScript/TypeChecker.hs+1
examples/passing/MutRec.pursnew file+4
@@ -0,0 +1,4 @@
1+f 0 = 0
2+f x = g x + 1
3+
4+g x = f (x / 2)
src/Language/PureScript.hs+2−1
@@ -27,6 +27,7 @@ import Language.PureScript.Optimize as P
2727import Language.PureScript.Operators as P
2828import Language.PureScript.CaseDeclarations as P
2929import Language.PureScript.TypeDeclarations as P
30+import Language.PureScript.BindingGroups as P
3031
3132import Data.List (intercalate)
3233import Data.Maybe (mapMaybe)
@@ -35,7 +36,7 @@ import Control.Monad ((>=>))
3536compile :: [Declaration] -> Either String (String, String, Environment)
3637compile decls = do
3738 bracketted <- rebracket decls
38− desugared <- desugarCases >=> desugarTypeDeclarations $ bracketted
39+ desugared <- desugarCases >=> desugarTypeDeclarations >=> (return . createBindingGroups) $ bracketted
3940 (_, env) <- runCheck (typeCheckAll desugared)
4041 let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ desugared
4142 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ desugared
src/Language/PureScript/BindingGroups.hs+30−3
@@ -13,10 +13,37 @@
1313-----------------------------------------------------------------------------
1414
1515module Language.PureScript.BindingGroups (
16− bindingGroups
16+ createBindingGroups
1717) where
1818
19+import Data.Graph
20+import Data.List (intersect)
21+
1922import Language.PureScript.Declarations
23+import Language.PureScript.Names
24+import Language.PureScript.Scope (usedNames)
2025
21−bindingGroups :: [Declaration] -> [[Declaration]]
22−bindingGroups = undefined
26+createBindingGroups :: [Declaration] -> [Declaration]
27+createBindingGroups ds =
28+ let
29+ values = filter isValueDecl ds
30+ nonValues = filter (not . isValueDecl) ds
31+ allIdents = map getIdent values
32+ verts = map (\d -> (d, getIdent d, usedNames d `intersect` allIdents)) values
33+ sorted = map toBindingGroup $ stronglyConnComp verts
34+ in
35+ map handleModuleDeclaration nonValues ++ sorted
36+ where
37+ isValueDecl :: Declaration -> Bool
38+ isValueDecl (ValueDeclaration _ _ _ _) = True
39+ isValueDecl _ = False
40+ getIdent :: Declaration -> Ident
41+ getIdent (ValueDeclaration ident _ _ _) = ident
42+ getIdent _ = error "undefined"
43+ toBindingGroup :: SCC Declaration -> Declaration
44+ toBindingGroup (AcyclicSCC d) = d
45+ toBindingGroup (CyclicSCC [d]) = d
46+ toBindingGroup (CyclicSCC ds') = BindingGroupDeclaration ds'
47+ handleModuleDeclaration :: Declaration -> Declaration
48+ handleModuleDeclaration (ModuleDeclaration name ds') = ModuleDeclaration name $ createBindingGroups ds'
49+ handleModuleDeclaration other = other
src/Language/PureScript/Declarations.hs+1
@@ -34,6 +34,7 @@ data Declaration
3434 | TypeSynonymDeclaration ProperName [String] PolyType
3535 | TypeDeclaration Ident PolyType
3636 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
37+ | BindingGroupDeclaration [Declaration]
3738 | ExternDeclaration Ident PolyType
3839 | ExternMemberDeclaration String Ident PolyType
3940 | ExternDataDeclaration ProperName Kind
src/Language/PureScript/TypeChecker.hs+1
@@ -74,6 +74,7 @@ typeCheckAll (ValueDeclaration name [] Nothing val : rest) = do
7474 putEnv (env { names = M.insert (modulePath, name) (ty, Value) (names env) })
7575 typeCheckAll rest
7676typeCheckAll (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
77+typeCheckAll (BindingGroupDeclaration ds : rest) = error $ show ds
7778typeCheckAll (ExternDataDeclaration name kind : rest) = do
7879 env <- getEnv
7980 modulePath <- checkModulePath `fmap` get