Commit 89d6447c authored by POTTIER Francois's avatar POTTIER Francois

Avoid exposing [Stretch] in the .cmly API.

Also, expose attributes under a more abstract form.
parent 957d3cbd
* avoid exposing Keyword and Stretch in MenhirSdk? what about Positions and IL?
* avoid exposing Keyword in MenhirSdk? what about Positions and IL?
* Document the recent additions (CHANGES + doc).
- attributes in .mly files
......
......@@ -26,25 +26,9 @@ end)
(* ------------------------------------------------------------------------ *)
(* Auxiliary functions. *)
let newline () =
printf "\n"
let is_attribute name (name', _payload : attribute) =
name = Positions.value name'
let payload (_, payload : attribute) : string =
payload.Stretch.stretch_raw_content
let string_of_type = function
| Stretch.Inferred s -> s
| Stretch.Declared s -> s.Stretch.stretch_raw_content
(* ------------------------------------------------------------------------ *)
(* All names which refer to Menhir's inspection API are qualified with this
module name. *)
module name. We do not [open] this module because that might hide some
names exploited by the user within attributes. *)
let menhir =
"MenhirInterpreter"
......@@ -61,10 +45,10 @@ let module_name =
|> String.capitalize_ascii
let header () =
printf "open %s\n" module_name;
printf "open %s\n\n" module_name;
List.iter (fun attr ->
if is_attribute "header" attr then
printf "%s\n" (payload attr)
if Attribute.has_label "header" attr then
printf "%s\n" (Attribute.payload attr)
) Grammar.attributes
(* ------------------------------------------------------------------------ *)
......@@ -74,8 +58,8 @@ let header () =
let name default attrs =
try
let attr = List.find (is_attribute "name") attrs in
payload attr
let attr = List.find (Attribute.has_label "name") attrs in
Attribute.payload attr
with Not_found ->
sprintf "%S" default
......@@ -104,7 +88,8 @@ let print_symbol () =
(name (Nonterminal.name n) (Nonterminal.attributes n))
| `START ->
()
)
);
printf "\n"
(* ------------------------------------------------------------------------ *)
......@@ -115,8 +100,8 @@ let print_symbol () =
let printer default attrs =
try
let attr = List.find (is_attribute "printer") attrs in
sprintf "(%s)" (payload attr)
let attr = List.find (Attribute.has_label "printer") attrs in
sprintf "(%s)" (Attribute.payload attr)
with Not_found ->
sprintf "(fun _ -> %s)" (name default attrs)
......@@ -147,7 +132,8 @@ let print_value () =
(printer (Nonterminal.name n) (Nonterminal.attributes n))
| `START ->
()
)
);
printf "\n"
(* [print_token()] generates code for a [print_token] function, which
converts a token to a string. The type of the token is [token].
......@@ -173,7 +159,8 @@ let print_token () =
value
| `ERROR | `PSEUDO | `EOF ->
()
)
);
printf "\n"
(* ------------------------------------------------------------------------ *)
......@@ -181,9 +168,6 @@ let print_token () =
let () =
header();
newline();
print_symbol();
newline();
print_value();
newline();
print_token()
......@@ -26,26 +26,29 @@ module type GRAMMAR = sig
type lr0 = private int
type lr1 = private int
type item = production * int
type ocamltype = string
type attribute =
string Positions.located * Stretch.t
type attributes =
attribute list
module Attribute : sig
type t
val label : t -> string
val has_label : string -> t -> bool
val payload : t -> string
val position : t -> Positions.t
end
module Grammar : sig
val basename : string
val entry_points : (production * lr1) list
val attributes : attributes
val parameters : Stretch.t list
val attributes : Attribute.t list
val parameters : string list (* %parameter declarations *)
end
module Terminal : sig
include INDEXED with type t = terminal
val name : t -> string
val kind : t -> [`REGULAR | `ERROR | `EOF | `PSEUDO]
val typ : t -> Stretch.ocamltype option
val attributes : t -> attributes
val typ : t -> ocamltype option
val attributes : t -> Attribute.t list
end
module Nonterminal : sig
......@@ -53,11 +56,11 @@ module type GRAMMAR = sig
val name : t -> string
val mangled_name : t -> string
val kind : t -> [`REGULAR | `START]
val typ : t -> Stretch.ocamltype option
val typ : t -> ocamltype option
val positions : t -> Positions.t list
val is_nullable : t -> bool
val nullable : t -> bool
val first : t -> terminal list
val attributes : t -> attributes
val attributes : t -> Attribute.t list
end
type symbol =
......@@ -79,10 +82,10 @@ module type GRAMMAR = sig
include INDEXED with type t = production
val kind : t -> [`REGULAR | `START]
val lhs : t -> nonterminal
val rhs : t -> (symbol * identifier * attributes) array
val rhs : t -> (symbol * identifier * Attribute.t list) array
val positions : t -> Positions.t list
val action : t -> Action.t option
val attributes : t -> attributes
val attributes : t -> Attribute.t list
end
module Lr0 : sig
......
......@@ -15,8 +15,13 @@ type production = int
type lr0 = int
type lr1 = int
type attribute =
string Positions.located * Stretch.t
type ocamltype = string
type attribute = {
a_label: string;
a_payload: string;
a_position: Positions.t;
}
type attributes =
attribute list
......@@ -24,7 +29,7 @@ type attributes =
type terminal_def = {
t_name: string;
t_kind: [`REGULAR | `ERROR | `EOF | `PSEUDO];
t_type: Stretch.ocamltype option;
t_type: ocamltype option;
t_attributes: attributes;
}
......@@ -32,9 +37,9 @@ type nonterminal_def = {
n_name: string;
n_kind: [`REGULAR | `START];
n_mangled_name: string;
n_type: Stretch.ocamltype option;
n_type: ocamltype option;
n_positions: Positions.t list;
n_is_nullable: bool;
n_nullable: bool;
n_first: terminal list;
n_attributes: attributes;
}
......@@ -83,5 +88,5 @@ type grammar = {
g_lr1_states : lr1_state_def array;
g_entry_points : (production * lr1) list;
g_attributes : attributes;
g_parameters : Stretch.t list;
g_parameters : string list;
}
......@@ -80,12 +80,26 @@ module Make (G : sig val grammar : grammar end) : GRAMMAR = struct
type lr0 = int
type lr1 = int
type item = production * int
type ocamltype = string
type attribute =
string Positions.located * Stretch.t
module Attribute = struct
type attributes =
attribute list
type t =
Cmly_format.attribute
let label attr =
attr.a_label
let has_label label attr =
label = attr.a_label
let payload attr =
attr.a_payload
let position attr =
attr.a_position
end
module Grammar = struct
let basename = grammar.g_basename
......@@ -113,7 +127,7 @@ module Make (G : sig val grammar : grammar end) : GRAMMAR = struct
let kind i = table.(i).n_kind
let typ i = table.(i).n_type
let positions i = table.(i).n_positions
let is_nullable i = table.(i).n_is_nullable
let nullable i = table.(i).n_nullable
let first i = table.(i).n_first
let attributes i = table.(i).n_attributes
include Index(struct
......
open Grammar
open Cmly_format
let raw_content stretch =
stretch.Stretch.stretch_raw_content
let ocamltype (typ : Stretch.ocamltype) : ocamltype =
match typ with
| Stretch.Declared stretch ->
raw_content stretch
| Stretch.Inferred typ ->
typ
let ocamltype (typo : Stretch.ocamltype option) : ocamltype option =
match typo with
| None ->
None
| Some typ ->
Some (ocamltype typ)
let attribute (label, payload : Syntax.attribute) : attribute =
{
a_label = Positions.value label;
a_payload = raw_content payload;
a_position = Positions.position label;
}
let attributes : Syntax.attributes -> attributes =
List.map attribute
let terminal (t : Terminal.t) : terminal_def =
{
t_kind = (
......@@ -17,8 +44,8 @@ let terminal (t : Terminal.t) : terminal_def =
`REGULAR
);
t_name = Terminal.print t;
t_type = Terminal.ocamltype t;
t_attributes = Terminal.attributes t;
t_type = ocamltype (Terminal.ocamltype t);
t_attributes = attributes (Terminal.attributes t);
}
let nonterminal (nt : Nonterminal.t) : nonterminal_def =
......@@ -27,11 +54,11 @@ let nonterminal (nt : Nonterminal.t) : nonterminal_def =
n_kind = if is_start then `START else `REGULAR;
n_name = Nonterminal.print false nt;
n_mangled_name = Nonterminal.print true nt;
n_type = if is_start then None else Nonterminal.ocamltype nt;
n_type = if is_start then None else ocamltype (Nonterminal.ocamltype nt);
n_positions = if is_start then [] else Nonterminal.positions nt;
n_is_nullable = Analysis.nullable nt;
n_nullable = Analysis.nullable nt;
n_first = List.map Terminal.t2i (TerminalSet.elements (Analysis.first nt));
n_attributes = if is_start then [] else Nonterminal.attributes nt;
n_attributes = if is_start then [] else attributes (Nonterminal.attributes nt);
}
let symbol (sym : Symbol.t) : symbol =
......@@ -53,8 +80,8 @@ let rhs (prod : Production.index) : producer_def array =
| None ->
Array.mapi (fun i sym ->
let id = (Production.identifiers prod).(i) in
let attributes = (Production.rhs_attributes prod).(i) in
symbol sym, id, attributes
let attrs = attributes (Production.rhs_attributes prod).(i) in
symbol sym, id, attrs
) (Production.rhs prod)
let production (prod : Production.index) : production_def =
......@@ -65,7 +92,7 @@ let production (prod : Production.index) : production_def =
p_positions = Production.positions prod;
p_action = if Production.is_start prod then None
else Some (action (Production.action prod));
p_attributes = Production.lhs_attributes prod;
p_attributes = attributes (Production.lhs_attributes prod);
}
let item (i : Item.t) : production * int =
......@@ -106,8 +133,8 @@ let encode () : grammar =
g_lr0_states = Array.init Lr0.n lr0_state;
g_lr1_states = Array.of_list (Lr1.map lr1_state);
g_entry_points = ProductionMap.fold entry_point Lr1.entry [];
g_attributes = Analysis.attributes;
g_parameters = Front.grammar.UnparameterizedSyntax.parameters;
g_attributes = attributes Analysis.attributes;
g_parameters = List.map raw_content Front.grammar.UnparameterizedSyntax.parameters;
}
let write oc t =
......
# This is the list of modules that must go into MenhirSdk.
Keyword
Positions
Stretch
IL
IO
Version
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment