Skip to content

Commit

Permalink
Merge pull request #146 from MLanguage/generic-table-access
Browse files Browse the repository at this point in the history
Relax M table access to variables
  • Loading branch information
Raphaël Monat authored May 31, 2022
2 parents 0fa8314 + ad2eec0 commit 32fee5d
Show file tree
Hide file tree
Showing 17 changed files with 219 additions and 188 deletions.
26 changes: 12 additions & 14 deletions src/mlang/backend_compilers/bir_to_c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,26 +41,30 @@ let generate_unop (op : Mast.unop) : string =

type offset =
| GetValueConst of int
| GetValueVar of string
| GetValueVar of variable
| PassPointer
| None

let generate_variable (offset : offset) (fmt : Format.formatter)
let rec generate_variable (offset : offset) (fmt : Format.formatter)
(var : variable) : unit =
let mvar = var_to_mir var in
let var_index = var.offset in
match offset with
| PassPointer ->
Format.fprintf fmt "(TGV + %d/*%s*/)" var_index
(Pos.unmark mvar.Mir.Variable.name)
| GetValueVar offset ->
(* TODO: boundary checks *)
Format.fprintf fmt "TGV[%d/*%s*/ + (int)%a.value]" var_index
(Pos.unmark mvar.Mir.Variable.name)
(generate_variable None) offset
| _ ->
Format.fprintf fmt "TGV[%d/*%s*/%s]" var_index
(Pos.unmark mvar.Mir.Variable.name)
(match offset with
| None -> ""
| GetValueVar offset -> " + " ^ offset
| GetValueConst offset -> " + " ^ string_of_int offset
| PassPointer -> assert false)
| PassPointer | GetValueVar _ -> assert false)

let generate_raw_name (v : variable) : string =
let v = var_to_mir v in
Expand Down Expand Up @@ -130,7 +134,6 @@ let rec generate_c_expr (e : expression Pos.marked) :
| Literal Undefined -> (Format.asprintf "%s" none_value, [])
| Var var -> (Format.asprintf "%a" (generate_variable None) var, [])
| LocalVar lvar -> (Format.asprintf "LOCAL[%d]" lvar.Mir.LocalVariable.id, [])
| GenericTableIndex -> (Format.asprintf "m_literal(generic_index)", [])
| Error -> assert false (* should not happen *)
| LocalLet (lvar, e1, e2) ->
let _, s1 = generate_c_expr e1 in
Expand Down Expand Up @@ -161,17 +164,12 @@ let generate_var_def (var : variable) (data : variable_data)
(generate_variable (GetValueConst i))
var sv))
es
| TableVar (size, IndexGeneric e) ->
| TableVar (_size, IndexGeneric (v, e)) ->
let sv, defs = generate_c_expr e in
Format.fprintf oc
"for (int generic_index=0; generic_index < %d; generic_index++) {@\n\
\ @[<h 4> %a%a = %s;@]@\n\
\ }@\n"
size format_local_vars_defs defs
(generate_variable (GetValueVar "generic_index"))
Format.fprintf oc "if(m_is_defined_true(%a))@[<hov 2>{%a%a = %s;@]@;}@\n"
(generate_variable None) v format_local_vars_defs defs
(generate_variable (GetValueVar v))
var sv
(* Errors.raise_spanned_error "generic index table definitions not supported in C the backend"
* (Pos.get_position e) *)
| InputVar -> assert false

let generate_var_cond (cond : condition_data) (oc : Format.formatter) =
Expand Down
25 changes: 10 additions & 15 deletions src/mlang/backend_compilers/bir_to_dgfip_c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,11 +41,11 @@ let generate_unop (op : Mast.unop) : string =

type offset =
| GetValueConst of int
| GetValueVar of string
| GetValueVar of variable
| PassPointer
| None

