Changeset 2981


Ignore:
Timestamp:
Mar 27, 2013, 4:53:06 PM (4 years ago)
Author:
sacerdot
Message:

New extraction after code simplification.

Location:
extracted
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • extracted/translateUtils.ml

    r2979 r2981  
    454454  (Registers.register, b_graph_translate_data) Bind_new.bind_new Types.sig0
    455455
    456 (** val get_first_costlabel :
     456(** val get_first_costlabel_next :
    457457    Joint.params -> AST.ident List.list ->
    458     Joint.joint_closed_internal_function -> CostLabel.costlabel **)
    459 let get_first_costlabel p g def =
     458    Joint.joint_closed_internal_function -> (CostLabel.costlabel, __)
     459    Types.prod **)
     460let get_first_costlabel_next p g def =
    460461  (match p.Joint.stmt_at g (Types.pi1 def).Joint.joint_if_code
    461462           (Types.pi1 def).Joint.joint_if_entry with
     
    465466      | Joint.Sequential (s', nxt) ->
    466467        (match s' with
    467          | Joint.COST_LABEL c -> (fun _ -> c)
     468         | Joint.COST_LABEL c ->
     469           (fun _ -> { Types.fst = c; Types.snd = nxt })
    468470         | Joint.CALL (x, x0, x1) ->
    469471           (fun _ -> assert false (* absurd case *))
     
    473475      | Joint.FCOND (x0, x1, x2) -> (fun _ -> assert false (* absurd case *))))
    474476    __
     477
     478(** val get_first_costlabel :
     479    Joint.params -> AST.ident List.list ->
     480    Joint.joint_closed_internal_function -> CostLabel.costlabel **)
     481let get_first_costlabel p g f =
     482  (get_first_costlabel_next p g f).Types.fst
    475483
    476484(** val not_emptyb : 'a1 List.list -> Bool.bool **)
     
    638646    Joint.joint_if_entry = entry }
    639647  in
    640   let prologue = data0.added_prologue in
    641   let { Types.fst = init0; Types.snd = entry' } =
    642     Obj.magic adds_graph_post dst_g_pars globals prologue
    643       (Obj.magic entry) init
    644   in
    645   let f_step0 =
    646     match not_emptyb prologue with
    647     | Bool.True ->
    648       (fun lbl ->
    649         match Identifiers.eq_identifier PreIdentifiers.LabelTag lbl
    650                 (Obj.magic entry) with
    651         | Bool.True ->
    652           (fun x -> Bind_new.Bret
    653             (Blocks.ensure_step_block
    654               (Joint.graph_params_to_params dst_g_pars) globals List.Nil))
    655         | Bool.False -> data0.f_step lbl)
    656     | Bool.False -> data0.f_step
    657   in
    658648  let f = fun lbl stmt def0 ->
    659649    match stmt with
    660650    | Joint.Sequential (inst, next) ->
    661       b_adds_graph dst_g_pars globals (f_step0 lbl inst) lbl (Obj.magic next)
    662         def0
     651      b_adds_graph dst_g_pars globals (data0.f_step lbl inst) lbl
     652        (Obj.magic next) def0
    663653    | Joint.Final inst ->
    664654      b_fin_adds_graph dst_g_pars globals (data0.f_fin lbl inst) lbl def0
     
    667657  let def_out =
    668658    Identifiers.foldi PreIdentifiers.LabelTag f
    669       (Obj.magic (Types.pi1 def).Joint.joint_if_code) init0
    670   in
     659      (Obj.magic (Types.pi1 def).Joint.joint_if_code) init
     660  in
     661  let prologue = data0.added_prologue in
    671662  let def_out0 =
    672663    match not_emptyb prologue with
    673664    | Bool.True ->
    674       let init_c =
    675         get_first_costlabel (Joint.graph_params_to_params src_g_pars) globals
    676           def
     665      let { Types.fst = init_c; Types.snd = nxt } =
     666        get_first_costlabel_next (Joint.graph_params_to_params src_g_pars)
     667          globals def
    677668      in
    678       let { Types.fst = def_out0; Types.snd = entry'' } =
     669      let def_out0 =
     670        Joint.add_graph dst_g_pars globals (Obj.magic entry)
     671          (Joint.Sequential ((Joint.Step_seq
     672          (Joint.nOOP
     673            (Joint.uns_pars__o__u_pars
     674              (Joint.gp_to_p__o__stmt_pars dst_g_pars)) globals)), nxt))
     675          def_out
     676      in
     677      let { Types.fst = def_out1; Types.snd = entry' } =
    679678        Obj.magic fresh_label (Joint.graph_params_to_params dst_g_pars)
    680           globals def_out
     679          globals def_out0
    681680      in
    682       let def_out1 =
    683         Joint.add_graph dst_g_pars globals entry'' (Joint.Sequential
    684           ((Joint.COST_LABEL init_c), entry')) def_out0
     681      let def_out2 =
     682        adds_graph dst_g_pars globals { Types.fst = { Types.fst = List.Nil;
     683          Types.snd = (fun x -> Joint.COST_LABEL init_c) }; Types.snd =
     684          prologue } entry' (Obj.magic entry) def_out1
    685685      in
    686       set_entry globals (Joint.graph_params_to_params dst_g_pars) def_out1
    687         (Obj.magic entry'')
     686      set_entry globals (Joint.graph_params_to_params dst_g_pars) def_out2
     687        (Obj.magic entry')
    688688    | Bool.False -> def_out
    689689  in
  • extracted/translateUtils.mli

    r2974 r2981  
    296296  (Registers.register, b_graph_translate_data) Bind_new.bind_new Types.sig0
    297297
     298val get_first_costlabel_next :
     299  Joint.params -> AST.ident List.list -> Joint.joint_closed_internal_function
     300  -> (CostLabel.costlabel, __) Types.prod
     301
    298302val get_first_costlabel :
    299303  Joint.params -> AST.ident List.list -> Joint.joint_closed_internal_function
Note: See TracChangeset for help on using the changeset viewer.