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 ef93a60 commit 8d13542
Show file tree
Hide file tree
Showing 6 changed files with 102 additions and 100 deletions.
8 changes: 8 additions & 0 deletions src/compiler/gencode/oaux.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,14 @@ let varmut x = var true x

let ifthenelse c e1 e2 = Eifthenelse(c, e1, e2)

let seq e1 e2 =
match e1, e2 with
| (Econst(Evoid), e) | (e, Econst(Evoid)) -> e
| Esequence e_list1, Esequence e_list2 -> Esequence(e_list1 @ e_list2)
| Esequence e_list1, _ -> Esequence (e_list1 @ [e2])
| _, Esequence e_list2 -> Esequence (e1 :: e_list2)
| _ -> Esequence [e1; e2]

let sequence e_list =
let seq e e_list =
match e, e_list with
Expand Down
16 changes: 8 additions & 8 deletions src/compiler/gencode/obc.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,21 +87,21 @@ and exp =
| Eapp of { f: exp; arg_list: exp list }
| Emethodcall of methodcall
| Etypeconstraint of exp * type_expression
| Efor of { index: Ident.t; left: exp; right: exp; e: exp }
| Efor of { index: Ident.t; dir: bool; left: exp; right: exp; e: exp }
| Ewhile of { cond: exp; e: exp }
| Emachine of machine
| Efun of { pat_list: pattern list; e: exp }
(* array operations *)
| Eget of { e: exp; size: size_expression } (* access in an array *)
| Eupdate of { e: exp; size: size_expression; index: size_expression; arg: exp }
| Eget of { e: exp; index: exp } (* access in an array *)
| Eupdate of { e: exp; size: exp; index: exp; arg: exp }
(* update of an array of size [s1] *)
| Eslice of
{ e: exp; left: size_expression;
right: size_expression; length: size_expression } (* e{s1..s2} *)
| Econcat of { left: exp; left_size: size_expression;
right: exp; right_size: size_expression }
{ e: exp; left: exp;
right: exp; length: exp } (* e{s1..s2} *)
| Econcat of { left: exp; left_size: exp;
right: exp; right_size: exp }
(* { e1 | e2 } *)
| Emake of { e: exp; size: size_expression }
| Emake of { e: exp; size: exp }
(* e1[e2] build an array of size [s2] with value [e1] *)

