Ignore:
Timestamp:
Nov 23, 2011, 1:55:12 PM (8 years ago)
Author:
tranquil
Message:

branch up to date

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051-indexed-labels-branch/src/languages.ml

    r1507 r1539  
    5353  | language -> [to_string language]
    5454
    55 let parse = function
     55let parse ?is_lustre_file ?remove_lustre_externals = function
    5656  | Clight ->
    57     fun filename -> AstClight (ClightParser.process filename)
     57    fun filename ->
     58      AstClight
     59        (ClightParser.process ?is_lustre_file ?remove_lustre_externals filename)
    5860
    5961(*
     
    113115
    114116let ltl_to_lin = function
    115   | AstLTL p -> 
     117  | AstLTL p ->
    116118    AstLIN (LTLToLIN.translate p)
    117119  | _ -> assert false
    118120
    119121let lin_to_asm = function
    120   | AstLIN p -> 
     122  | AstLIN p ->
    121123    AstASM (LINToASM.translate p)
    122124  | _ -> assert false
     
    137139
    138140let insert_transformations ts chain =
    139         (* turn transformation into elements of the compilation chain *)
    140         let trans_to_comp (n, t) = (n, n, t) in
    141         let ts = List.map trans_to_comp ts in
    142         (* ts and chain are merged, and then sorted so that the resulting list is *)
    143         (* still a well formed compilation chain. Stable sort preserves order *)
    144         (* between transformations on the same language as appearing in ts *)
    145         let compare (n1, n2, s) (m1, m2, t) = compare (n1, n2) (m1, m2) in
    146         List.stable_sort compare (ts @ chain)
     141  (* turn transformation into elements of the compilation chain *)
     142  let trans_to_comp (n, t) = (n, n, t) in
     143  let ts = List.map trans_to_comp ts in
     144  (* ts and chain are merged, and then sorted so that the resulting list is *)
     145  (* still a well formed compilation chain. Stable sort preserves order *)
     146  (* between transformations on the same language as appearing in ts *)
     147  let compare (n1, n2, s) (m1, m2, t) = compare (n1, n2) (m1, m2) in
     148  List.stable_sort compare (ts @ chain)
    147149
    148150let compile debug ts src tgt =
    149         (* insert intermediate transformations *)
     151  (* insert intermediate transformations *)
    150152  let chain = insert_transformations ts compilation_chain in
    151         (* erase transformations whose source is strictly before src *)
    152         let chain = List.filter (function (l1, _, _) -> l1 >= src) chain in
     153  (* erase transformations whose source is strictly before src *)
     154  let chain = List.filter (function (l1, _, _) -> l1 >= src) chain in
    153155  (* erase transformations whose target is strictly after tgt *)
    154         let chain = List.filter (function (_, l2, _) -> l2 <= tgt) chain in
     156  let chain = List.filter (function (_, l2, _) -> l2 <= tgt) chain in
    155157  (* Compose the atomic translations to build a compilation function
    156158     from [src] to [tgt]. Again, we assume that the compilation chain
     
    217219let instrument cost_tern costs_mapping = function
    218220  | AstClight p ->
    219     let (p', cost_id, cost_incr) =
     221    let (p', cost_id, cost_incr, extern_cost_variables) =
    220222      ClightAnnotator.instrument cost_tern p costs_mapping in
    221     (AstClight p', cost_id, cost_incr)
     223    (AstClight p', cost_id, cost_incr, extern_cost_variables)
    222224(*
    223225  | AstCminor p ->
     
    230232         "Instrumentation is not implemented for source language `%s'."
    231233         (to_string (language_of_ast p)));
    232     (p, "", "")
     234    (p, "", "", StringTools.Map.empty)
    233235
    234236let annotate cost_tern input_ast final =
     
    236238  instrument cost_tern costs_mapping input_ast
    237239
    238 let string_output = function
     240let string_output asm_pretty = function
    239241  | AstClight p ->
    240242    [ClightPrinter.print_program p]
     
    252254    [LINPrinter.print_program p]
    253255  | AstASM p ->
    254     [Pretty.print_program p ; ASMPrinter.print_program p]
    255 
    256 let save exact_output filename suffix ast =
     256    (if asm_pretty then [Pretty.print_program p]
     257     else ["Pretty print not requested"]) @
     258    [ASMPrinter.print_program p]
     259
     260let save asm_pretty exact_output filename suffix ast =
    257261  let ext_chopped_filename =
    258262    if exact_output then filename
     
    267271    if exact_output then ext_filenames
    268272    else List.map Misc.SysExt.alternative ext_filenames in
    269   let output_strings = string_output ast in
     273  let output_strings = string_output asm_pretty ast in
    270274  let f filename s =
    271275    let cout = open_out filename in
     
    275279  List.iter2 f output_filenames output_strings
    276280
    277 let save_cost filename cost_id cost_incr =
     281let save_cost exact_name filename cost_id cost_incr extern_cost_variables =
     282  let filename =
     283    if exact_name then filename
     284    else
     285      try Filename.chop_extension filename
     286      with Invalid_argument ("Filename.chop_extension") -> filename in
    278287  let cout = open_out (filename ^ ".cerco") in
     288  let f fun_name cost_var =
     289    output_string cout (fun_name ^ " " ^ cost_var ^ "\n") in
    279290  output_string cout (cost_id ^ "\n");
    280291  output_string cout (cost_incr ^ "\n");
     292  StringTools.Map.iter f extern_cost_variables;
    281293  flush cout;
    282294  close_out cout
     
    299311  | AstASM p ->
    300312    ASMInterpret.interpret debug p
     313
     314let add_lustre_main
     315    lustre_test lustre_test_cases lustre_test_cycles
     316    lustre_test_min_int lustre_test_max_int = function
     317  | AstClight p ->
     318    AstClight
     319      (ClightLustreMain.add lustre_test lustre_test_cases lustre_test_cycles
     320         lustre_test_min_int lustre_test_max_int p)
     321  | _ ->
     322    Error.global_error "during main generation"
     323      "Lustre testing is only available with C programs."
Note: See TracChangeset for help on using the changeset viewer.