Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

[M extension] variable category generalization #217

Merged
merged 4 commits into from
Jun 28, 2023
Merged

[M extension] variable category generalization #217

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
94c68bc
[M extension] variable category generalization
Keryan-dev May 30, 2023
15fa013
bugfixes
Keryan-dev May 31, 2023
617cde2
more reporting
Keryan-dev May 31, 2023
3cb6648
some homogeny
Keryan-dev May 31, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 31 additions & 21 deletions src/mlang/backend_compilers/dgfip_gen_files.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -130,27 +130,37 @@ let is_input st = match st with Base | Computed -> false | _ -> true
let is_computed st = match st with Base | Computed -> true | _ -> false

let input_var_subtype iv : var_subtype =
match Pos.unmark iv.Mast.input_subtyp with
| Mast.Context -> Context
| Family -> Family
| Penality -> Penality
| Income -> Income
List.find_map
(fun t ->
match Pos.unmark t with
| "contexte" -> Some Context
| "famille" -> Some Family
| "penalite" -> Some Penality
| "revenu" -> Some Income
| _ -> None)
iv.Mast.input_category
|> function
| Some s -> s
| None -> assert false
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here you should maybe put an error message in case someone enters an attribute not in the list of strings you accept above?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So the issue here would be that none of the expected categories appears, not that there is an unexpected one. I definitely would add a clean error message here, but this file in its current state ought to fall into oblivion as it's mostly adhoc, hardcoded, necessary mess that works only because tailored for the current M codebase.

