From 4a5649dfa31bf804bf59acd789a38055df17d3ba Mon Sep 17 00:00:00 2001 From: Marc Pouzet Date: Mon, 28 Oct 2024 17:19:23 +0100 Subject: [PATCH] Update --- src/compiler/gencode/obc.ml | 20 +++++------ src/compiler/gencode/ocamlprinter.ml | 52 +++++++++++++--------------- src/compiler/gencode/oprinter.ml | 30 +++++++++++----- src/compiler/gencode/translate.ml | 44 ++++++++++++----------- 4 files changed, 79 insertions(+), 67 deletions(-) diff --git a/src/compiler/gencode/obc.ml b/src/compiler/gencode/obc.ml index f57e8fd4..fb581572 100644 --- a/src/compiler/gencode/obc.ml +++ b/src/compiler/gencode/obc.ml @@ -26,7 +26,7 @@ type ('pattern, 'body) match_handler = (* type declaration *) type type_expression = Zelus.type_expression -type kind = Zelus.kind +type kind = Efun | Enode type size_expression = Zelus.size_expression @@ -77,7 +77,7 @@ and exp = | Ematch of exp * (pattern, exp) match_handler list | Elet of pattern * exp * exp (* [let p = e1 in e2] *) | Eletvar of { id: Ident.t; is_mutable: is_mutable; - ty: type_expression; e_opt: exp option; e : exp } + ty: Deftypes.typ; e_opt: exp option; e : exp } (* var id : ty [= e1] in e2 *) | Eletmem of mentry list * exp (* [let mem m1...mk in e] *) | Eletinstance of ientry list * exp (* [let instances i1...ik in e] *) @@ -132,7 +132,7 @@ and primitive_access = (* Definition of a sequential machine *) and machine = - { ma_kind: kind; + { ma_kind: Deftypes.kind; (* combinatorial, continuous-time or discrete-time *) ma_initialize: exp option; ma_params: pattern list; (* list of static parameters *) @@ -144,15 +144,15 @@ and machine = and mentry = { m_name: Ident.t; (* its name *) m_value: exp option; (* its initial value *) - m_typ: type_expression; (* its type *) - m_kind: mkind; (* the kind of the memory *) + m_typ: Deftypes.typ; (* its type *) + m_kind: Deftypes.mkind option; (* the kind of the memory *) m_size: exp path; (* it may be an array *) } and ientry = { i_name: Ident.t; (* its name *) i_machine: exp; (* the machine it belongs to *) - i_kind: kind; (* the kind of the machine *) + i_kind: Deftypes.kind; (* the kind of the machine *) i_params: exp path; (* static parameters used at instance creation *) i_sizes: exp list; (* it is possibly an array of instances *) } @@ -161,7 +161,7 @@ and method_desc = { me_name: method_name; (* name of the method *) me_params: pattern list; (* list of input arguments *) me_body: exp; (* its result *) - me_typ: type_expression; (* type of the result *) + me_typ: Deftypes.typ; (* type of the result *) } and methodcall = @@ -180,9 +180,9 @@ and mkind = | Econt (* continuous state variable *) | Ezero (* zero-crossing *) | Ehorizon (* horizon *) - | Emajor (* major step *) - | Ediscrete (* discrete state variable *) - + | Emajor (* true in discrete mode; major step *) + | Eencore (* a cascade event *) + | Eperiod (* a event defined by a period *) and 'a path = 'a list diff --git a/src/compiler/gencode/ocamlprinter.ml b/src/compiler/gencode/ocamlprinter.ml index 4d9a9a56..25c6ff33 100644 --- a/src/compiler/gencode/ocamlprinter.ml +++ b/src/compiler/gencode/ocamlprinter.ml @@ -21,13 +21,6 @@ open Pp_tools open Printer open Oprinter -let typ_bool = - { Zelus.desc = Zelus.Etypeconstr(Lident.Modname (Initial.bool_ident), []); - Zelus.loc = Location.no_location } -let typ_float = - { Zelus.desc = Zelus.Etypeconstr(Lident.Modname (Initial.float_ident), []); - Zelus.loc = Location.no_location } - let immediate ff = function | Eint i -> if i < 0 then fprintf ff "(%a)" pp_print_int i else pp_print_int ff i @@ -166,7 +159,7 @@ and exp prio ff e = (print_list_r (print_record longname (exp 0) "" " =" "") "{" ";" "}") label_e_list | Etypeconstraint(e, ty_e) -> - fprintf ff "@[(%a : %a)@]" (exp prio_e) e ptype ty_e + fprintf ff "@[(%a : %a)@]" (exp prio_e) e Printer.ptype ty_e | Eifthenelse(e, e1, e2) -> fprintf ff "@[if %a@ @[then@ %a@]@ @[else@ %a@]@]" (exp 0) e (exp prio_e) e1 (exp prio_e) e2 @@ -277,7 +270,7 @@ and array_of e_opt ty ff ie_size = (* Print the allocation function *) and print_memory ff { m_name; m_value; m_typ; m_kind; m_size } = match m_kind with - | Ediscrete -> + | None -> (* discrete state variable *) begin match m_value with @@ -290,18 +283,21 @@ and print_memory ff { m_name; m_value; m_typ; m_kind; m_size } = fprintf ff "@[%a = %a@]" name m_name (array_make exp_with_typ (e, m_typ)) m_size end - | Ezero -> - fprintf ff "@[%a = @[{ zin = %a;@ zout = %a }@]@]" - name m_name (array_of m_value typ_bool) m_size - (array_of (Some(Econst(Efloat(1.0)))) typ_float) - m_size - | Econt -> - fprintf ff "@[%a = @[{ pos = %a; der = %a }@]@]" - name m_name (array_of m_value m_typ) m_size - (* the default value of a derivative must be zero *) - (array_of (Some(Econst(Efloat(0.0)))) m_typ) m_size - | Ehorizon | Emajor -> - fprintf ff "%a = %a" name m_name (array_of m_value m_typ) m_size + | Some(k) -> + match k with + Ezero -> + fprintf ff "@[%a = @[{ zin = %a;@ zout = %a }@]@]" + name m_name (array_of m_value Initial.typ_bool) m_size + (array_of (Some(Econst(Efloat(1.0)))) Initial.typ_float) + m_size + | Econt -> + fprintf ff "@[%a = @[{ pos = %a; der = %a }@]@]" + name m_name (array_of m_value m_typ) m_size + (* the default value of a derivative must be zero *) + (array_of (Some(Econst(Efloat(0.0)))) m_typ) m_size + | Ehorizon | Emajor | Eperiod | Eencore -> + fprintf ff "%a = %a" name m_name (array_of m_value m_typ) m_size + and print_instance ff { i_name; i_machine; i_kind; i_params; i_sizes } = fprintf ff "@[%a = %a (* %s *)@ @]" name i_name @@ -314,11 +310,11 @@ and exp_with_typ ff (e, ty) = fprintf ff "(%a:%a)" (exp 2) e ptype ty let pmethod f ff { me_name; me_params; me_body; me_typ } = fprintf ff "@[let %s_%s self %a =@ (%a:%a) in@]" f (method_name me_name) pattern_list me_params (exp 2) me_body - Printer.ptype me_typ + ptype me_typ let constructor_for_kind = function - | Zelus.Knode _ -> "Node" - | Zelus.Kfun _ -> assert false + | Deftypes.Tnode _ -> "Node" + | Deftypes.Tfun _ -> assert false let expected_list_of_methods = default_list_of_methods @@ -357,8 +353,8 @@ let def_instance_function ff { i_name; i_machine; i_kind; i_params; i_sizes } = let list_of_methods ff m_list = print_list_r method_name """;""" ff m_list in match i_kind with - | Zelus.Kfun _ -> () - | Zelus.Knode _ -> + | Deftypes.Tfun _ -> () + | Deftypes.Tnode _ -> let m_name_list = expected_list_of_methods in let k = constructor_for_kind i_kind in fprintf ff @@ -384,8 +380,8 @@ let machine f ff { ma_kind; ma_params; ma_initialize; ma_memories; (* or [k { alloc = f_alloc; m1 = f_m1; ...; mn = f_mn }] *) let tuple_of_methods ff m_name_list = match ma_kind with - | Zelus.Kfun _ -> fprintf ff "%s" f - | Zelus.Knode _ -> + | Deftypes.Tfun _ -> fprintf ff "%s" f + | Deftypes.Tnode _ -> let method_name ff me_name = let m = method_name me_name in fprintf ff "@[%s = %s_%s@]" m f m in diff --git a/src/compiler/gencode/oprinter.ml b/src/compiler/gencode/oprinter.ml index d7e93da1..10298630 100644 --- a/src/compiler/gencode/oprinter.ml +++ b/src/compiler/gencode/oprinter.ml @@ -20,6 +20,13 @@ open Format open Pp_tools open Printer +let kind = function + | Deftypes.Tfun _ -> "any" + | Deftypes.Tnode(k) -> + match k with + | Deftypes.Tdiscrete -> "discrete" + | Deftypes.Tcont -> "continuous" + (* Priorities *) let priority_exp = function | Econst _ | Econstr0 _| Eglobal _ | Evar _ @@ -32,6 +39,8 @@ let priority_exp = function | Esequence _ -> 0 | Efun _ | Emachine _ -> 0 +let ptype ff ty = Ptypes.output ff ty + let immediate ff = function | Eint i -> if i < 0 then fprintf ff "(%a)" pp_print_int i else pp_print_int ff i @@ -140,10 +149,10 @@ and letvar ff n ty e_opt e = match e_opt with | None -> fprintf ff - "@[var %a: %a in@ %a@]" name n Printer.ptype ty (exp 0) e + "@[var %a: %a in@ %a@]" name n ptype ty (exp 0) e | Some(e0) -> fprintf ff "@[var %a: %a = %a in@ %a@]" - name n Printer.ptype ty (exp 0) e0 (exp 0) e + name n ptype ty (exp 0) e0 (exp 0) e and exp prio ff e = let prio_e = priority_exp e in @@ -241,19 +250,22 @@ and match_handler ff { m_pat = pat; m_body = b } = and mkind mk = match mk with - | Econt -> "cont " - | Ezero -> "zero " - | Ediscrete -> "" - | Ehorizon -> "horizon " - | Emajor -> "major " + | None -> "" + | Some(mk) -> + match mk with + | Econt -> "cont " + | Ezero -> "zero " + | Ehorizon -> "horizon " + | Emajor -> "major " + | Eencore -> "encore " + | Eperiod -> "period " and memory ff { m_name; m_value; m_typ; m_kind = k; m_size } = fprintf ff "%s%a%a : %a = %a" (mkind k) name m_name (print_list_no_space (print_with_braces (exp 0) "[" "]") "" "" "") m_size ptype m_typ (print_opt (exp 0)) m_value -and instance ff { i_name; i_machine; i_kind; - i_params; i_sizes } = +and instance ff { i_name; i_machine; i_kind; i_params; i_sizes } = fprintf ff "@[%a : %s(%a)%a%a@]" name i_name (kind i_kind) (exp 0) i_machine (print_list_no_space (print_with_braces (exp 0) "(" ")") "" "" "") diff --git a/src/compiler/gencode/translate.ml b/src/compiler/gencode/translate.ml index 07f88121..8103c614 100644 --- a/src/compiler/gencode/translate.ml +++ b/src/compiler/gencode/translate.ml @@ -91,15 +91,18 @@ let state is_read n k = (* index in an array *) let rec index e = - function [] -> e | ei :: ei_list -> - Eget { e = index e ei_list; index = Evar { is_mutable = false; - id = ei } } + function + | [] -> e + | ei :: ei_list -> + Eget { e = index e ei_list; index = Evar { is_mutable = false; + id = ei } } let rec left_value_index lv = function | [] -> lv | ei :: ei_list -> - Eleft_index(left_value_index lv ei_list, Evar { is_mutable = false; id = ei }) + Eleft_index(left_value_index lv ei_list, + Evar { is_mutable = false; id = ei }) let rec left_state_value_index lv = function | [] -> lv @@ -138,33 +141,33 @@ let def { e_typ; e_sort; e_size = ei_list } e ({ step = s } as code) = | Out(id, sort) -> match sort with | Sort_val -> - { code with step = - Elet(Evarpat - { id; ty = Interface.type_expression_of_typ e_typ }, - e, s) } + let step = Elet(Evarpat + { id; ty = Interface.type_expression_of_typ e_typ }, + e, s) in + { code with step } + | Sort_var -> { code with step = Oaux.seq (Eassign(left_value_index (Eleft_name id) ei_list, e)) s } | Sort_mem { m_mkind } -> - { code with step = - Oaux.seq - (Eassign_state(left_state_value_index - (state false id m_mkind) ei_list, e)) s } + let step = Oaux.seq + (Eassign_state(left_state_value_index + (state false id m_mkind) ei_list, e)) s in + { code with step } (* Generate the code for [der x = e] *) let der { e_sort; e_size = ei_list } e ({ step = s } as code) = match e_sort with | In _ -> assert false | Out(n, sort) -> - { code with step = - Oaux.seq - (Eassign_state(left_state_value_index - (Eleft_state_primitive_access - (Eleft_state_name(n), Eder)) ei_list, - e)) - s } + let step = + Oaux.seq (Eassign_state(left_state_value_index + (Eleft_state_primitive_access + (Eleft_state_name(n), Eder)) ei_list, + e)) s in + { code with step } (* Generate an if/then *) let ifthen r_e i_code s = Oaux.seq (Eifthenelse(r_e, i_code, Oaux.void)) s @@ -296,7 +299,8 @@ let append loop_path l_env env = Env.add n { e_typ = typ_body; e_sort = Out(n, t_sort); e_size = [] } env_acc, mem_acc, - (n, is_mutable typ_body, typ_body, default env typ_body None) :: var_acc + (n, is_mutable typ_body, typ_body, default env typ_body None) + :: var_acc | Sort_mem { m_mkind } -> Env.add n { e_typ = typ_body; e_sort = Out(n, t_sort); e_size = loop_path }