37a94cd · rowtype-yoga/purescript-native

examples/passing/MutRec.pursnew file+4

compare with golang

unifiedsplit

@@ -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

27import Language.PureScript.Operators as P

28import Language.PureScript.CaseDeclarations as P

29import Language.PureScript.TypeDeclarations as P

30+import Language.PureScript.BindingGroups as P

30

31

31import Data.List (intercalate)

32import Data.List (intercalate)

32import Data.Maybe (mapMaybe)

33import Data.Maybe (mapMaybe)

@@ -35,7 +36,7 @@ import Control.Monad ((>=>))

35compile :: [Declaration] -> Either String (String, String, Environment)

36compile :: [Declaration] -> Either String (String, String, Environment)

36compile decls = do

37compile decls = do

37 bracketted <- rebracket decls

38 bracketted <- rebracket decls

38− desugared <- desugarCases >=> desugarTypeDeclarations $ bracketted

39+ desugared <- desugarCases >=> desugarTypeDeclarations >=> (return . createBindingGroups) $ bracketted

39 (_, env) <- runCheck (typeCheckAll desugared)

40 (_, env) <- runCheck (typeCheckAll desugared)

40 let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ desugared

41 let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ desugared

41 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ desugared

42 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ desugared

src/Language/PureScript/BindingGroups.hs+30−3

@@ -13,10 +13,37 @@

13-----------------------------------------------------------------------------

14

15module Language.PureScript.BindingGroups (

16− bindingGroups

16+ createBindingGroups

17) where

18

19+import Data.Graph

20+import Data.List (intersect)

21+

19import Language.PureScript.Declarations

22import Language.PureScript.Declarations

23+import Language.PureScript.Names

24+import Language.PureScript.Scope (usedNames)

20

25

21−bindingGroups :: [Declaration] -> [[Declaration]]

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

22−bindingGroups = undefined

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

34 | TypeSynonymDeclaration ProperName [String] PolyType

35 | TypeDeclaration Ident PolyType

36 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value

37+ | BindingGroupDeclaration [Declaration]

37 | ExternDeclaration Ident PolyType

38 | ExternDeclaration Ident PolyType

38 | ExternMemberDeclaration String Ident PolyType

39 | ExternMemberDeclaration String Ident PolyType

39 | ExternDataDeclaration ProperName Kind

40 | ExternDataDeclaration ProperName Kind

src/Language/PureScript/TypeChecker.hs+1

@@ -74,6 +74,7 @@ typeCheckAll (ValueDeclaration name [] Nothing val : rest) = do

74 putEnv (env { names = M.insert (modulePath, name) (ty, Value) (names env) })

75 typeCheckAll rest

76typeCheckAll (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"

77+typeCheckAll (BindingGroupDeclaration ds : rest) = error $ show ds

77typeCheckAll (ExternDataDeclaration name kind : rest) = do

78typeCheckAll (ExternDataDeclaration name kind : rest) = do

78 env <- getEnv

79 env <- getEnv

79 modulePath <- checkModulePath `fmap` get

80 modulePath <- checkModulePath `fmap` get