let generate_variable (vm : Dgfip_varid.var_id_map) (offset : offset)
let rec generate_variable (vm : Dgfip_varid.var_id_map) (offset : offset)
?(def_flag = false) (var : Bir.variable) : string =
let mvar = Bir.var_to_mir var in
try
Expand All @@ -55,7 +55,7 @@ let generate_variable (vm : Dgfip_varid.var_id_map) (offset : offset)
let offset =
match offset with
| None -> ""
| GetValueVar offset -> " + " ^ offset
| GetValueVar offset -> " + (int)" ^ generate_variable vm None offset
| GetValueConst offset -> " + " ^ string_of_int offset
| PassPointer -> assert false
in
Expand Down Expand Up @@ -219,8 +219,6 @@ let rec generate_c_expr (e : expression Pos.marked)
value_comp = "mlocal" ^ string_of_int lvar.Mir.LocalVariable.id;
locals = [];
}
| GenericTableIndex ->
{ def_test = "1"; value_comp = "generic_index"; locals = [] }
| Error -> assert false (* should not happen *)
| LocalLet (lvar, e1, e2) ->
let se1 = generate_c_expr e1 var_indexes in
Expand Down Expand Up @@ -266,18 +264,15 @@ let generate_var_def (var_indexes : Dgfip_varid.var_id_map) (var : variable)
(generate_variable var_indexes (GetValueConst i) var)
sv.value_comp))
es
| TableVar (size, IndexGeneric e) ->
| TableVar (_size, IndexGeneric (v, e)) ->
(* TODO: boundary checks *)
let sv = generate_c_expr e var_indexes in
Format.fprintf oc
"for (int generic_index=0; generic_index < %d; generic_index++) {@\n\
\ @[<h 4> %a%s = %s;@\n\
%s = %s;@]@\n\
\ }@\n"
size format_local_vars_defs sv.locals
(generate_variable ~def_flag:true var_indexes
(GetValueVar "generic_index") var)
Format.fprintf oc "if(%s)@[<hov 2>{%a%s = %s;@ %s = %s;@]@;}@\n"
(generate_variable var_indexes None ~def_flag:true v)
format_local_vars_defs sv.locals
(generate_variable ~def_flag:true var_indexes (GetValueVar v) var)
sv.def_test
(generate_variable var_indexes (GetValueVar "generic_index") var)
(generate_variable var_indexes (GetValueVar v) var)
sv.value_comp
| InputVar -> assert false

Expand Down
13 changes: 6 additions & 7 deletions src/mlang/backend_compilers/bir_to_java.ml
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,6 @@ let rec generate_java_expr (e : expression Pos.marked) :
[] )
| LocalVar lvar ->
(Format.asprintf "localVariables[%d]" lvar.Mir.LocalVariable.id, [])
| GenericTableIndex -> (Format.asprintf "new MValue(genericIndex)", [])
| Error -> assert false (* should not happen *)
| LocalLet (lvar, e1, e2) ->
let _, s1 = generate_java_expr e1 in
Expand Down Expand Up @@ -186,14 +185,14 @@ let generate_var_def (var : variable) (data : variable_data)
(get_var_pos var |> ( + ) i)
format_var_name var sv))
es
| TableVar (size, IndexGeneric e) ->
| TableVar (_size, IndexGeneric (v, e)) ->
let se, s = generate_java_expr e in
Format.fprintf oc
"@[<hv 2>for (int genericIndex = 0; genericIndex < %d; genericIndex++) \
{@,\
@[<h 4> %atgv[%d + genericIndex /* %a */] = %s;@]@]@,\
}"
size format_local_vars_defs s (get_var_pos var) format_var_name var se
"if(!tgv[%d/* %a */].isUndefined())@[<hov 2>{@ %atgv[%d/* %a */ + \
(int)tgv[%d/* %a */].getValue()] = %s;@] }@,"
(get_var_pos v) format_var_name v format_local_vars_defs s
(get_var_pos var) format_var_name var (get_var_pos v) format_var_name v
se
| InputVar -> assert false

let generate_input_handling (function_spec : Bir_interface.bir_function)
Expand Down
13 changes: 7 additions & 6 deletions src/mlang/backend_compilers/bir_to_python.ml
Original file line number Diff line number Diff line change
Expand Up @@ -97,10 +97,12 @@ let undefined_class_prelude : string =
\ if isinstance(x, Undefined): return x\n\
\ else: return floor(x + 0.000001)\n\n\
class GenericIndex:\n\
\ def __init__(self, lambda_function):\n\
\ def __init__(self, lambda_function, var):\n\
\ self.l = lambda_function\n\
\ self.i = var\n\
\ def __getitem__(self, x):\n\
\ return self.l(x)"
\ if isinstance(self.i, Undefined) or self.i != x: return x\n\
\ else: self.l(x)"

let none_value = "Undefined()"

Expand Down Expand Up @@ -288,7 +290,6 @@ let rec generate_python_expr safe_bool_binops fmt (e : expression Pos.marked) :
| Literal Undefined -> Format.fprintf fmt "%s" none_value
| Var var -> Format.fprintf fmt "%a" generate_tgv_variable var
| LocalVar lvar -> Format.fprintf fmt "v%d" lvar.Mir.LocalVariable.id
| GenericTableIndex -> Format.fprintf fmt "generic_index"
| Error -> assert false (* TODO *)
| LocalLet (lvar, e1, e2) ->
Format.fprintf fmt "(lambda v%d: %a)(%a)" lvar.Mir.LocalVariable.id
Expand All @@ -313,14 +314,14 @@ let generate_var_def (var : variable) (data : variable_data)
Mir.IndexMap.iter (fun _ v ->
Format.fprintf fmt "%a, " (generate_python_expr false) v))
es
| TableVar (_, IndexGeneric e) ->
| TableVar (_, IndexGeneric (v, e)) ->
if !verbose_output then
Format.fprintf oc "# Defined %a@\n" Pos.format_position_short
(Pos.get_position e);
Format.fprintf oc "%a = GenericIndex(lambda generic_index: %a)@\n@\n"
Format.fprintf oc "%a = GenericIndex(lambda index: %a, %a)@\n@\n"
generate_tgv_variable var
(generate_python_expr false)
e
e generate_tgv_variable v
| InputVar -> assert false

let generate_header (oc : Format.formatter) () : unit =
Expand Down
4 changes: 2 additions & 2 deletions src/mlang/backend_ir/bir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -238,7 +238,7 @@ let get_local_variables (p : program) : unit Mir.LocalVariableMap.t =
(fun (acc : unit Mir.LocalVariableMap.t) arg ->
get_local_vars_expr acc arg)
acc args
| Mir.Literal _ | Mir.Var _ | Mir.GenericTableIndex | Mir.Error -> acc
| Mir.Literal _ | Mir.Var _ | Mir.Error -> acc
| Mir.LocalVar lvar -> Mir.LocalVariableMap.add lvar () acc
| Mir.LocalLet (lvar, e1, e2) ->
let acc = get_local_vars_expr acc e1 in
Expand All @@ -260,7 +260,7 @@ let get_local_variables (p : program) : unit Mir.LocalVariableMap.t =
Mir.IndexMap.fold
(fun _ e acc -> get_local_vars_expr acc e)
es acc
| Mir.IndexGeneric e -> get_local_vars_expr acc e)
| Mir.IndexGeneric (_v, e) -> get_local_vars_expr acc e)
| _ -> acc)
| SConditional (cond, s1, s2) ->
let acc = get_local_vars_expr acc (cond, Pos.no_pos) in
Expand Down
19 changes: 14 additions & 5 deletions src/mlang/backend_ir/bir_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -300,11 +300,20 @@ let adapt_program_to_function (p : Bir.program) (f : bir_function) :
| None ->
Mir.SimpleVar (Mir.Literal Mir.Undefined, pos)
| Some size ->
Mir.TableVar
( size,
Mir.IndexGeneric
(Pos.same_pos_as (Mir.Literal Mir.Undefined)
var.Mir.Variable.name) )
let idxmap =
let rec loop i acc =
if i < 0 then acc
else
loop (i - 1)
(Mir.IndexMap.add i
(Pos.same_pos_as
(Mir.Literal Mir.Undefined)
var.Mir.Variable.name)
acc)
in
loop (size - 1) Mir.IndexMap.empty
in
Mir.TableVar (size, Mir.IndexTable idxmap)
end;
} ),
pos )
Expand Down
74 changes: 54 additions & 20 deletions src/mlang/backend_ir/bir_interpreter.ml
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,6 @@ module type S = sig
type ctx = {
ctx_local_vars : value Pos.marked Mir.LocalVariableMap.t;
ctx_vars : var_value Bir.VariableMap.t;
ctx_generic_index : int option;
}

val empty_ctx : ctx
Expand Down Expand Up @@ -160,14 +159,12 @@ module Make (N : Bir_number.NumberInterface) = struct
type ctx = {
ctx_local_vars : value Pos.marked Mir.LocalVariableMap.t;
ctx_vars : var_value Bir.VariableMap.t;
ctx_generic_index : int option;
}

let empty_ctx : ctx =
{
ctx_local_vars = Mir.LocalVariableMap.empty;
ctx_vars = Bir.VariableMap.empty;
ctx_generic_index = None;
}

let literal_to_value (l : Mir.literal) : value =
Expand Down Expand Up @@ -485,10 +482,6 @@ module Make (N : Bir_number.NumberInterface) = struct
(Pos.get_position e)
in
r
| GenericTableIndex -> (
match ctx.ctx_generic_index with
| None -> assert false (* should not happen *)
| Some i -> Number (N.of_int (Int64.of_int i)))
| Error ->
raise
(RuntimeError
Expand Down Expand Up @@ -529,9 +522,8 @@ module Make (N : Bir_number.NumberInterface) = struct
| _ -> true_value ())
| FunctionCall (NullFunc, [ arg ]) -> (
match evaluate_expr ctx p arg with
| Undefined -> Undefined
| Number f ->
if N.is_zero f then true_value () else false_value ())
| Undefined -> Undefined
| Number f -> if N.is_zero f then true_value () else false_value ())
| FunctionCall (MinFunc, [ arg1; arg2 ]) -> (
match (evaluate_expr ctx p arg1, evaluate_expr ctx p arg2) with
| Undefined, Number f | Number f, Undefined ->
Expand Down Expand Up @@ -649,20 +641,52 @@ module Make (N : Bir_number.NumberInterface) = struct
(Pos.unmark (Mir.Error.err_descr_string err));
ctx

let evaluate_variable (p : Bir.program) (ctx : ctx)
let evaluate_variable (p : Bir.program) (ctx : ctx) (curr_value : var_value)
(vdef : Bir.variable Mir.variable_def_) : var_value =
match vdef with
| Mir.SimpleVar e -> SimpleVar (evaluate_expr ctx p.mir_program e)
| Mir.TableVar (size, es) ->
TableVar
( size,
Array.init size (fun idx ->
match es with
| IndexGeneric e ->
evaluate_expr
{ ctx with ctx_generic_index = Some idx }
p.mir_program e
| IndexTable es ->
match es with
| IndexGeneric (v, e) ->
let i =
match Bir.VariableMap.find v ctx.ctx_vars with
| SimpleVar n -> n
| TableVar _ -> assert false
(* should not happen *)
| exception Not_found ->
raise
(RuntimeError
( ErrorValue
( "no value found for dynamic index",
Pos.get_position e ),
ctx ))
in
let tval =
match curr_value with
| SimpleVar _ -> assert false (* should not happen *)
| TableVar (s, vals) ->
assert (s = size);
vals
in
(match i with
| Undefined -> ()
| Number f ->
let i = int_of_float (N.to_float f) in
if i < 0 || i >= size then
raise
(RuntimeError
( IndexOutOfBounds
("dynamic index out of bound", Pos.get_position e),
ctx )));
Array.init size (fun idx ->
match i with
| Number f when int_of_float (N.to_float f) = idx ->
evaluate_expr ctx p.mir_program e
| Number _ | Undefined -> tval.(idx))
| IndexTable es ->
Array.init size (fun idx ->
let e = Mir.IndexMap.find idx es in
evaluate_expr ctx p.mir_program e) )
| Mir.InputVar -> assert false
Expand All @@ -671,11 +695,21 @@ module Make (N : Bir_number.NumberInterface) = struct
(loc : code_location) =
match Pos.unmark stmt with
| Bir.SAssign (var, vdata) ->
let res = evaluate_variable p ctx vdata.var_definition in
let value =
try Bir.VariableMap.find var ctx.ctx_vars
with Not_found -> (
match (Bir.var_to_mir var).is_table with
| Some size -> TableVar (size, Array.make size Undefined)
| None -> SimpleVar Undefined)
in
let res = evaluate_variable p ctx value vdata.var_definition in
!assign_hook var (fun _ -> var_value_to_var_literal res) loc;
{ ctx with ctx_vars = Bir.VariableMap.add var res ctx.ctx_vars }
| Bir.SConditional (b, t, f) -> (
match evaluate_variable p ctx (SimpleVar (b, Pos.no_pos)) with
match
evaluate_variable p ctx (SimpleVar Undefined)
(SimpleVar (b, Pos.no_pos))
with
| SimpleVar (Number z) when N.(z =. zero ()) ->
evaluate_stmts p ctx f (ConditionalBranch false :: loc) 0
| SimpleVar (Number _) ->
Expand Down
1 change: 0 additions & 1 deletion src/mlang/backend_ir/bir_interpreter.mli
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,6 @@ module type S = sig
type ctx = {
ctx_local_vars : value Pos.marked Mir.LocalVariableMap.t;
ctx_vars : var_value Bir.VariableMap.t;
ctx_generic_index : int option;
}
(** Interpretation context *)

Expand Down
Loading

0 comments on commit 32fee5d

Please sign in to comment.