Skip to content

Commit

Permalink
Update
Browse files Browse the repository at this point in the history
  • Loading branch information
@marcpouzet
marcpouzet committed Oct 28, 2024
1 parent 0a1dbfa commit 4a5649d
Show file tree
Hide file tree
Showing 4 changed files with 79 additions and 67 deletions.
20 changes: 10 additions & 10 deletions src/compiler/gencode/obc.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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] *)
Expand Down Expand Up @@ -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 *)
Expand All @@ -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 *)
}
Expand All @@ -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 =
Expand All @@ -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

Expand Down
52 changes: 24 additions & 28 deletions src/compiler/gencode/ocamlprinter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 "@[<hv>if %a@ @[<hv 2>then@ %a@]@ @[<hv 2>else@ %a@]@]"
(exp 0) e (exp prio_e) e1 (exp prio_e) e2
Expand Down Expand Up @@ -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
Expand All @@ -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 = @[<hov 2>{ 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 = @[<hov 2>{ 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 = @[<hov 2>{ 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 = @[<hov 2>{ 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
Expand All @@ -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 "@[<v 2>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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
30 changes: 21 additions & 9 deletions src/compiler/gencode/oprinter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 _
Expand All @@ -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
Expand Down Expand Up @@ -140,10 +149,10 @@ and letvar ff n ty e_opt e =
match e_opt with
| None ->
fprintf ff
"@[<v 0>var %a: %a in@ %a@]" name n Printer.ptype ty (exp 0) e
"@[<v 0>var %a: %a in@ %a@]" name n ptype ty (exp 0) e
| Some(e0) ->
fprintf ff "@[<v 0>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
Expand Down Expand Up @@ -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) "(" ")") "" "" "")
Expand Down
44 changes: 24 additions & 20 deletions src/compiler/gencode/translate.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 }
Expand Down

0 comments on commit 4a5649d

Please sign in to comment.