(* Missing CorrIncome and Variation (actually not used *)

let computed_var_subtype cv : var_subtype =
let is_base =
List.exists
(fun ct ->
match Pos.unmark ct with Mast.Base -> true | GivenBack -> false)
cv.Mast.comp_subtyp
(fun ct -> String.equal (Pos.unmark ct) Mast.base_category)
cv.Mast.comp_category
in
if is_base then Base else Computed

let computed_var_is_output cv =
List.exists
(fun st ->
match Pos.unmark st with Mast.GivenBack -> true | Base -> false)
cv.Mast.comp_subtyp
(fun st -> String.equal (Pos.unmark st) Mast.givenback_category)
cv.Mast.comp_category

let input_var_is_output iv =
List.exists
(fun st -> String.equal (Pos.unmark st) Mast.givenback_category)
iv.Mast.input_category

let consider_output is_ebcdic attribs =
is_ebcdic = false
Expand All @@ -164,12 +174,12 @@ let consider_output is_ebcdic attribs =
(* Used to generated the array names *)
let subtype_name subtyp =
match subtyp with
| Context -> "contexte"
| Family -> "famille"
| Income -> "revenu"
| Context -> Mast.context_category
| Family -> Mast.family_category
| Income -> Mast.income_category
| CorrIncome -> "revenu_correc"
| Variation -> "variation"
| Penality -> "penalite"
| Penality -> Mast.penality_category
| Base -> assert false (* never used *)
| Computed -> assert false
(* never used *)
Expand All @@ -178,10 +188,10 @@ let subtype_name subtyp =
let req_type_name req_type =
match req_type with
| Computed (Some typ) -> subtype_name typ
| Computed None -> "calculee"
| Computed None -> Mast.computed_category
| Input (Some typ) -> subtype_name typ
| Input None -> "saisie"
| Output -> "restituee"
| Input None -> Mast.input_category
| Output -> Mast.givenback_category
| Debug i when i <= 0 -> "debug"
| Debug i -> Printf.sprintf "debug%02d" i

Expand Down Expand Up @@ -299,7 +309,7 @@ let get_vars prog is_ebcdic =
let tvar = input_var_subtype iv in
let idx1, idx2, idxo_opt =
next_idx idx tvar
(iv.input_given_back
(input_var_is_output iv
&& consider_output is_ebcdic iv.Mast.input_attributes)
1
in
Expand Down Expand Up @@ -510,7 +520,7 @@ let gen_var fmt req_type opt ~idx ~name ~tvar ~is_output ~typ_opt ~attributes
if opt.with_libelle then Format.fprintf fmt ", \"%s\"" desc
else Format.fprintf fmt " /*\"%s\"*/" desc;
begin
match (req_type, tvar) with
match ((req_type : gen_type), tvar) with
| Input _, Income -> Format.fprintf fmt ", \"%s\"" name
| _ -> ()
end;
Expand Down Expand Up @@ -615,7 +625,7 @@ let gen_desc fmt vars ~alias_only is_ebcdic =
| Base | Computed -> begin
(* computed var: only output *)
match idxo_opt with
| Some idx -> Some ("restituee", idx)
| Some idx -> Some (Mast.givenback_category, idx)
| None -> None
end
| _ -> Some (subtype_name tvar, idx2)
Expand Down
48 changes: 24 additions & 24 deletions src/mlang/m_frontend/format_mast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -235,19 +235,6 @@ let format_rule fmt (r : rule) =
(pp_unmark format_formula))
r.rule_formulaes

let format_computed_typ fmt (t : computed_typ) =
match t with
| Base -> Format.fprintf fmt "base"
| GivenBack -> Format.fprintf fmt "restituee"

let format_input_variable_subtype fmt (t : input_variable_subtype) =
Format.pp_print_string fmt
(match t with
| Context -> "contexte"
| Family -> "famille"
| Penality -> "penalite"
| Income -> "revenu")

let format_value_typ fmt (t : value_typ) =
Format.pp_print_string fmt
(match t with
Expand All @@ -258,28 +245,27 @@ let format_value_typ fmt (t : value_typ) =
| Integer -> "ENTIER"
| Real -> "REEL")

let format_input_attribute fmt
((n, v) : input_variable_attribute Pos.marked * literal Pos.marked) =
let format_input_attribute fmt ((n, v) : variable_attribute) =
Format.fprintf fmt "%s = %a" (Pos.unmark n) format_literal (Pos.unmark v)

let format_input_variable fmt (v : input_variable) =
Format.fprintf fmt "%a saisie %a %a%s %a : %s%a;" format_variable_name
(Pos.unmark v.input_name) format_input_variable_subtype
(Pos.unmark v.input_subtyp)
Format.fprintf fmt "%a %s %a %a %a : %s%a;" format_variable_name
(Pos.unmark v.input_name) input_category
(pp_print_list_space Format.pp_print_string)
(List.map Pos.unmark v.input_category)
(pp_print_list_space format_input_attribute)
v.input_attributes
(if v.input_given_back then " restituee" else "")
format_variable_name (Pos.unmark v.input_alias)
v.input_attributes format_variable_name (Pos.unmark v.input_alias)
(Pos.unmark v.input_description)
(option_print format_value_typ)
(option_bind Pos.unmark v.input_typ)

let format_computed_variable fmt (v : computed_variable) =
Format.fprintf fmt "%s%a calculee %a : %a%s;" (Pos.unmark v.comp_name)
Format.fprintf fmt "%s%a %s %a : %a%s;" (Pos.unmark v.comp_name)
(option_print Format.pp_print_int)
(option_bind Pos.unmark v.comp_table)
(pp_print_list_space (pp_unmark format_computed_typ))
v.comp_subtyp
computed_category
(pp_print_list_space (pp_unmark Format.pp_print_string))
v.comp_category
(option_print format_value_typ)
(option_bind Pos.unmark v.comp_typ)
(Pos.unmark v.comp_description)
Expand Down Expand Up @@ -323,6 +309,17 @@ let format_error_ fmt (e : error_) =
(pp_unmark Format.pp_print_string))
e.error_descr

let format_var_type (t : var_type) =
match t with Input -> input_category | Computed -> computed_category

let format_var_category fmt (c : var_category_decl) =
Format.fprintf fmt "%s %a :@ attributs %a"
(format_var_type c.var_type)
(pp_print_list_space (pp_unmark Format.pp_print_string))
c.var_category
(pp_print_list_comma (pp_unmark Format.pp_print_string))
c.var_attributes

let format_source_file_item fmt (i : source_file_item) =
match i with
| Application app ->
Expand All @@ -338,6 +335,9 @@ let format_source_file_item fmt (i : source_file_item) =
| Error e -> format_error_ fmt e
| Output o ->
Format.fprintf fmt "sortie(%a);" format_variable_name (Pos.unmark o)
| VarCatDecl c ->
Format.fprintf fmt "variable category %a;" format_var_category
(Pos.unmark c)

