Skip to content
Snippets Groups Projects
Commit 8d22ea35 authored by Guillaume DAVY's avatar Guillaume DAVY
Browse files

Ada: Some indentation

parent 09d7b39f
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/backends/Ada/ada_backend_adb.ml
+ 71
− 71
View file @ 8d22ea35
......@@ -133,78 +133,78 @@ struct
fprintf fmt "%a" (Utils.fprintf_list ~sep:"" pp_oneline_comment) lines
| _ -> assert false
(** Print the definition of the step procedure from a machine.
@param typed_submachines list of all typed machine instances of this machine
@param fmt the formater to print on
@param machine the machine
**)
let pp_step_definition typed_submachines fmt m = pp_procedure_definition
pp_step_procedure_name
(pp_step_prototype m)
(pp_machine_var_decl NoMode)
(pp_machine_instr typed_submachines m)
fmt
(m.mstep.step_locals, m.mstep.step_instrs)
(** Print the definition of the reset procedure from a machine.
@param typed_submachines list of all typed machine instances of this machine
@param fmt the formater to print on
@param machine the machine
**)
let pp_reset_definition typed_submachines fmt m = pp_procedure_definition
pp_reset_procedure_name
(pp_reset_prototype m)
(pp_machine_var_decl NoMode)
(pp_machine_instr typed_submachines m)
fmt
([], m.minit)
(** Print the package definition(ads) of a machine.
It requires the list of all typed instance.
A typed submachine instance is (ident, type_machine) with ident
the instance name and typed_machine is (substitution, machine) with machine
the machine associated to the instance and substitution the instanciation of
all its polymorphic types.
@param fmt the formater to print on
@param typed_submachines list of all typed machine instances of this machine
@param m the machine
**)
let pp_file fmt (typed_submachines, machine) =
let pp_reset fmt =
if is_machine_statefull machine then
fprintf fmt "%a;@,@," (pp_reset_definition typed_submachines) machine
else
fprintf fmt ""
in
let aux pkgs (id, _) =
try
let (pkg, _) = List.assoc id ada_supported_funs in
if List.mem pkg pkgs then
pkgs
(** Print the definition of the step procedure from a machine.
@param typed_submachines list of all typed machine instances of this machine
@param fmt the formater to print on
@param machine the machine
**)
let pp_step_definition typed_submachines fmt m = pp_procedure_definition
pp_step_procedure_name
(pp_step_prototype m)
(pp_machine_var_decl NoMode)
(pp_machine_instr typed_submachines m)
fmt
(m.mstep.step_locals, m.mstep.step_instrs)
(** Print the definition of the reset procedure from a machine.
@param typed_submachines list of all typed machine instances of this machine
@param fmt the formater to print on
@param machine the machine
**)
let pp_reset_definition typed_submachines fmt m = pp_procedure_definition
pp_reset_procedure_name
(pp_reset_prototype m)
(pp_machine_var_decl NoMode)
(pp_machine_instr typed_submachines m)
fmt
([], m.minit)
(** Print the package definition(ads) of a machine.
It requires the list of all typed instance.
A typed submachine instance is (ident, type_machine) with ident
the instance name and typed_machine is (substitution, machine) with machine
the machine associated to the instance and substitution the instanciation of
all its polymorphic types.
@param fmt the formater to print on
@param typed_submachines list of all typed machine instances of this machine
@param m the machine
**)
let pp_file fmt (typed_submachines, machine) =
let pp_reset fmt =
if is_machine_statefull machine then
fprintf fmt "%a;@,@," (pp_reset_definition typed_submachines) machine
else
pkg::pkgs
with Not_found -> pkgs
in
let packages = List.fold_left aux [] machine.mcalls in
fprintf fmt "%a%t%a@, @[<v>@,%t%a;@,@]@,%a;@."
(* Include all the required packages*)
(Utils.fprintf_list ~sep:";@," pp_with) packages
(Utils.pp_final_char_if_non_empty ";@,@," packages)
(*Begin the package*)
(pp_begin_package true) machine
(*Define the reset procedure*)
pp_reset
(*Define the step procedure*)
(pp_step_definition typed_submachines) machine
(*End the package*)
pp_end_package machine
fprintf fmt ""
in
let aux pkgs (id, _) =
try
let (pkg, _) = List.assoc id ada_supported_funs in
if List.mem pkg pkgs then
pkgs
else
pkg::pkgs
with Not_found -> pkgs
in
let packages = List.fold_left aux [] machine.mcalls in
fprintf fmt "%a%t%a@, @[<v>@,%t%a;@,@]@,%a;@."
(* Include all the required packages*)
(Utils.fprintf_list ~sep:";@," pp_with) packages
(Utils.pp_final_char_if_non_empty ";@,@," packages)
(*Begin the package*)
(pp_begin_package true) machine
(*Define the reset procedure*)
pp_reset
(*Define the step procedure*)
(pp_step_definition typed_submachines) machine
(*End the package*)
pp_end_package machine
end
......
src/backends/Ada/ada_backend_ads.ml
+ 178
− 178
View file @ 8d22ea35
......@@ -22,191 +22,191 @@ open Ada_backend_common
module Main =
struct
(** Print the declaration of a state element of a subinstance of a machine.
@param machine the machine
@param fmt the formater to print on
@param substitution correspondance between polymorphic type id and their instantiation
@param ident the identifier of the subinstance
@param submachine the submachine of the subinstance
**)
let pp_machine_subinstance_state_decl fmt (ident, (substitution, submachine)) =
pp_node_state_decl substitution ident fmt submachine
(** Print the state record for a machine.
@param fmt the formater to print on
@param var_list list of all state var
@param typed_instances list typed instances
**)
let pp_state_record_definition fmt (var_list, typed_instances) =
fprintf fmt "@, @[<v>record@, @[<v>%a%t%t%a%t@]@,end record@]"
(Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl)
typed_instances
(Utils.pp_final_char_if_non_empty ";" typed_instances)
(fun fmt -> if var_list!=[] && typed_instances!= [] then fprintf fmt "@,@," else fprintf fmt "")
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode))
var_list
(Utils.pp_final_char_if_non_empty ";" var_list)
(** Print the declaration for polymorphic types.
@param fmt the formater to print on
@param polymorphic_types all the types to print
**)
let pp_generic fmt polymorphic_types =
let pp_polymorphic_types =
List.map (fun id fmt -> pp_polymorphic_type fmt id) polymorphic_types in
if polymorphic_types != [] then
fprintf fmt "generic@, @[<v>%a;@]@,"
(Utils.fprintf_list ~sep:";@," pp_private_limited_type_decl)
pp_polymorphic_types
else
fprintf fmt ""
(** Print instanciation of a generic type in a new statement.
@param fmt the formater to print on
@param id id of the polymorphic type
@param typ the new type
**)
let pp_generic_instanciation fmt (id, typ) =
fprintf fmt "%a => %a" pp_polymorphic_type id pp_type typ
(** Print a new statement instantiating a generic package.
@param fmt the formater to print on
@param substitutions the instanciation substitution
@param machine the machine to instanciate
**)
let pp_new_package fmt (substitutions, machine) =
fprintf fmt "package %a is new %a @[<v>(%a)@]"
(pp_package_name_with_polymorphic substitutions) machine
pp_package_name machine
(Utils.fprintf_list ~sep:",@," pp_generic_instanciation) substitutions
let pp_eexpr fmt eexpr = fprintf fmt "true"
(** Print a precondition in aspect
@param fmt the formater to print on
@param expr the expession to print as pre
**)
let pp_pre fmt expr =
fprintf fmt "Pre => %a"
pp_eexpr expr
(** Print a postcondition in aspect
@param fmt the formater to print on
@param expr the expession to print as pre
**)
let pp_post fmt expr =
fprintf fmt "Post => %a"
pp_eexpr expr
(** Print the declaration of a procedure with a contract
@param pp_prototype the prototype printer
@param fmt the formater to print on
@param contract the contract for the function to declare
**)
let pp_procedure_prototype_contract pp_prototype fmt opt_contract =
match opt_contract with
| None -> pp_prototype fmt
| Some contract ->
fprintf fmt "@[<v 2>%t with@,%a%t%a@]"
pp_prototype
(Utils.fprintf_list ~sep:",@," pp_pre) contract.assume
(Utils.pp_final_char_if_non_empty ",@," contract.assume)
(Utils.fprintf_list ~sep:",@," pp_post) contract.guarantees
(** Print the prototype with a contract of the reset procedure from a machine.
@param fmt the formater to print on
@param machine the machine
**)
let pp_step_prototype_contract fmt m = pp_procedure_prototype_contract
(pp_step_prototype m)
fmt
m.mspec
(** Remove duplicates from a list according to a given predicate.
@param eq the predicate defining equality
@param l the list to parse
**)
let remove_duplicates eq l =
let aux l x = if List.exists (eq x) l then l else x::l in
List.fold_left aux [] l
(** Compare two typed machines.
**)
let eq_typed_machine (subst1, machine1) (subst2, machine2) =
(String.equal machine1.mname.node_id machine2.mname.node_id) &&
(List.for_all2 (fun a b -> pp_eq_type (snd a) (snd b)) subst1 subst2)
(** Print the package declaration(ads) of a machine.
It requires the list of all typed instance.
A typed submachine is a (ident, typed_machine) with
- ident: the name
- typed_machine: a (substitution, machine) with
- machine: the submachine struct
- substitution the instanciation of all its polymorphic types.
@param fmt the formater to print on
@param typed_submachines list of all typed submachines of this machine
@param m the machine
**)
let pp_file fmt (typed_submachines, m) =
let typed_machines = snd (List.split typed_submachines) in
let typed_machines_set = remove_duplicates eq_typed_machine typed_machines in
let machines_to_import = snd (List.split typed_machines_set) in
let polymorphic_types = find_all_polymorphic_type m in
let typed_machines_to_instanciate =
List.filter (fun (l, _) -> l != []) typed_machines_set in
let typed_instances = List.filter is_submachine_statefull typed_submachines in
let pp_record fmt =
pp_state_record_definition fmt (m.mmemory, typed_instances) in
let pp_state_decl_and_reset fmt = fprintf fmt "%a;@,@,%t;@,@,"
(*Declare the state type*)
pp_private_limited_type_decl pp_state_type
(*Declare the reset procedure*)
(pp_reset_prototype m)
in
let pp_private_section fmt = fprintf fmt "@,private@,@,%a%t%a;@,"
(*Instantiate the polymorphic type that need to be instantiated*)
(Utils.fprintf_list ~sep:";@," pp_new_package) typed_machines_to_instanciate
(Utils.pp_final_char_if_non_empty ";@,@," typed_machines_to_instanciate)
(*Define the state type*)
pp_type_decl (pp_state_type, pp_record)
in
let pp_ifstatefull fmt pp =
if is_machine_statefull m then
fprintf fmt "%t" pp
(** Print the declaration of a state element of a subinstance of a machine.
@param machine the machine
@param fmt the formater to print on
@param substitution correspondance between polymorphic type id and their instantiation
@param ident the identifier of the subinstance
@param submachine the submachine of the subinstance
**)
let pp_machine_subinstance_state_decl fmt (ident, (substitution, submachine)) =
pp_node_state_decl substitution ident fmt submachine
(** Print the state record for a machine.
@param fmt the formater to print on
@param var_list list of all state var
@param typed_instances list typed instances
**)
let pp_state_record_definition fmt (var_list, typed_instances) =
fprintf fmt "@, @[<v>record@, @[<v>%a%t%t%a%t@]@,end record@]"
(Utils.fprintf_list ~sep:";@;" pp_machine_subinstance_state_decl)
typed_instances
(Utils.pp_final_char_if_non_empty ";" typed_instances)
(fun fmt -> if var_list!=[] && typed_instances!= [] then fprintf fmt "@,@," else fprintf fmt "")
(Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode))
var_list
(Utils.pp_final_char_if_non_empty ";" var_list)
(** Print the declaration for polymorphic types.
@param fmt the formater to print on
@param polymorphic_types all the types to print
**)
let pp_generic fmt polymorphic_types =
let pp_polymorphic_types =
List.map (fun id fmt -> pp_polymorphic_type fmt id) polymorphic_types in
if polymorphic_types != [] then
fprintf fmt "generic@, @[<v>%a;@]@,"
(Utils.fprintf_list ~sep:";@," pp_private_limited_type_decl)
pp_polymorphic_types
else
fprintf fmt ""
in
fprintf fmt "@[<v>%a%t%a%a@, @[<v>@,%a%a;@,%a@]@,%a;@.@]"
(* Include all the subinstance package*)
(Utils.fprintf_list ~sep:";@," pp_with_machine) machines_to_import
(Utils.pp_final_char_if_non_empty ";@,@," machines_to_import)
(** Print instanciation of a generic type in a new statement.
@param fmt the formater to print on
@param id id of the polymorphic type
@param typ the new type
**)
let pp_generic_instanciation fmt (id, typ) =
fprintf fmt "%a => %a" pp_polymorphic_type id pp_type typ
(** Print a new statement instantiating a generic package.
@param fmt the formater to print on
@param substitutions the instanciation substitution
@param machine the machine to instanciate
**)
let pp_new_package fmt (substitutions, machine) =
fprintf fmt "package %a is new %a @[<v>(%a)@]"
(pp_package_name_with_polymorphic substitutions) machine
pp_package_name machine
(Utils.fprintf_list ~sep:",@," pp_generic_instanciation) substitutions
let pp_eexpr fmt eexpr = fprintf fmt "true"
(** Print a precondition in aspect
@param fmt the formater to print on
@param expr the expession to print as pre
**)
let pp_pre fmt expr =
fprintf fmt "Pre => %a"
pp_eexpr expr
(** Print a postcondition in aspect
@param fmt the formater to print on
@param expr the expession to print as pre
**)
let pp_post fmt expr =
fprintf fmt "Post => %a"
pp_eexpr expr
(** Print the declaration of a procedure with a contract
@param pp_prototype the prototype printer
@param fmt the formater to print on
@param contract the contract for the function to declare
**)
let pp_procedure_prototype_contract pp_prototype fmt opt_contract =
match opt_contract with
| None -> pp_prototype fmt
| Some contract ->
fprintf fmt "@[<v 2>%t with@,%a%t%a@]"
pp_prototype
(Utils.fprintf_list ~sep:",@," pp_pre) contract.assume
(Utils.pp_final_char_if_non_empty ",@," contract.assume)
(Utils.fprintf_list ~sep:",@," pp_post) contract.guarantees
(** Print the prototype with a contract of the reset procedure from a machine.
@param fmt the formater to print on
@param machine the machine
**)
let pp_step_prototype_contract fmt m = pp_procedure_prototype_contract
(pp_step_prototype m)
fmt
m.mspec
(** Remove duplicates from a list according to a given predicate.
@param eq the predicate defining equality
@param l the list to parse
**)
let remove_duplicates eq l =
let aux l x = if List.exists (eq x) l then l else x::l in
List.fold_left aux [] l
(** Compare two typed machines.
**)
let eq_typed_machine (subst1, machine1) (subst2, machine2) =
(String.equal machine1.mname.node_id machine2.mname.node_id) &&
(List.for_all2 (fun a b -> pp_eq_type (snd a) (snd b)) subst1 subst2)
(** Print the package declaration(ads) of a machine.
It requires the list of all typed instance.
A typed submachine is a (ident, typed_machine) with
- ident: the name
- typed_machine: a (substitution, machine) with
- machine: the submachine struct
- substitution the instanciation of all its polymorphic types.
@param fmt the formater to print on
@param typed_submachines list of all typed submachines of this machine
@param m the machine
**)
let pp_file fmt (typed_submachines, m) =
let typed_machines = snd (List.split typed_submachines) in
let typed_machines_set = remove_duplicates eq_typed_machine typed_machines in
pp_generic polymorphic_types
let machines_to_import = snd (List.split typed_machines_set) in
let polymorphic_types = find_all_polymorphic_type m in
(*Begin the package*)
(pp_begin_package false) m
let typed_machines_to_instanciate =
List.filter (fun (l, _) -> l != []) typed_machines_set in
pp_ifstatefull pp_state_decl_and_reset
let typed_instances = List.filter is_submachine_statefull typed_submachines in
(*Declare the step procedure*)
pp_step_prototype_contract m
let pp_record fmt =
pp_state_record_definition fmt (m.mmemory, typed_instances) in
let pp_state_decl_and_reset fmt = fprintf fmt "%a;@,@,%t;@,@,"
(*Declare the state type*)
pp_private_limited_type_decl pp_state_type
(*Declare the reset procedure*)
(pp_reset_prototype m)
in
let pp_private_section fmt = fprintf fmt "@,private@,@,%a%t%a;@,"
(*Instantiate the polymorphic type that need to be instantiated*)
(Utils.fprintf_list ~sep:";@," pp_new_package) typed_machines_to_instanciate
(Utils.pp_final_char_if_non_empty ";@,@," typed_machines_to_instanciate)
(*Define the state type*)
pp_type_decl (pp_state_type, pp_record)
in
(*Print the private section*)
pp_ifstatefull pp_private_section
let pp_ifstatefull fmt pp =
if is_machine_statefull m then
fprintf fmt "%t" pp
else
fprintf fmt ""
in
(*End the package*)
pp_end_package m
fprintf fmt "@[<v>%a%t%a%a@, @[<v>@,%a%a;@,%a@]@,%a;@.@]"
(* Include all the subinstance package*)
(Utils.fprintf_list ~sep:";@," pp_with_machine) machines_to_import
(Utils.pp_final_char_if_non_empty ";@,@," machines_to_import)
pp_generic polymorphic_types
(*Begin the package*)
(pp_begin_package false) m
pp_ifstatefull pp_state_decl_and_reset
(*Declare the step procedure*)
pp_step_prototype_contract m
(*Print the private section*)
pp_ifstatefull pp_private_section
(*End the package*)
pp_end_package m
end
src/backends/Ada/ada_backend_wrapper.ml
+ 95
− 130
View file @ 8d22ea35
......@@ -17,133 +17,98 @@ open Ada_backend_common
module Main =
struct
(** Print the main procedure
@param fmt the formater to print on
@param machine the main machine
@param locals list of local variable printers
@param instrs list of instructions printer
**)
let pp_main_procedure_definition machine fmt (locals, instrs) =
pp_procedure_definition
pp_main_procedure_name
(pp_simple_prototype pp_main_procedure_name)
(fun fmt local -> fprintf fmt "%t" local)
(fun fmt instr -> fprintf fmt "%t" instr)
fmt
(locals, instrs)
(** Print call to machine procedure on state.
@param instance name of the variable
@param fmt the formater to print on
@param instance node
**)
let pp_node_reset_call name fmt node =
let pp_package fmt = pp_package_name fmt node in
let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
let pp_name fmt = pp_clean_ada_identifier fmt name in
pp_var_decl fmt (NoMode, pp_name, pp_type)
(** Print the main file calling in a loop the step function of the main machine.
@param fmt the formater to print on
@param machine the main machine
**)
let pp_main_adb fmt machine =
let pp_str str fmt = fprintf fmt "%s"str in
(* Dependances *)
let text_io = "Ada.Text_IO" in
(* Locals *)
let stateVar = "state" in
let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
let pp_local_state_var_decl fmt = pp_node_state_decl [] stateVar fmt machine in
let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
let locals = List.map apply_pp_var_decl step_parameters in
let locals = pp_local_state_var_decl::locals in
(* Node instructions *)
let pp_reset fmt =
fprintf fmt "%a.reset(%s)"
pp_package_name machine
stateVar in
let pp_step fmt =
fprintf fmt "%a.step(@[%s,@ %a@])"
pp_package_name machine
stateVar
(Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters in
(* Stream instructions *)
let pp_stdin fmt = fprintf fmt "Ada.Text_IO.Standard_Input" in
let pp_stdout fmt = fprintf fmt "Ada.Text_IO.Standard_Output" in
let pp_read fmt var =
fprintf fmt "%a := %a'Value(Ada.Text_IO.Get_Line(%t))"
pp_var_name var
pp_var_type var
pp_stdin in
let pp_write fmt var =
fprintf fmt "Ada.Text_IO.Put_Line(%t, %a'Image(%a))"
pp_stdout
pp_var_type var
pp_var_name var in
(* Loop instructions *)
let pp_loop fmt =
fprintf fmt "while not Ada.Text_IO.End_Of_File (%t) loop@, @[<v>%a;@,%t;@,%a;@]@,end loop"
pp_stdin
(Utils.fprintf_list ~sep:";@," pp_read) machine.mstep.step_inputs
pp_step
(Utils.fprintf_list ~sep:";@," pp_write) machine.mstep.step_outputs in
(* Print the file *)
let instrs = [ pp_reset;
pp_loop] in
fprintf fmt "@[<v>%a;@,%a;@,@,%a;@]"
pp_private_with (pp_str text_io)
pp_with_machine machine
(pp_main_procedure_definition machine) (locals, instrs)
(*
with Ada.Text_IO;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
procedure Show_Float_Stream is
F : File_Type;
S : Stream_Access;
File_Name : constant String := "float_file.bin";
begin
Create (F, Out_File, File_Name);
S := Stream (F);
Float'Write (S, 1.5);
Float'Write (S, 2.4);
Float'Write (S, 6.7);
Close (F);
declare
Value : Float;
begin
Open (F, In_File, File_Name);
S := Stream (F);
while not End_Of_File (F) loop
Float'Read (S, Value);
Ada.Text_IO.Put_Line (Float'Image (Value));
end loop;
Close (F);
*)
(** Print the gpr project file.
@param fmt the formater to print on
@param machine the main machine
**)
let pp_project_file fmt machine =
fprintf fmt "project %a is@. for Main use (\"%a\");@.end %a;"
pp_package_name machine
(pp_filename "adb") pp_main_procedure_name
pp_package_name machine
end
(** Print the main procedure
@param fmt the formater to print on
@param machine the main machine
@param locals list of local variable printers
@param instrs list of instructions printer
**)
let pp_main_procedure_definition machine fmt (locals, instrs) =
pp_procedure_definition
pp_main_procedure_name
(pp_simple_prototype pp_main_procedure_name)
(fun fmt local -> fprintf fmt "%t" local)
(fun fmt instr -> fprintf fmt "%t" instr)
fmt
(locals, instrs)
(** Print call to machine procedure on state.
@param instance name of the variable
@param fmt the formater to print on
@param instance node
**)
let pp_node_reset_call name fmt node =
let pp_package fmt = pp_package_name fmt node in
let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
let pp_name fmt = pp_clean_ada_identifier fmt name in
pp_var_decl fmt (NoMode, pp_name, pp_type)
(** Print the main file calling in a loop the step function of the main machine.
@param fmt the formater to print on
@param machine the main machine
**)
let pp_main_adb fmt machine =
let pp_str str fmt = fprintf fmt "%s"str in
(* Dependances *)
let text_io = "Ada.Text_IO" in
(* Locals *)
let stateVar = "state" in
let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
let pp_local_state_var_decl fmt = pp_node_state_decl [] stateVar fmt machine in
let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
let locals = List.map apply_pp_var_decl step_parameters in
let locals = pp_local_state_var_decl::locals in
(* Node instructions *)
let pp_reset fmt =
fprintf fmt "%a.reset(%s)"
pp_package_name machine
stateVar in
let pp_step fmt =
fprintf fmt "%a.step(@[%s,@ %a@])"
pp_package_name machine
stateVar
(Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters in
(* Stream instructions *)
let pp_stdin fmt = fprintf fmt "Ada.Text_IO.Standard_Input" in
let pp_stdout fmt = fprintf fmt "Ada.Text_IO.Standard_Output" in
let pp_read fmt var =
fprintf fmt "%a := %a'Value(Ada.Text_IO.Get_Line(%t))"
pp_var_name var
pp_var_type var
pp_stdin in
let pp_write fmt var =
fprintf fmt "Ada.Text_IO.Put_Line(%t, %a'Image(%a))"
pp_stdout
pp_var_type var
pp_var_name var in
(* Loop instructions *)
let pp_loop fmt =
fprintf fmt "while not Ada.Text_IO.End_Of_File (%t) loop@, @[<v>%a;@,%t;@,%a;@]@,end loop"
pp_stdin
(Utils.fprintf_list ~sep:";@," pp_read) machine.mstep.step_inputs
pp_step
(Utils.fprintf_list ~sep:";@," pp_write) machine.mstep.step_outputs in
(* Print the file *)
let instrs = [ pp_reset;
pp_loop] in
fprintf fmt "@[<v>%a;@,%a;@,@,%a;@]"
pp_private_with (pp_str text_io)
pp_with_machine machine
(pp_main_procedure_definition machine) (locals, instrs)
(** Print the gpr project file.
@param fmt the formater to print on
@param machine the main machine
**)
let pp_project_file fmt machine =
fprintf fmt "project %a is@. for Main use (\"%a\");@.end %a;"
pp_package_name machine
(pp_filename "adb") pp_main_procedure_name
pp_package_name machine
end
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment