git.iko.soy/rowtype-yoga/purescript-native
on 37a94cd help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/BindingGroups.hs
49 lines 1.7 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.BindingGroups
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-----------------------------------------------------------------------------
15module Language.PureScript.BindingGroups (
16 createBindingGroups
17) where
19import Data.Graph
20import Data.List (intersect)
22import Language.PureScript.Declarations
23import Language.PureScript.Names
24import Language.PureScript.Scope (usedNames)
26createBindingGroups :: [Declaration] -> [Declaration]
27createBindingGroups 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