let format_source_file fmt (f : source_file) =
pp_print_list_endline (pp_unmark format_source_file_item) fmt f
2 changes: 2 additions & 0 deletions src/mlang/m_frontend/format_mast.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ val format_unop : Format.formatter -> Mast.unop -> unit

val format_value_typ : Format.formatter -> Mast.value_typ -> unit

val format_var_type : Mast.var_type -> string

val format_variable : Format.formatter -> Mast.variable -> unit

val format_source_file : Format.formatter -> Mast.source_file -> unit
Expand Down
50 changes: 31 additions & 19 deletions src/mlang/m_frontend/mast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -340,12 +340,7 @@ type rule = {

(**{3 Input variables}*)

(** Unused for now, except for typechecking: [Income] should be a real number
corresponding to an amount of money *)
type input_variable_subtype = Context | Family | Penality | Income

type input_variable_attribute = string
(** Attributes are unused for now *)
type variable_attribute = string Pos.marked * literal Pos.marked

(** Here are all the types a value can have. Date types don't seem to be used at
all though. *)
Expand All @@ -359,27 +354,19 @@ type value_typ =

type input_variable = {
input_name : variable_name Pos.marked;
input_subtyp : input_variable_subtype Pos.marked;
input_attributes :
(input_variable_attribute Pos.marked * literal Pos.marked) list;
input_given_back : bool;
(** An input variable given back ("restituee") means that it's also an
output *)
input_category : string Pos.marked list;
input_attributes : variable_attribute list;
input_alias : variable_name Pos.marked; (** Unused for now *)
input_description : string Pos.marked;
input_typ : value_typ Pos.marked option;
}

(** A [GivenBack] variable is an output of the program *)
type computed_typ = Base | GivenBack

type computed_variable = {
comp_name : variable_name Pos.marked;
comp_table : int Pos.marked option;
(** size of the table, [None] for non-table variables *)
comp_attributes :
(input_variable_attribute Pos.marked * literal Pos.marked) list;
comp_subtyp : computed_typ Pos.marked list;
comp_attributes : variable_attribute list;
comp_category : string Pos.marked list;
comp_typ : value_typ Pos.marked option;
comp_description : string Pos.marked;
}
Expand All @@ -390,6 +377,31 @@ type variable_decl =
(** The literal is the constant value *)
| InputVar of input_variable Pos.marked

type var_type = Input | Computed

type var_category_decl = {
var_type : var_type;
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't really understand the meaning of this struct. Does this correspond in the syntax to a declaration of a new variable category, or a new variable ? If this was the declaration of a new variable category I would just have expected a string here (déclaration catégorie XXX or déclaration attribut XXX).

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh I see the declaration is of the sort déclaration catégorie XXX saisie attributs YYY, ZZZ

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, the expected attributes are simply listed while the actual category is the set of declared keywords before. It reads as "variables declared with keywords that includes this set are expected to have exactly these attributes."

var_category : string Pos.marked list;
var_attributes : string Pos.marked list;
}

(* standard categories *)
let input_category = "saisie"

let computed_category = "calculee"

let base_category = "base"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Cant' these be put in a attributs.m file and not hardcoded in the compiler?

Copy link
Collaborator Author

@Keryan-dev Keryan-dev Jun 8, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is only to minimize occurrences of hardcoded strings in various places of the code. Because the compiler still needs to identify them for lack of generality. This ought to disappear once every specificities like this are declared away in the user code instead of in the compiler.


let givenback_category = "restituee"

let family_category = "famille"

let income_category = "revenu"

let context_category = "contexte"

let penality_category = "penalite"

(**{2 Verification clauses}*)

(** These clauses are expression refering to the variables of the program. They
Expand Down Expand Up @@ -437,7 +449,7 @@ type source_file_item =
| Error of error_ (** Declares an error *)
| Output of variable_name Pos.marked (** Declares an output variable *)
| Function (** Declares a function, unused *)

| VarCatDecl of var_category_decl Pos.marked
(* TODO: parse something here *)

type source_file = source_file_item Pos.marked list
Expand Down
Loading