simultaneous modification of statements
authorhaftmann
Wed Sep 01 17:14:42 2010 +0200 (2010-09-01)
changeset 390233f70c03e8282
parent 39022 ac7774a35bcf
child 39024 30d5dd2f30b6
simultaneous modification of statements
src/Tools/Code/code_namespace.ML
src/Tools/Code/code_scala.ML
     1.1 --- a/src/Tools/Code/code_namespace.ML	Wed Sep 01 16:08:31 2010 +0200
     1.2 +++ b/src/Tools/Code/code_namespace.ML	Wed Sep 01 17:14:42 2010 +0200
     1.3 @@ -14,10 +14,10 @@
     1.4      reserved: Name.context, empty_nsp: 'c, namify_module: string -> 'c -> string * 'c,
     1.5      namify_stmt: Code_Thingol.stmt -> string -> 'c -> string * 'c,
     1.6      cyclic_modules: bool, empty_data: 'b, memorize_data: string -> 'b -> 'b,
     1.7 -    modify_stmt: Code_Thingol.stmt -> Code_Thingol.stmt option }
     1.8 +    modify_stmts: Code_Thingol.stmt list -> 'a option list }
     1.9        -> Code_Thingol.program
    1.10        -> { deresolver: string list -> string -> string,
    1.11 -           hierarchical_program: (string * (Code_Thingol.stmt, 'b) node) Graph.T }
    1.12 +           hierarchical_program: (string * ('a, 'b) node) Graph.T }
    1.13  end;
    1.14  
    1.15  structure Code_Namespace : CODE_NAMESPACE =
    1.16 @@ -38,7 +38,7 @@
    1.17          o map_module name_fragments;
    1.18  
    1.19  fun hierarchical_program labelled_name { module_alias, reserved, empty_nsp,
    1.20 -      namify_module, namify_stmt, cyclic_modules, empty_data, memorize_data, modify_stmt } program =
    1.21 +      namify_module, namify_stmt, cyclic_modules, empty_data, memorize_data, modify_stmts } program =
    1.22    let
    1.23  
    1.24      (* building module name hierarchy *)
    1.25 @@ -77,8 +77,8 @@
    1.26          val (name_fragments', base') = dest_name name';
    1.27          val (name_fragments_common, (diff, diff')) =
    1.28            chop_prefix (op =) (name_fragments, name_fragments');
    1.29 -        val (is_module, dep) = if null diff then (false, (name, name'))
    1.30 -          else (true, (hd diff, hd diff'))
    1.31 +        val is_module = not (null diff andalso null diff');
    1.32 +        val dep = pairself hd (diff @ [name], diff' @ [name']);
    1.33          val add_edge = if is_module andalso not cyclic_modules
    1.34            then (fn node => Graph.add_edge_acyclic dep node
    1.35              handle Graph.CYCLES _ => error ("Dependency "
    1.36 @@ -105,11 +105,15 @@
    1.37          val (nsps', nodes') = (nsps, nodes)
    1.38            |> fold (declare (K namify_module)) module_fragments
    1.39            |> fold (declare (namify_stmt o (fn Stmt stmt => stmt))) stmt_names;
    1.40 -        val nodes'' = nodes'
    1.41 -          |> fold (fn name_fragment => (Graph.map_node name_fragment
    1.42 -              o apsnd o map_module_content) (make_declarations nsps')) module_fragments
    1.43 -          |> fold (fn name => (Graph.map_node name o apsnd) (fn Stmt stmt =>
    1.44 -               case modify_stmt stmt of NONE => Dummy | SOME stmt => Stmt stmt)) stmt_names;
    1.45 +        val modify_stmts' = filter (member (op =) stmt_names)
    1.46 +          #> AList.make (snd o Graph.get_node nodes)
    1.47 +          #> split_list
    1.48 +          ##> map (fn Stmt stmt => stmt)
    1.49 +          ##> modify_stmts
    1.50 +          #> op ~~;
    1.51 +        val stmtss' = maps modify_stmts' (Graph.strong_conn nodes);
    1.52 +        val nodes'' = Graph.map (fn name => apsnd (fn Module content => Module (make_declarations nsps' content)
    1.53 +            | _ => case AList.lookup (op =) stmtss' name of SOME (SOME stmt) => Stmt stmt | _ => Dummy)) nodes';
    1.54          val data' = fold memorize_data stmt_names data;
    1.55        in (data', nodes'') end;
    1.56      val (_, hierarchical_program) = make_declarations empty_nsp proto_program;
     2.1 --- a/src/Tools/Code/code_scala.ML	Wed Sep 01 16:08:31 2010 +0200
     2.2 +++ b/src/Tools/Code/code_scala.ML	Wed Sep 01 17:14:42 2010 +0200
     2.3 @@ -193,8 +193,7 @@
     2.4                  str "match", str "{"], str "}")
     2.5                (map print_clause eqs)
     2.6            end;
     2.7 -    val print_method = str o Library.enclose "`" "`" o space_implode "+"
     2.8 -      o Long_Name.explode o deresolve_full;
     2.9 +    val print_method = str o Library.enclose "`" "`" o deresolve_full;
    2.10      fun print_stmt (name, Code_Thingol.Fun (_, (((vs, ty), raw_eqs), _))) =
    2.11            print_def name (vs, ty) (filter (snd o snd) raw_eqs)
    2.12        | print_stmt (name, Code_Thingol.Datatype (_, (vs, cos))) =
    2.13 @@ -325,7 +324,7 @@
    2.14    in
    2.15      Code_Namespace.hierarchical_program labelled_name { module_alias = module_alias, reserved = reserved,
    2.16        empty_nsp = ((reserved, reserved), reserved), namify_module = namify_module, namify_stmt = namify_stmt,
    2.17 -      cyclic_modules = true, empty_data = [], memorize_data = memorize_implicits, modify_stmt = modify_stmt } program
    2.18 +      cyclic_modules = true, empty_data = [], memorize_data = memorize_implicits, modify_stmts = map modify_stmt } program
    2.19    end;
    2.20  
    2.21  fun serialize_scala { labelled_name, reserved_syms, includes,
    2.22 @@ -368,7 +367,7 @@
    2.23        let
    2.24          val s = deresolver prefix_fragments implicit;
    2.25        in if length (Long_Name.explode s) = 1 then NONE else SOME (str s) end;
    2.26 -    fun print_node _ (_, Dummy) = NONE
    2.27 +    fun print_node _ (_, Code_Namespace.Dummy) = NONE
    2.28        | print_node prefix_fragments (name, Code_Namespace.Stmt stmt) =
    2.29            if null presentation_names
    2.30            orelse member (op =) presentation_names name