(* when [is_mutable = true] a variable [x] is mutable which means that *)
Expand Down
29 changes: 15 additions & 14 deletions src/compiler/gencode/ocamlprinter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -185,9 +185,10 @@ and exp prio ff e =
fprintf ff "@[<v2>match %a with@ @[%a@]@]"
(exp 0) e
(print_list_l match_handler """""") match_handler_l
| Efor { index; left; right; e } ->
fprintf ff "@[<hv>for %a = %a to %a@ @[<hv 2>do@ %a@ done@]@]"
name index (exp 0) left (exp 0) right (exp 0) e
| Efor { index; dir; left; right; e } ->
fprintf ff "@[<hv>for %a = %a %s %a@ @[<hv 2>do@ %a@ done@]@]"
name index (exp 0) left (if dir then "to" else "downto")
(exp 0) right (exp 0) e
| Ewhile { cond; e } ->
fprintf ff "@[<hv>while %a do %a done@]@]"
(exp 0) cond (exp 0) e
Expand All @@ -199,25 +200,25 @@ and exp prio ff e =
else
fprintf ff
"@[<hv>%a@]" (print_list_r (exp 1) "" ";" "") e_list
| Eget { e; size} ->
fprintf ff "%a.(@[%a@])" (exp prio_e) e Printer.size size
| Eget { e; index} ->
fprintf ff "%a.(@[%a@])" (exp prio_e) e (exp 0) index
| Eupdate { e; index; arg } ->
(* returns a fresh vector [_t] of size [se] equal to [e2] except at *)
(* [i] where it is equal to [e2] *)
fprintf ff "@[(let _t = Array.copy (%a) in@ _t.(%a) <- %a; _t)@]"
(exp 0) e Printer.size index (exp 0) arg
(exp 0) e (exp 0) index (exp 0) arg
| Emake { e; size } ->
(* make a vector *)
let print_vec ff e se =
match e with
| Econst _ ->
fprintf ff "@[<hov 2>Array.make@ (%a)@ (%a)@]"
Printer.size se (exp prio_e) e
(exp 0) se (exp prio_e) e
| Emake { e; size } ->
fprintf ff "@[<hov 2>Array.make_matrix@ (%a)@ (%a)@ (%a)@]"
Printer.size se Printer.size size (exp prio_e) e
(exp 0) se (exp 0) size (exp prio_e) e
| _ -> fprintf ff "@[<hov 2>Array.init@ @[(%a)@]@ @[(fun _ -> %a)@]@]"
Printer.size se (exp prio_e) e in
(exp 0) se (exp prio_e) e in
print_vec ff e size
| Eslice { e; left; right; length } ->
(* returns a fresh vector [_t] of size [s1+s2] *)
Expand All @@ -226,8 +227,8 @@ and exp prio ff e =
for i = 0 to %a - 1 do @ \
_t.(i) <- %a.(i+%a) done; @ \
_t)@]"
Printer.size length (exp 2) e Printer.size right
(exp 2) e Printer.size left
(exp 0) length (exp 2) e (exp 0) right
(exp 2) e (exp 0) left
| Econcat { left; left_size; right; right_size } ->
(* returns a fresh vector [_t] of size [s1+s2] *)
(* with _t.(i) = e1.(i) forall i in [0..s1-1] and *)
Expand All @@ -236,9 +237,9 @@ and exp prio ff e =
Array.blit %a 0 _t 0 %a; @ \
Array.blit %a 0 _t %a; @ \
_t)@]"
Printer.size left_size Printer.size right_size (exp 2) left
(exp 2) left Printer.size left_size
(exp 2) right Printer.size right_size
(exp 0) left_size (exp 0) right_size (exp 2) left
(exp 2) left (exp 0) left_size
(exp 2) right (exp 0) right_size
| Emachine(ma) -> machine ff ma
| Efun _ -> ()
end;
Expand Down
20 changes: 10 additions & 10 deletions src/compiler/gencode/oprinter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,9 +195,10 @@ and exp prio ff e =
fprintf ff "@[<v2>match %a with@ @[%a@]@]"
(exp 0) e
(print_list_l match_handler """""") match_handler_l
| Efor { index; left; right; e } ->
fprintf ff "@[<hv>for %a = %a to %a@ @[<hv 2>do@ %a@ done@]@]"
name index (exp 0) left (exp 0) right (exp 0) e
| Efor { index; dir; left; right; e } ->
fprintf ff "@[<hv>for %a = %a %s %a@ @[<hv 2>do@ %a@ done@]@]"
name index (exp 0) left (if dir then "to" else "downto")
(exp 0) right (exp 0) e
| Ewhile { cond; e } ->
fprintf ff "@[<hv>while %a do %a done@]@]"
(exp 0) cond (exp 0) e
Expand All @@ -209,20 +210,19 @@ and exp prio ff e =
else
fprintf ff
"@[<hv>%a@]" (print_list_r (exp 1) "" ";" "") e_list
| Eget { e; size} ->
fprintf ff "%a.(@[%a@])" (exp prio_e) e Printer.size size
| Eget { e; index } ->
fprintf ff "%a.(@[%a@])" (exp prio_e) e (exp 0) index
| Eupdate { e; size; index; arg } ->
fprintf ff "@[<hov2>{%a:%a with@ %a = %a}@]"
(exp prio_e) e Printer.size size Printer.size index (exp 0) arg
(exp prio_e) e (exp 0) size (exp 0) index (exp 0) arg
| Emake { e; size } ->
fprintf ff "%a[%a]" (exp prio_e) e Printer.size size
fprintf ff "%a[%a]" (exp prio_e) e (exp 0) size
| Eslice { e; left; right } ->
fprintf ff "%a{%a..%a}"
(exp prio_e) e Printer.size left Printer.size right
(exp prio_e) e (exp 0) left (exp 0) right
| Econcat { left; left_size; right; right_size } ->
fprintf ff "{%a:%a | %a:%a}"
(exp 0) left Printer.size left_size (exp 0) right
Printer.size right_size
(exp 0) left (exp 0) left_size (exp 0) right (exp 0) right_size
| Emachine(ma) -> machine ff ma
| Efun _ -> ()
end;
Expand Down
126 changes: 59 additions & 67 deletions src/compiler/gencode/translate.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,11 +43,11 @@ type env = entry Env.t (* the symbol table *)
and loop_path = Ident.t list

