Changeset 2981

Timestamp:

Mar 27, 2013, 4:53:06 PM (7 years ago)

Author:

sacerdot

Message:

New extraction after code simplification.

Location:

extracted

Files:

• translateUtils.ml (modified) (5 diffs)
• translateUtils.mli (modified) (1 diff)

extracted/translateUtils.ml

@@ -454 +454 @@
   (Registers.register, b_graph_translate_data) Bind_new.bind_new Types.sig0
 
-(** val get_first_costlabel :
+(** val get_first_costlabel_next :
     Joint.params -> AST.ident List.list ->
-    Joint.joint_closed_internal_function -> CostLabel.costlabel **)
-let get_first_costlabel p g def =
+    Joint.joint_closed_internal_function -> (CostLabel.costlabel, __)
+    Types.prod **)
+let get_first_costlabel_next p g def =
   (match p.Joint.stmt_at g (Types.pi1 def).Joint.joint_if_code
            (Types.pi1 def).Joint.joint_if_entry with
@@ -465 +466 @@
       | Joint.Sequential (s', nxt) ->
         (match s' with
-         | Joint.COST_LABEL c -> (fun _ -> c)
+         | Joint.COST_LABEL c ->
+           (fun _ -> { Types.fst = c; Types.snd = nxt })
          | Joint.CALL (x, x0, x1) ->
            (fun _ -> assert false (* absurd case *))
@@ -473 +475 @@
       | Joint.FCOND (x0, x1, x2) -> (fun _ -> assert false (* absurd case *))))
     __
+
+(** val get_first_costlabel :
+    Joint.params -> AST.ident List.list ->
+    Joint.joint_closed_internal_function -> CostLabel.costlabel **)
+let get_first_costlabel p g f =
+  (get_first_costlabel_next p g f).Types.fst
 
 (** val not_emptyb : 'a1 List.list -> Bool.bool **)
@@ -638 +646 @@
     Joint.joint_if_entry = entry }
   in
-  let prologue = data0.added_prologue in
-  let { Types.fst = init0; Types.snd = entry' } =
-    Obj.magic adds_graph_post dst_g_pars globals prologue
-      (Obj.magic entry) init
-  in
-  let f_step0 =
-    match not_emptyb prologue with
-    | Bool.True ->
-      (fun lbl ->
-        match Identifiers.eq_identifier PreIdentifiers.LabelTag lbl
-                (Obj.magic entry) with
-        | Bool.True ->
-          (fun x -> Bind_new.Bret
-            (Blocks.ensure_step_block
-              (Joint.graph_params_to_params dst_g_pars) globals List.Nil))
-        | Bool.False -> data0.f_step lbl)
-    | Bool.False -> data0.f_step
-  in
   let f = fun lbl stmt def0 ->
     match stmt with
     | Joint.Sequential (inst, next) ->
-      b_adds_graph dst_g_pars globals (f_step0 lbl inst) lbl (Obj.magic next)
-        def0
+      b_adds_graph dst_g_pars globals (data0.f_step lbl inst) lbl
+        (Obj.magic next) def0
     | Joint.Final inst ->
       b_fin_adds_graph dst_g_pars globals (data0.f_fin lbl inst) lbl def0
@@ -667 +657 @@
   let def_out =
     Identifiers.foldi PreIdentifiers.LabelTag f
-      (Obj.magic (Types.pi1 def).Joint.joint_if_code) init0
-  in
+      (Obj.magic (Types.pi1 def).Joint.joint_if_code) init
+  in
+  let prologue = data0.added_prologue in
   let def_out0 =
     match not_emptyb prologue with
     | Bool.True ->
-      let init_c =
-        get_first_costlabel (Joint.graph_params_to_params src_g_pars) globals
-          def
+      let { Types.fst = init_c; Types.snd = nxt } =
+        get_first_costlabel_next (Joint.graph_params_to_params src_g_pars)
+          globals def
       in
-      let { Types.fst = def_out0; Types.snd = entry'' } =
+      let def_out0 =
+        Joint.add_graph dst_g_pars globals (Obj.magic entry)
+          (Joint.Sequential ((Joint.Step_seq
+          (Joint.nOOP
+            (Joint.uns_pars__o__u_pars
+              (Joint.gp_to_p__o__stmt_pars dst_g_pars)) globals)), nxt))
+          def_out
+      in
+      let { Types.fst = def_out1; Types.snd = entry' } =
         Obj.magic fresh_label (Joint.graph_params_to_params dst_g_pars)
-          globals def_out
+          globals def_out0
       in
-      let def_out1 =
-        Joint.add_graph dst_g_pars globals entry'' (Joint.Sequential
-          ((Joint.COST_LABEL init_c), entry')) def_out0
+      let def_out2 =
+        adds_graph dst_g_pars globals { Types.fst = { Types.fst = List.Nil;
+          Types.snd = (fun x -> Joint.COST_LABEL init_c) }; Types.snd =
+          prologue } entry' (Obj.magic entry) def_out1
       in
-      set_entry globals (Joint.graph_params_to_params dst_g_pars) def_out1
-        (Obj.magic entry'')
+      set_entry globals (Joint.graph_params_to_params dst_g_pars) def_out2
+        (Obj.magic entry')
     | Bool.False -> def_out
   in

extracted/translateUtils.mli

@@ -296 +296 @@
   (Registers.register, b_graph_translate_data) Bind_new.bind_new Types.sig0
 
+val get_first_costlabel_next :
+  Joint.params -> AST.ident List.list -> Joint.joint_closed_internal_function
+  -> (CostLabel.costlabel, __) Types.prod
+
 val get_first_costlabel :
   Joint.params -> AST.ident List.list -> Joint.joint_closed_internal_function