explicit modify_stmt parameter
authorhaftmann
Wed Sep 01 16:08:31 2010 +0200 (2010-09-01)
changeset 39022ac7774a35bcf
parent 39021 139aada5caf8
child 39023 3f70c03e8282
explicit modify_stmt parameter
src/Tools/Code/code_namespace.ML
src/Tools/Code/code_scala.ML
     1.1 --- a/src/Tools/Code/code_namespace.ML	Wed Sep 01 15:51:49 2010 +0200
     1.2 +++ b/src/Tools/Code/code_namespace.ML	Wed Sep 01 16:08:31 2010 +0200
     1.3 @@ -11,9 +11,10 @@
     1.4      | Stmt of 'a
     1.5      | Module of ('b * (string * ('a, 'b) node) Graph.T);
     1.6    val hierarchical_program: (string -> string) -> { module_alias: string -> string option,
     1.7 -    reserved: Name.context, empty_nsp: 'a, namify_module: string -> 'a -> string * 'a,
     1.8 -    namify_stmt: Code_Thingol.stmt -> string -> 'a -> string * 'a,
     1.9 -    cyclic_modules: bool, empty_data: 'b, memorize_data: string -> 'b -> 'b }
    1.10 +    reserved: Name.context, empty_nsp: 'c, namify_module: string -> 'c -> string * 'c,
    1.11 +    namify_stmt: Code_Thingol.stmt -> string -> 'c -> string * 'c,
    1.12 +    cyclic_modules: bool, empty_data: 'b, memorize_data: string -> 'b -> 'b,
    1.13 +    modify_stmt: Code_Thingol.stmt -> Code_Thingol.stmt option }
    1.14        -> Code_Thingol.program
    1.15        -> { deresolver: string list -> string -> string,
    1.16             hierarchical_program: (string * (Code_Thingol.stmt, 'b) node) Graph.T }
    1.17 @@ -37,7 +38,7 @@
    1.18          o map_module name_fragments;
    1.19  
    1.20  fun hierarchical_program labelled_name { module_alias, reserved, empty_nsp,
    1.21 -      namify_module, namify_stmt, cyclic_modules, empty_data, memorize_data } program =
    1.22 +      namify_module, namify_stmt, cyclic_modules, empty_data, memorize_data, modify_stmt } program =
    1.23    let
    1.24  
    1.25      (* building module name hierarchy *)
    1.26 @@ -89,28 +90,26 @@
    1.27        |> Graph.fold (fn (name, (stmt, _)) => add_stmt name stmt) program
    1.28        |> Graph.fold (fn (name, (_, (_, names))) => fold (add_dependency name) names) program;
    1.29  
    1.30 -    (* name declarations *)
    1.31 +    (* name declarations, data and statement modifications *)
    1.32      fun make_declarations nsps (data, nodes) =
    1.33        let
    1.34          val (module_fragments, stmt_names) = List.partition
    1.35            (fn name_fragment => case Graph.get_node nodes name_fragment
    1.36              of (_, Module _) => true | _ => false) (Graph.keys nodes);
    1.37 -        fun modify_stmt (Stmt (Code_Thingol.Datatypecons _)) = Dummy
    1.38 -          | modify_stmt (Stmt (Code_Thingol.Classrel _)) = Dummy
    1.39 -          | modify_stmt (Stmt (Code_Thingol.Classparam _)) = Dummy
    1.40 -          | modify_stmt stmt = stmt;
    1.41 -        fun declare namify modify name (nsps, nodes) =
    1.42 +        fun declare namify name (nsps, nodes) =
    1.43            let
    1.44              val (base, node) = Graph.get_node nodes name;
    1.45              val (base', nsps') = namify node base nsps;
    1.46 -            val nodes' = Graph.map_node name (K (base', modify node)) nodes;
    1.47 +            val nodes' = Graph.map_node name (K (base', node)) nodes;
    1.48            in (nsps', nodes') end;
    1.49          val (nsps', nodes') = (nsps, nodes)
    1.50 -          |> fold (declare (K namify_module) I) module_fragments
    1.51 -          |> fold (declare (namify_stmt o (fn Stmt stmt => stmt)) modify_stmt) stmt_names;
    1.52 +          |> fold (declare (K namify_module)) module_fragments
    1.53 +          |> fold (declare (namify_stmt o (fn Stmt stmt => stmt))) stmt_names;
    1.54          val nodes'' = nodes'
    1.55            |> fold (fn name_fragment => (Graph.map_node name_fragment
    1.56 -              o apsnd o map_module_content) (make_declarations nsps')) module_fragments;
    1.57 +              o apsnd o map_module_content) (make_declarations nsps')) module_fragments
    1.58 +          |> fold (fn name => (Graph.map_node name o apsnd) (fn Stmt stmt =>
    1.59 +               case modify_stmt stmt of NONE => Dummy | SOME stmt => Stmt stmt)) stmt_names;
    1.60          val data' = fold memorize_data stmt_names data;
    1.61        in (data', nodes'') end;
    1.62      val (_, hierarchical_program) = make_declarations empty_nsp proto_program;
     2.1 --- a/src/Tools/Code/code_scala.ML	Wed Sep 01 15:51:49 2010 +0200
     2.2 +++ b/src/Tools/Code/code_scala.ML	Wed Sep 01 16:08:31 2010 +0200
     2.3 @@ -318,10 +318,14 @@
     2.4          val implicits = filter (is_classinst o Graph.get_node program)
     2.5            (Graph.imm_succs program name);
     2.6        in union (op =) implicits end;
     2.7 +    fun modify_stmt (Code_Thingol.Datatypecons _) = NONE
     2.8 +      | modify_stmt (Code_Thingol.Classrel _) = NONE
     2.9 +      | modify_stmt (Code_Thingol.Classparam _) = NONE
    2.10 +      | modify_stmt stmt = SOME stmt;
    2.11    in
    2.12      Code_Namespace.hierarchical_program labelled_name { module_alias = module_alias, reserved = reserved,
    2.13        empty_nsp = ((reserved, reserved), reserved), namify_module = namify_module, namify_stmt = namify_stmt,
    2.14 -      cyclic_modules = true, empty_data = [], memorize_data = memorize_implicits } program
    2.15 +      cyclic_modules = true, empty_data = [], memorize_data = memorize_implicits, modify_stmt = modify_stmt } program
    2.16    end;
    2.17  
    2.18  fun serialize_scala { labelled_name, reserved_syms, includes,