type code =
{ init: Obc.exp Parseq.t; (* sequence of initializations for [mem] *)
{ init: Obc.exp; (* sequence of initializations for [mem] *)
mem: mentry Parseq.t; (* set of state variables *)
instances: ientry Parseq.t; (* set of instances *)
reset: Obc.exp Parseq.t; (* sequence of equations for resetting the block *)
step: Obc.exp Parseq.t; (* body *)
reset: Obc.exp; (* sequence of equations for resetting the block *)
step: Obc.exp; (* body *)
}

let fprint ff (env: entry Env.t) =
Expand All @@ -57,14 +57,14 @@ let fprint ff (env: entry Env.t) =
(Pp_tools.print_list_r Printer.name "[" "," "]") size in
Ident.Env.fprint_t fprint_entry ff env

let empty_code = { mem = Parseq.empty; init = Parseq.empty;
let empty_code = { mem = Parseq.empty; init = Oaux.void;
instances = Parseq.empty;
reset = Parseq.empty; step = Parseq.empty }
reset = Oaux.void; step = Oaux.void }

let seq { mem = m1; init = i1; instances = j1; reset = r1; step = s1 }
{ mem = m2; init = i2; instances = j2; reset = r2; step = s2 } =
{ mem = Parseq.seq m1 m2; init = Parseq.seq i1 i2; instances = Parseq.par j1 j2;
reset = Parseq.seq r1 r2; step = Parseq.seq s1 s2 }
{ mem = Parseq.seq m1 m2; init = Oaux.seq i1 i2; instances = Parseq.par j1 j2;
reset = Oaux.seq r1 r2; step = Oaux.seq s1 s2 }

let empty_path = []

Expand All @@ -91,7 +91,9 @@ 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; size = 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
Expand All @@ -111,90 +113,80 @@ let var { e_sort; e_typ; e_size = ei_list } =
| In(e) -> index e ei_list
| Out(n, sort) ->
match sort with
| Sstatic | Sval -> index (Olocal(n)) ei_list
| Svar _ ->
index (Ovar(is_mutable ty, n)) ei_list
| Smem { m_kind = k } ->
Ostate(left_state_value_index (state true n k) ei_list)
| Sort_val -> index (Evar { is_mutable = false; id = n }) ei_list
| Sort_var ->
let i = is_mutable e_typ in
index (Evar { is_mutable = i; id = n }) ei_list
| Sort_mem { m_mkind } ->
Estate_access(left_state_value_index (state true n m_mkind) ei_list)

(** Make an assignment according to the sort of a variable [n] *)
let assign { e_sort = sort; e_size = ei_list } e =
match sort with
(* Make an assignment according to the sort of a variable [n] *)
let assign { e_sort; e_size = ei_list } e =
match e_sort with
| In _ -> assert false
| Out(n, sort) ->
match sort with
| Sstatic | Sval -> assert false
| Svar _ -> Oassign(left_value_index (Oleft_name n) ei_list, e)
| Smem { m_kind = k } ->
Oassign_state(left_state_value_index (state false n k) ei_list, e)
| Sort_val -> assert false
| Sort_var -> Eassign(left_value_index (Eleft_name n) ei_list, e)
| Sort_mem { m_mkind } ->
Eassign_state(left_state_value_index (state false n m_mkind) ei_list, e)

(** Generate the code for a definition *)
let def { e_typ = ty; e_sort = sort; e_size = ei_list } e
({ step = s } as code) =
match sort with
(* Generate the code for a definition *)
let def { e_typ; e_sort; e_size = ei_list } e ({ step = s } as code) =
match e_sort with
| In _ -> assert false
| Out(n, sort) ->
| Out(id, sort) ->
match sort with
| Sstatic | Sval ->
| Sort_val ->
{ code with step =
Olet(Ovarpat(n, type_expression_of_typ ty), e, s) }
| Svar _ ->
Elet(Evarpat
{ id; ty = Interface.type_expression_of_typ e_typ },
e, s) }
| Sort_var ->
{ code with step =
sequence
(Oassign(left_value_index (Oleft_name n) ei_list, e))
Oaux.seq
(Eassign(left_value_index (Eleft_name id) ei_list, e))
s }
| Smem { m_kind = k } ->
{ code with step = sequence
(Oassign_state(left_state_value_index
(state false n k) 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 }

(** Generate the code for [der x = e] *)
let der { e_sort = sort; e_size = ei_list } e ({ step = s } as code) =
match sort with
(* 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 =
sequence
(Oassign_state(left_state_value_index
(Oleft_state_primitive_access
(Oleft_state_name(n), Oder)) ei_list,
Oaux.seq
(Eassign_state(left_state_value_index
(Eleft_state_primitive_access
(Eleft_state_name(n), Eder)) ei_list,
e))
s }

(** Generate an if/then *)
let ifthen r_e i_code s = sequence (Oif(r_e, i_code, None)) s
(* Generate an if/then *)
let ifthen r_e i_code s = Oaux.seq (Eifthenelse(r_e, i_code, Oaux.void)) s

(** Generate a for loop *)
let for_loop direction ix e1 e2 i_body =
match i_body with
| Osequence [] -> Osequence []
| _ -> Ofor(direction, ix, e1, e2, i_body)
(* Generate a for loop *)
let for_loop dir ix e1 e2 e_body =
match e_body with
| Econst (Evoid) | Esequence [] -> e_body
| _ -> Efor { index = ix; dir = dir; left = e1; right = e2; e = e_body }

(** Generate the code for the definition of a value *)
(* Generate the code for the definition of a value *)
let letpat p e ({ step = s } as code) =
{ code with step = Olet(p, e, s) }
{ code with step = Elet(p, e, s) }

(** Generate the code for initializing shared variables *)
(* Generate the code for initializing shared variables *)
let rec letvar l s =
match l with
| [] -> s
| (n, is_mutable, ty, v_opt) :: l ->
Oletvar(n, is_mutable, ty, v_opt, letvar l s)
| (id, is_mutable, ty, e_opt) :: l ->
Eletvar { id; is_mutable; ty; e_opt; e = letvar l s }

(** Compile an equation [n += e] *)
let pluseq ({ e_sort = sort; e_size = ei_list } as entry)
e ({ step = s } as code) =
let ln =
match sort with
| In _ -> assert false
| Out(n, sort) ->
match sort with
| Svar { v_combine = Some(ln) } | Smem { m_combine = Some(ln) } -> ln
| _ -> Zmisc.internal_error "Unbound variable" Printer.name n in
{ code with step =
sequence (assign entry
(Oapp(Oglobal(ln), [var entry; e]))) s }


let out_of n env =
let { e_typ = ty; e_sort = sort; e_size = ix_list } = entry_of n env in
match sort with
Expand Down
3 changes: 2 additions & 1 deletion src/dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -197,7 +197,8 @@
ocamlprinter; print OCaml code
translate; translate into sequential code
)
(libraries zelus.global_lib zelus.typdefs_lib zelus.common_lib)
(libraries zelus.global_lib zelus.typdefs_lib
zelus.common_lib zelus.typing_lib)
)

; The compiler
Expand Down

0 comments on commit 8d13542

Please sign in to comment.