feat(runtime): clean parse_raw_events + add documentation

This commit is contained in:
Emile Rolley 2022-06-15 19:33:24 +02:00
parent 9b5779ed62
commit e35e4a7cb4
5 changed files with 280 additions and 331 deletions

View File

@ -172,60 +172,37 @@ let embed_date x = Date x
let embed_duration x = Duration x
let embed_array f x = Array (Array.map f x)
type information = string list
type raw_event =
| BeginCall of string list
| EndCall of string list
| VariableDefinition of string list * runtime_value
| BeginCall of information
| EndCall of information
| VariableDefinition of information * runtime_value
| DecisionTaken of source_position
type event =
| VarDef of var_def
| VarDefWithFunCalls of var_def_with_fun_calls
| VarComputation of var_def
| FunCall of fun_call
| SubScopeCall of {
name : string list;
name : information;
inputs : var_def list;
body : event list;
}
and var_def = {
pos : source_position option;
name : string list;
name : information;
value : runtime_value;
fun_calls : fun_call list option;
}
and var_def_with_fun_calls = { var : var_def; fun_calls : fun_call list }
and fun_call = {
fun_name : string list;
fun_name : information;
input : var_def;
body : event list;
output : var_def_with_fun_calls;
output : var_def;
}
let raw_event_to_string = function
| BeginCall name ->
Printf.sprintf "BeginCall([ " ^ String.concat ", " name ^ " ])"
| EndCall name ->
Printf.sprintf "EndCall([ " ^ String.concat ", " name ^ " ])"
| VariableDefinition (name, value) ->
Printf.sprintf "VariableDefinition([ %s ], %s)" (String.concat ", " name)
(yojson_of_runtime_value value |> Yojson.Safe.to_string)
| DecisionTaken _ -> Printf.sprintf "DecisionTaken(_)"
(* let event_to_string = function *)
(* | VarDef { name; _ } -> *)
(* Printf.sprintf "VarDef(name: [ " ^ String.concat ", " name ^ " ])" *)
(* | VarDefWithFunCalls { var; _ } -> *)
(* Printf.sprintf "VarDefWithFunCalls(var.name: [ " *)
(* ^ String.concat ", " var.name *)
(* ^ " ])" *)
(* | FunCall { fun_name; _ } -> *)
(* Printf.sprintf "FunCall(fun_name: [ " ^ String.concat ", " fun_name ^ "
])" *)
(* | SubScopeCall { name; _ } -> *)
(* Printf.sprintf "SubScopeCall(name: [ " ^ String.concat ", " name ^ " ])" *)
let log_ref : raw_event list ref = ref []
let reset_log () = log_ref := []
let retrieve_log () = List.rev !log_ref
@ -246,24 +223,6 @@ let log_decision_taken pos x =
if x then log_ref := DecisionTaken pos :: !log_ref;
x
module VarDefMap = struct
module StringMap = Map.Make (String)
type t = var_def list StringMap.t
let add (name : string) (v : var_def) (map : t) : t =
match StringMap.find_opt name map with
| Some ls -> StringMap.add name (v :: ls) map
| None -> StringMap.add name [v] map
(** [get name map] return the list of definitions if there is a corresponding
entry, otherwise, returns an empty array. *)
let get (name : string) (map : t) : var_def list =
match StringMap.find_opt name map with Some ls -> ls | None -> []
let empty : t = StringMap.empty
end
let rec pp_events ?(is_first_call = true) ppf events =
let rec format_var_def ppf var =
Format.fprintf ppf "@[<hov 2><var_def at %a>@ %s:@ %a@]" format_pos_opt
@ -280,17 +239,18 @@ let rec pp_events ?(is_first_call = true) ppf events =
~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ")
format_var_def ppf
and format_var_def_with_fun_calls ppf var_with_fun =
if [] = var_with_fun.fun_calls then format_var_def ppf var_with_fun.var
else
match var_with_fun.fun_calls with
| None | Some [] -> format_var_def ppf var_with_fun
| Some fun_calls ->
Format.fprintf ppf
"@[<hov 2><var_def_with_fun>@ %s: %a@ computed from@ :@ @[<hv 2>[@ %a@;\
<1 -2>]@] @]"
(String.concat "." var_with_fun.var.name)
format_value var_with_fun.var.value
(String.concat "." var_with_fun.name)
format_value var_with_fun.value
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
(fun ppf fun_call -> format_event ppf (FunCall fun_call)))
var_with_fun.fun_calls
fun_calls
and format_value ppf = function
| Unembeddable -> Format.fprintf ppf "fun"
| Unit -> Format.fprintf ppf "()"
@ -317,9 +277,10 @@ let rec pp_events ?(is_first_call = true) ppf events =
format_value)
(elts |> Array.to_list)
and format_event ppf = function
| VarDef var -> Format.fprintf ppf "%a" format_var_def var
| VarDefWithFunCalls var_with_fun ->
Format.fprintf ppf "%a" format_var_def_with_fun_calls var_with_fun
| VarComputation var_def_with_fun
when Option.is_some var_def_with_fun.fun_calls ->
Format.fprintf ppf "%a" format_var_def_with_fun_calls var_def_with_fun
| VarComputation var_def -> Format.fprintf ppf "%a" format_var_def var_def
| FunCall { fun_name; input; body; output } ->
Format.fprintf ppf
"@[<hov 1><function_call>@ %s :=@ {@[<hv 1>@ input:@ %a,@ output:@ \
@ -349,182 +310,188 @@ let rec pp_events ?(is_first_call = true) ppf events =
format_event)
events
type context = {
(* Keeps tracks of the subscope input variable definitions. *)
vars : VarDefMap.t;
(* Current parsed events. *)
events : event list;
rest : raw_event list;
}
module EventParser = struct
module VarDefMap = struct
module StringMap = Map.Make (String)
(** TODO:
type t = var_def list StringMap.t
- add error handling*)
let parse_log (raw_events : raw_event list) : event list =
let nb_raw_events = List.length raw_events in
Printf.printf "Start parsing %d events\n" nb_raw_events;
let is_function_call infos = 2 = List.length infos in
let is_subscope_call infos = 3 = List.length infos in
let is_var_def name = 2 = List.length name in
let is_output_var_def name =
3 = List.length name && "output" = List.nth name 2
in
let is_input_var_def name =
3 = List.length name && "input" = List.nth name 2
in
let is_subscope_input_var_def name =
let res = 2 = List.length name && String.contains (List.nth name 1) '.' in
Printf.printf "\n==== is_subscope_input_var_def %s = %b\n"
(String.concat "." name) res;
res
in
let add (name : string) (v : var_def) (map : t) : t =
match StringMap.find_opt name map with
| Some ls -> StringMap.add name (v :: ls) map
| None -> StringMap.add name [v] map
let rec parse_events (ctx : context) : context =
(try
Printf.printf "[%d/%d] Parsing events: %s followed by %s\n"
(nb_raw_events - List.length ctx.rest + 1)
nb_raw_events
(List.hd ctx.rest |> raw_event_to_string)
(ctx.rest |> List.tl |> List.hd |> raw_event_to_string)
with Failure _ -> ());
match ctx.rest with
| [] -> { ctx with events = ctx.events |> List.rev }
| VariableDefinition (name, value) :: rest when is_var_def name ->
parse_events
{
ctx with
events = VarDef { pos = None; name; value } :: ctx.events;
rest;
}
| DecisionTaken pos :: VariableDefinition (name, value) :: rest
when is_subscope_input_var_def name -> (
match name with
| [_; var_dot_subscope_var_name] ->
let var_name =
List.nth (String.split_on_char '.' var_dot_subscope_var_name) 0
in
parse_events
{
ctx with
vars =
ctx.vars |> VarDefMap.add var_name { pos = Some pos; name; value };
rest;
}
| _ ->
failwith
("Invalid subscope input variable definition: [ "
^ String.concat ", " name ^ " ]"))
| DecisionTaken pos :: VariableDefinition (name, value) :: rest
when is_var_def name || is_output_var_def name ->
parse_events
{
ctx with
events = VarDef { pos = Some pos; name; value } :: ctx.events;
rest;
}
| DecisionTaken pos
:: VariableDefinition _ (* fun input *)
:: BeginCall infos
:: _
when is_function_call infos ->
(* Variable definition with fun calls. *)
let rec parse_fun_calls fun_calls raw_events =
match raw_events with
| VariableDefinition _ :: BeginCall infos :: _
when is_function_call infos ->
let rest, fun_call = parse_fun_call raw_events in
parse_fun_calls (fun_call :: fun_calls) rest
| rest -> rest, fun_calls |> List.rev
in
let rest, fun_calls, var =
let rest, fun_calls = parse_fun_calls [] (List.tl ctx.rest) in
match rest with
| VariableDefinition (name, value) :: rest ->
rest, fun_calls, { pos = Some pos; name; value }
| event :: _ ->
failwith
("Invalid function call ([ " ^ String.concat ", " infos
^ " ]): expected variable definition (function ouput), found: "
^ raw_event_to_string event ^ "["
^ (nb_raw_events - List.length rest + 1 |> string_of_int)
^ "]")
| [] -> failwith "empty log"
in
(** [get name map] returns the list of definitions if there is a
corresponding entry, otherwise, returns an empty array. *)
let get (name : string) (map : t) : var_def list =
match StringMap.find_opt name map with Some ls -> ls | None -> []
parse_events
{
ctx with
events = VarDefWithFunCalls { var; fun_calls } :: ctx.events;
rest;
}
| VariableDefinition _ :: BeginCall infos :: _ when is_function_call infos
->
let rest, fun_call = parse_fun_call ctx.rest in
let empty : t = StringMap.empty
end
parse_events { ctx with events = FunCall fun_call :: ctx.events; rest }
| BeginCall infos :: rest when is_subscope_call infos -> (
match infos with
| [_; var_name; _] ->
(* NOTE: should use an empty context here? *)
let body_ctx = parse_events { ctx with events = []; rest } in
let inputs = VarDefMap.get var_name body_ctx.vars in
type context = {
(* Keeps tracks of the subscope input variable definitions. *)
vars : VarDefMap.t;
(* Current parsed events. *)
events : event list;
rest : raw_event list;
}
let empty_ctx = { vars = VarDefMap.empty; events = []; rest = [] }
let raw_event_to_string = function
| BeginCall name ->
Printf.sprintf "BeginCall([ " ^ String.concat ", " name ^ " ])"
| EndCall name ->
Printf.sprintf "EndCall([ " ^ String.concat ", " name ^ " ])"
| VariableDefinition (name, value) ->
Printf.sprintf "VariableDefinition([ %s ], %s)" (String.concat ", " name)
(yojson_of_runtime_value value |> Yojson.Safe.to_string)
| DecisionTaken _ -> Printf.sprintf "DecisionTaken(_)"
let parse_raw_events raw_events =
let nb_raw_events = List.length raw_events
and is_function_call infos = 2 = List.length infos
and is_subscope_call infos = 3 = List.length infos
and is_var_def name = 2 = List.length name
and is_output_var_def name =
3 = List.length name && "output" = List.nth name 2
and is_input_var_def name =
3 = List.length name && "input" = List.nth name 2
and is_subscope_input_var_def name =
2 = List.length name && String.contains (List.nth name 1) '.'
in
let rec parse_events (ctx : context) : context =
match ctx.rest with
| [] -> { ctx with events = ctx.events |> List.rev }
| VariableDefinition (name, value) :: rest when is_var_def name ->
parse_events
{
ctx with
events =
SubScopeCall { name = infos; inputs; body = body_ctx.events }
VarComputation { pos = None; name; value; fun_calls = None }
:: ctx.events;
rest = body_ctx.rest;
rest;
}
| _ ->
failwith
("Invalid subscope call name: [ " ^ String.concat ", " infos ^ " ]"))
| EndCall infos :: rest ->
Printf.printf "Find the endcall token of: %s\n" (String.concat ", " infos);
{ ctx with events = ctx.events |> List.rev; rest }
| event :: event' :: _ ->
failwith
("[EventParser error] invalid event: " ^ raw_event_to_string event
^ ", followed by: " ^ raw_event_to_string event')
| _ -> failwith "empty log"
and parse_fun_call events =
(try
Printf.printf "[%d/%d] In parse_fun_call, parsing events: %s\n"
(nb_raw_events - List.length events)
nb_raw_events
(List.hd events |> raw_event_to_string)
with Failure _ -> Printf.printf "Error in parse_fun_call");
match events with
| VariableDefinition (name, value) :: BeginCall infos :: rest
when is_function_call infos && is_input_var_def name ->
Printf.printf "Parsing function call of: %s\n" (String.concat ", " infos);
let rest, body, output =
let body_ctx =
Printf.printf "Before call rest.length = %d\n" (List.length rest);
parse_events { vars = VarDefMap.empty; events = []; rest }
| DecisionTaken pos :: VariableDefinition (name, value) :: rest
when is_subscope_input_var_def name -> (
match name with
| [_; var_dot_subscope_var_name] ->
let var_name =
List.nth (String.split_on_char '.' var_dot_subscope_var_name) 0
in
parse_events
{
ctx with
vars =
ctx.vars
|> VarDefMap.add var_name
{ pos = Some pos; name; value; fun_calls = None };
rest;
}
| _ ->
failwith "unreachable due to the [is_subscope_input_var_def] test")
| DecisionTaken pos :: VariableDefinition (name, value) :: rest
when is_var_def name || is_output_var_def name ->
parse_events
{
ctx with
events =
VarComputation { pos = Some pos; name; value; fun_calls = None }
:: ctx.events;
rest;
}
| DecisionTaken pos :: VariableDefinition _ :: BeginCall infos :: _
when is_function_call infos ->
(* Variable definition with function calls. *)
let rec parse_fun_calls fun_calls raw_events =
match raw_events with
| VariableDefinition _ :: BeginCall infos :: _
when is_function_call infos ->
let rest, fun_call = parse_fun_call raw_events in
parse_fun_calls (fun_call :: fun_calls) rest
| rest -> rest, fun_calls |> List.rev
in
let rest, var_comp =
let rest, fun_calls = parse_fun_calls [] (List.tl ctx.rest) in
match rest with
| VariableDefinition (name, value) :: rest ->
( rest,
VarComputation
{ pos = Some pos; name; value; fun_calls = Some fun_calls } )
| event :: _ ->
failwith
("Invalid function call ([ " ^ String.concat ", " infos
^ " ]): expected variable definition (function output), found: "
^ raw_event_to_string event ^ "["
^ (nb_raw_events - List.length rest + 1 |> string_of_int)
^ "]")
| [] ->
failwith
("Invalid function call ([ " ^ String.concat ", " infos
^ " ]): expected variable definition (function output), found: \
end of tokens")
in
Printf.printf "After call rest.length = %d\n"
(List.length body_ctx.rest);
let body_rev = List.rev body_ctx.events in
body_ctx.rest, body_rev |> List.tl |> List.rev, body_rev |> List.hd
in
let output =
match output with
| VarDef var -> { var; fun_calls = [] }
| VarDefWithFunCalls def -> def
| _ -> failwith "[EventParser error]: invalid function call output"
in
( rest,
{ fun_name = infos; input = { pos = None; name; value }; body; output }
)
| _ -> failwith "[EventParser error]: invalid function call"
in
parse_events { ctx with events = var_comp :: ctx.events; rest }
| VariableDefinition _ :: BeginCall infos :: _ when is_function_call infos
->
let rest, fun_call = parse_fun_call ctx.rest in
let ctx =
parse_events { vars = VarDefMap.empty; events = []; rest = raw_events }
in
ctx.events
parse_events { ctx with events = FunCall fun_call :: ctx.events; rest }
| BeginCall infos :: rest when is_subscope_call infos -> (
match infos with
| [_; var_name; _] ->
let body_ctx = parse_events { empty_ctx with rest } in
let inputs = VarDefMap.get var_name ctx.vars in
parse_events
{
ctx with
events =
SubScopeCall { name = infos; inputs; body = body_ctx.events }
:: ctx.events;
rest = body_ctx.rest;
}
| _ -> failwith "unreachable due to the [is_subscope_call] test")
| EndCall _ :: rest -> { ctx with events = ctx.events |> List.rev; rest }
| event :: _ -> failwith ("Unexpected event: " ^ raw_event_to_string event)
and parse_fun_call events =
match events with
| VariableDefinition (name, value) :: BeginCall infos :: rest
when is_function_call infos && is_input_var_def name ->
let rest, body, output =
let body_ctx =
parse_events { vars = VarDefMap.empty; events = []; rest }
in
let body_rev = List.rev body_ctx.events in
body_ctx.rest, body_rev |> List.tl |> List.rev, body_rev |> List.hd
in
let output =
match output with
| VarComputation var_def -> var_def
| _ -> failwith "Missing function output variable definition."
in
( rest,
{
fun_name = infos;
input = { pos = None; name; value; fun_calls = None };
body;
output;
} )
| _ -> failwith "Invalid start of function call."
in
let ctx =
try parse_events { empty_ctx with rest = raw_events }
with Failure msg ->
(* TODO: discuss what should be done. *)
Printf.eprintf "An error occurred while parsing raw events: %s\n" msg;
empty_ctx
in
ctx.events
end
let handle_default :
'a. (unit -> 'a) array -> (unit -> bool) -> (unit -> 'a) -> 'a =

View File

@ -72,72 +72,119 @@ val embed_array : ('a -> runtime_value) -> 'a Array.t -> runtime_value
(** {1 Logging} *)
(** The logging is constituted of two phases.
(** {2 Global process} *)
The first one consists in collecting {!type: rawEvent} during the program
execution.
(** The logging is constituted of two phases:
The second one consists in parsing the collected raw events into structured
ones. *)
- The first one consists of collecting {i raw} events (see
{!type:raw_event}) during the program execution (see {!val:retrieve_log})
throught {!instruments}.
- The second one consists in parsing the collected raw events into
{i structured} ones (see {!type: event}). *)
(** {2 Data structures} *)
type information = string list
(** Represents information about a name in the code -- i.e. variable name,
subscope name, etc...
It's a list of strings with a length varying from 2 to 3, where:
- the first string is the name of the current scope -- starting with a
capitalized letter [Scope_name],
- the second string is either: the name of a scope variable or, the name of
a subscope input variable -- [a_subscope_var.input_var]
- the third string is either: a subscope name (starting with a capitalized
letter [Subscope_name] or, the [input] (resp. [output]) string -- which
corresponds to the input (resp. the output) of a function. *)
(** {3 The raw events} *)
type raw_event =
| BeginCall of string list
| EndCall of string list
| VariableDefinition of string list * runtime_value
| DecisionTaken of source_position
| BeginCall of information (** Subscope or function call. *)
| EndCall of information (** End of a subscope or a function call. *)
| VariableDefinition of information * runtime_value
(** Definition of a variable or a function argument. *)
| DecisionTaken of source_position (** Source code position of an event. *)
(** {3 The structured events} *)
(** The corresponding grammar of the {!type: event} type, is the following:
{v
<event> := <fun_call>
| <subscope_call>
| <var_def>
| <var_def_with_fun>
| VariableDefinition
<fun_call> :=
VariableDefinition (function input)
<fun_call_beg>
<event>*
(<var_def> | <var_def_with_fun>) (function output)
EndCall
<var_def_with_fun> :=
/-- DecisionTaken
pos of | <fun_call>+ (function calls needed to compute the variable value)
\-> VariableDefinition
<subscope_call> :=
<sub_var_def>* (sub-scope attributes def)
<sub_call_beg>
<event>+
EndCall
<var_def> := DecisionTaken VariableDefinition(info, _)
(when info.length = 2 && info[1] == "id")
<sub_var_def> := DecisionTaken VariableDefinition(info, _)
(when info.length = 3)
<fun_call_beg> := BeginCall(info)
(when info.length = 2)
<sub_call_beg> := BeginCall(info)
(when info.length = 2 and '.' in info[1])
v} *)
type event =
| VarDef of var_def
| VarDefWithFunCalls of var_def_with_fun_calls
| VarComputation of var_def
| FunCall of fun_call
| SubScopeCall of {
name : string list;
name : information;
inputs : var_def list;
body : event list;
}
and var_def = {
pos : source_position option;
name : string list;
name : information;
value : runtime_value;
fun_calls : fun_call list option;
}
and var_def_with_fun_calls = { var : var_def; fun_calls : fun_call list }
and fun_call = {
fun_name : string list;
fun_name : information;
input : var_def;
body : event list;
output : var_def_with_fun_calls;
output : var_def;
}
val raw_event_to_string : raw_event -> string
(** TODO: should it be removed? *)
(** {2 Parsing} *)
val retrieve_log : unit -> raw_event list
(** [retrieve_log ()] returns the current list of collected [raw_event].*)
val parse_log : raw_event list -> event list
(** [parse_log raw_events] parses raw events into {i structured} ones. *)
module EventParser : sig
val parse_raw_events : raw_event list -> event list
(** [parse_raw_events raw_events] parses raw events into {i structured} ones. *)
end
val pp_events : ?is_first_call:bool -> Format.formatter -> event list -> unit
(** [pp_events ~is_first_call ppf events] pretty prints in [ppf] the string
representation of [events].
(** {2 Helping functions} *)
If [is_first_call] is set to true, the formatter will be flush at the end.
By default, [is_first_call] is set to false.
Note: it's used for debugging purposes. *)
(** {2 Log instruments} *)
(** {3:instruments Logging instruments} *)
val reset_log : unit -> unit
val log_begin_call : string list -> 'a -> 'a
@ -145,6 +192,15 @@ val log_end_call : string list -> 'a -> 'a
val log_variable_definition : string list -> ('a -> runtime_value) -> 'a -> 'a
val log_decision_taken : source_position -> bool -> bool
(** {3 Pretty printers} *)
val pp_events : ?is_first_call:bool -> Format.formatter -> event list -> unit
(** [pp_events ~is_first_call ppf events] pretty prints in [ppf] the string
representation of [events].
If [is_first_call] is set to true, the formatter will be flush at the end.
By default, [is_first_call] is set to false. *)
(**{1 Constructors and conversions} *)
(**{2 Money}*)

View File

@ -277,6 +277,10 @@ let rec translate_expr (ctx : ctx) (e : Ast.expr Pos.marked) :
in
let new_args = List.map (translate_expr ctx) args in
let input_typ, output_typ =
(* NOTE: this is a temporary solution, it works because it's assume that
all function calls are from scope variable. However, this will change
-- for more information see
https://github.com/CatalaLang/catala/pull/280#discussion_r898851693. *)
let retrieve_in_and_out_typ_or_any var vars =
let _, typ, _ = Ast.ScopeVarMap.find (Pos.unmark var) vars in
match typ with

View File

@ -14,11 +14,6 @@ will export functions corresponding to the scopes of the original Catala
program. You can then reuse those exported functions in your application written
in X.
### Log events
To have a better understanding of the log events structure, see [the dedicated
readme](log-events.md).
## OCaml
To see how to deploy Catala programs as an OCaml library, see

View File

@ -1,73 +0,0 @@
# Mechanics of log events
## Some invariants
Log events respect the following invariants:
1. _Function calls always have one input and one ouput._
2. _2 <= `logEvent.information.length` <= 3_
## Structure
In the following, _**raw** log events_ will refer to the array of logs built
during the program execution -- the result of `retrieveLog` and the result of
the `-t` flag for the `Interpret` backend. In contrast, of the _**structured**
log events_ which are built from the _raw_ ones in order to reflect the
semantic in the log structure itself.
### Raw log events
For raw log events, there is four types of event:
* `Decision taken` (token: `POS`) (source code position)
* `Variable definition` (token: `VAR_DEF`)
* `Begin call` (token: `BEG`)
* `End call` (token: `END`)
```
[sub-scope call] [function call]
| |
__________ ____________
event.information = [ "Scope name", "attribute name", ("Scope name" | "attribute name" | "input/output") ]
______________
|
[sub-scope input var definition]
```
### Structured log events
```
<structured_events> := <events>+
<events> := <fun_call> [DONE]
| <subscope_call> [DONE]
| <var_def> [DONE]
| <var_def_with_fun> [DONE]
<fun_call> :=
<fun_call_beg>
VAR_DEF (function input)
<events>*
(<var_def> | <var_def_with_fun>) (function output)
END
<var_def_with_fun> :=
/-- POS
pos of | <fun_call>+ (function calls needed to compute the variable value)
\-> VAR_DEF
<subscope_call> :=
<sub_var_def>* (sub-scope attributes def)
<sub_call_beg>
<events>+
END
<var_def> := POS VAR_DEF (when VAR_DEF.information.length = 2)
<sub_var_def> := POS VAR_DEF (when VAR_DEF.information.length = 3)
<fun_call_beg> := BEG (when BEG.information.length = 2)
<sub_call_beg> := BEG (when BEG.information.length = 3)
```