factored out build_module_namespace
authorhaftmann
Tue Sep 07 11:08:58 2010 +0200 (2010-09-07)
changeset 39203b2f9a6f4b84b
parent 39202 dd0660d93c31
child 39204 3d30f501b7c2
factored out build_module_namespace
src/Tools/Code/code_namespace.ML
     1.1 --- a/src/Tools/Code/code_namespace.ML	Tue Sep 07 11:08:57 2010 +0200
     1.2 +++ b/src/Tools/Code/code_namespace.ML	Tue Sep 07 11:08:58 2010 +0200
     1.3 @@ -7,6 +7,9 @@
     1.4  signature CODE_NAMESPACE =
     1.5  sig
     1.6    val dest_name: string -> string * string
     1.7 +  val build_module_namespace: { module_alias: string -> string option,
     1.8 +    module_prefix: string option, reserved: Name.context } -> Code_Thingol.program
     1.9 +    -> string list Symtab.table
    1.10    datatype ('a, 'b) node =
    1.11        Dummy
    1.12      | Stmt of 'a
    1.13 @@ -29,11 +32,23 @@
    1.14  structure Code_Namespace : CODE_NAMESPACE =
    1.15  struct
    1.16  
    1.17 -(** splitting names in module and base part **)
    1.18 +(** building module name hierarchy **)
    1.19  
    1.20  val dest_name =
    1.21    apfst Long_Name.implode o split_last o fst o split_last o Long_Name.explode;
    1.22  
    1.23 +fun build_module_namespace { module_alias, module_prefix, reserved } program =
    1.24 +  let
    1.25 +    fun alias_fragments name = case module_alias name
    1.26 +     of SOME name' => Long_Name.explode name'
    1.27 +      | NONE => map (fn name => fst (yield_singleton Name.variants name reserved))
    1.28 +          (Long_Name.explode name);
    1.29 +    val module_names = Graph.fold (insert (op =) o fst o dest_name o fst) program [];
    1.30 +  in
    1.31 +    fold (fn name => Symtab.update (name, alias_fragments name))
    1.32 +      module_names Symtab.empty
    1.33 +  end;
    1.34 +
    1.35  
    1.36  (** hierarchical program structure **)
    1.37  
    1.38 @@ -56,13 +71,8 @@
    1.39    let
    1.40  
    1.41      (* building module name hierarchy *)
    1.42 -    fun alias_fragments name = case module_alias name
    1.43 -     of SOME name' => Long_Name.explode name'
    1.44 -      | NONE => map (fn name => fst (yield_singleton Name.variants name reserved))
    1.45 -          (Long_Name.explode name);
    1.46 -    val module_names = Graph.fold (insert (op =) o fst o dest_name o fst) program [];
    1.47 -    val fragments_tab = fold (fn name => Symtab.update
    1.48 -      (name, alias_fragments name)) module_names Symtab.empty;
    1.49 +    val fragments_tab = build_module_namespace { module_alias = module_alias,
    1.50 +      module_prefix = NONE, reserved = reserved } program;
    1.51      val dest_name = dest_name #>> (the o Symtab.lookup fragments_tab);
    1.52  
    1.53      (* building empty module hierarchy *)