Commit 998f3c5f authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan Committed by Xavier Leroy
Browse files

New parser based on new version of the Coq backend of Menhir (#276)

What's new:

1. A rewrite of the Coq interpreter of Menhir automaton, with
   dependent types removing the need for runtime checks for the
   well-formedness of the LR stack. This seem to cause some speedup on
   the parsing time (~10% for lexing + parsing).

2. Thanks to 1., it is now possible to avoid the use of int31 for
   comparing symbols: Since this is only used for validation,
   positives are enough.

3. Speedup of Validation: on my machine, the time needed for compiling
   Parser.v goes from about 2 minutes to about 1 minute. This seem to
   be related to a performance bug in the completeness validator and
   to the use of positive instead of int31.

3. Menhir now generates a dedicated inductive type for
   (semantic-value-carrying) tokens (in addition to the already
   existing inductive type for (non-semantic-value-carrying)
   terminals. The end result is that the OCaml support code for the
   parser no longer contain calls to Obj.magic. The bad side of this
   change is that the formal specification of the parser is perhaps
   harder to read.

4. The parser and its library are now free of axioms (I used to use
   axiom K and proof irrelevance for easing proofs involving dependent
   types).

5. Use of a dedicated custom negative coinductive type for the input
   stream of tokens, instead of Coq stdlib's `Stream`. `Stream` is a
   positive coinductive type, which are now deprecated by Coq.

6. The fuel of the parser is now specified using its logarithm instead
   of its actual value. This makes it possible to give large fuel
   values instead of using the `let rec fuel = S fuel` hack.

7. Some refactoring in the lexer, the parser and the Cabs syntax tree.

The corresponding changes in Menhir have been released as part of
version 20190626. The `MenhirLib` directory is identical to the
content of the `src` directory of the corresponding `coq-menhirlib`
opam package except that:
   - In order to try to make CompCert compatible with several Menhir
     versions without updates, we do not check the version of menhir
     is compatible with the version of coq-menhirlib. Hence the
     `Version.v` file is not present in CompCert's copy.
   - Build-system related files have been removed.
parent da929bc6
All files in this distribution are part of the CompCert verified compiler.
The CompCert verified compiler is Copyright by Institut National de
The CompCert verified compiler is Copyright by Institut National de
Recherche en Informatique et en Automatique (INRIA) and
AbsInt Angewandte Informatik GmbH.
......@@ -9,12 +9,12 @@ INRIA Non-Commercial License Agreement given below or under the terms
of a Software Usage Agreement of AbsInt Angewandte Informatik GmbH.
The latter is a separate contract document.
The INRIA Non-Commercial License Agreement is a non-free license that
grants you the right to use the CompCert verified compiler for
educational, research or evaluation purposes only, but prohibits
The INRIA Non-Commercial License Agreement is a non-free license that
grants you the right to use the CompCert verified compiler for
educational, research or evaluation purposes only, but prohibits
any commercial use.
For commercial use you need a Software Usage Agreement from
For commercial use you need a Software Usage Agreement from
AbsInt Angewandte Informatik GmbH.
The following files in this distribution are dual-licensed both under
......@@ -38,7 +38,7 @@ option) any later version:
cfrontend/Ctyping.v
cfrontend/PrintClight.ml
cfrontend/PrintCsyntax.ml
backend/Cminor.v
backend/PrintCminor.ml
......@@ -46,7 +46,7 @@ option) any later version:
all files in the exportclight/ directory
the Archi.v, CBuiltins.ml, and extractionMachdep.v files
the Archi.v, CBuiltins.ml, and extractionMachdep.v files
in directories arm, powerpc, riscV, x86, x86_32, x86_64
extraction/extraction.v
......@@ -64,11 +64,14 @@ non-commercial contexts, subject to the terms of the GNU General
Public License.
The files contained in the flocq/ directory and its subdirectories are
taken from the Flocq project, http://flocq.gforge.inria.fr/
These files are Copyright 2010-2017 INRIA and distributed under the
terms of the GNU Lesser General Public Licence, either version 3 of
the licence, or (at your option) any later version. A copy of the GNU
Lesser General Public Licence version 3 is included below.
taken from the Flocq project, http://flocq.gforge.inria.fr/. The files
contained in the MenhirLib directory are taken from the Menhir
project, http://gallium.inria.fr/~fpottier/menhir/. The files from the
Flocq project and the files in the MenhirLib directory are Copyright
2010-2019 INRIA and distributed under the terms of the GNU Lesser
General Public Licence, either version 3 of the licence, or (at your
option) any later version. A copy of the GNU Lesser General Public
Licence version 3 is included below.
The files contained in the runtime/ directory and its subdirectories
are Copyright 2013-2017 INRIA and distributed under the terms of the BSD
......
......@@ -23,9 +23,10 @@ endif
DIRS=lib common $(ARCHDIRS) backend cfrontend driver \
flocq/Core flocq/Prop flocq/Calc flocq/IEEE754 \
exportclight cparser cparser/MenhirLib
exportclight MenhirLib cparser
RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight cparser
RECDIRS=lib common $(ARCHDIRS) backend cfrontend driver flocq exportclight \
MenhirLib cparser
COQINCLUDES=$(foreach d, $(RECDIRS), -R $(d) compcert.$(d))
......@@ -103,16 +104,16 @@ CFRONTEND=Ctypes.v Cop.v Csyntax.v Csem.v Ctyping.v Cstrategy.v Cexec.v \
Cshmgen.v Cshmgenproof.v \
Csharpminor.v Cminorgen.v Cminorgenproof.v
# LR(1) parser validator
PARSERVALIDATOR=Alphabet.v Interpreter_complete.v Interpreter.v \
Validator_complete.v Automaton.v Interpreter_correct.v Main.v \
Validator_safe.v Grammar.v Interpreter_safe.v Tuples.v
# Parser
PARSER=Cabs.v Parser.v
# MenhirLib
MENHIRLIB=Alphabet.v Automaton.v Grammar.v Interpreter_complete.v \
Interpreter_correct.v Interpreter.v Main.v Validator_complete.v \
Validator_safe.v Validator_classes.v
# Putting everything together (in driver/)
DRIVER=Compopts.v Compiler.v Complements.v
......@@ -120,7 +121,7 @@ DRIVER=Compopts.v Compiler.v Complements.v
# All source files
FILES=$(VLIB) $(COMMON) $(BACKEND) $(CFRONTEND) $(DRIVER) $(FLOCQ) \
$(PARSERVALIDATOR) $(PARSER)
$(MENHIRLIB) $(PARSER)
# Generated source files
......@@ -141,7 +142,6 @@ ifeq ($(CLIGHTGEN),true)
$(MAKE) clightgen
endif
proof: $(FILES:.v=.vo)
# Turn off some warnings for compiling Flocq
......@@ -225,7 +225,7 @@ driver/Version.ml: VERSION
cparser/Parser.v: cparser/Parser.vy
@rm -f $@
$(MENHIR) $(MENHIR_FLAGS) --coq cparser/Parser.vy
$(MENHIR) --coq --coq-lib-path compcert.MenhirLib --coq-no-version-check cparser/Parser.vy
@chmod a-w $@
depend: $(GENERATED) depend1
......
......@@ -50,8 +50,8 @@ INCLUDES=$(patsubst %,-I %, $(DIRS))
# Control of warnings:
WARNINGS=-w +a-4-9-27 -strict-sequence -safe-string -warn-error +a #Deprication returns with ocaml 4.03
extraction/%.cmx: WARNINGS +=-w -20-27-32..34-39-41-44..45
extraction/%.cmo: WARNINGS +=-w -20-27-32..34-39-41-44..45
extraction/%.cmx: WARNINGS +=-w -20-27-32..34-39-41-44..45-60
extraction/%.cmo: WARNINGS +=-w -20-27-32..34-39-41-44..45-60
cparser/pre_parser.cmx: WARNINGS += -w -41
cparser/pre_parser.cmo: WARNINGS += -w -41
......
(* *********************************************************************)
(* *)
(* The Compcert verified compiler *)
(* *)
(* Jacques-Henri Jourdan, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright Institut National de Recherche en Informatique et en *)
(* Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation, either version 2 of the License, or *)
(* (at your option) any later version. This file is also distributed *)
(* under the terms of the INRIA Non-Commercial License Agreement. *)
(* *)
(* *********************************************************************)
Require Import Int31.
Require Import Cyclic31.
Require Import Omega.
Require Import List.
Require Import Syntax.
Require Import Relations.
Require Import RelationClasses.
(****************************************************************************)
(* *)
(* Menhir *)
(* *)
(* Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud *)
(* *)
(* Copyright Inria. All rights reserved. This file is distributed under *)
(* the terms of the GNU Lesser General Public License as published by the *)
(* Free Software Foundation, either version 3 of the License, or (at your *)
(* option) any later version, as described in the file LICENSE. *)
(* *)
(****************************************************************************)
From Coq Require Import Omega List Syntax Relations RelationClasses.
Local Obligation Tactic := intros.
......@@ -119,8 +111,8 @@ try assumption.
apply (compare_trans _ _ _ _ H H0).
Qed.
(** Special case of comparable, where equality is usual equality. **)
Class ComparableUsualEq {A:Type} (C: Comparable A) :=
(** Special case of comparable, where equality is Leibniz equality. **)
Class ComparableLeibnizEq {A:Type} (C: Comparable A) :=
compare_eq : forall x y, compare x y = Eq -> x = y.
(** Boolean equality for a [Comparable]. **)
......@@ -130,7 +122,7 @@ Definition compare_eqb {A:Type} {C:Comparable A} (x y:A) :=
| _ => false
end.
Theorem compare_eqb_iff {A:Type} {C:Comparable A} {U:ComparableUsualEq C} :
Theorem compare_eqb_iff {A:Type} {C:Comparable A} {U:ComparableLeibnizEq C} :
forall x y, compare_eqb x y = true <-> x = y.
Proof.
unfold compare_eqb.
......@@ -141,21 +133,13 @@ destruct H.
rewrite compare_refl; intuition.
Qed.
(** [Comparable] provides a decidable equality. **)
Definition compare_eqdec {A:Type} {C:Comparable A} {U:ComparableUsualEq C} (x y:A):
{x = y} + {x <> y}.
Proof.
destruct (compare x y) as [] eqn:?; [left; apply compare_eq; intuition | ..];
right; intro; destruct H; rewrite compare_refl in Heqc; discriminate.
Defined.
Instance NComparableLeibnizEq : ComparableLeibnizEq natComparable := Nat.compare_eq.
Instance NComparableUsualEq : ComparableUsualEq natComparable := Nat.compare_eq.
(** A pair of ComparableUsualEq is ComparableUsualEq **)
Instance PairComparableUsualEq
{A:Type} {CA:Comparable A} (UA:ComparableUsualEq CA)
{B:Type} {CB:Comparable B} (UB:ComparableUsualEq CB) :
ComparableUsualEq (PairComparable CA CB).
(** A pair of ComparableLeibnizEq is ComparableLeibnizEq **)
Instance PairComparableLeibnizEq
{A:Type} {CA:Comparable A} (UA:ComparableLeibnizEq CA)
{B:Type} {CB:Comparable B} (UB:ComparableLeibnizEq CB) :
ComparableLeibnizEq (PairComparable CA CB).
Proof.
intros x y; destruct x, y; simpl.
pose proof (compare_eq a a0); pose proof (compare_eq b b0).
......@@ -171,123 +155,66 @@ Class Finite (A:Type) := {
all_list_forall : forall x:A, In x all_list
}.
(** An alphabet is both [ComparableUsualEq] and [Finite]. **)
(** An alphabet is both [ComparableLeibnizEq] and [Finite]. **)
Class Alphabet (A:Type) := {
AlphabetComparable :> Comparable A;
AlphabetComparableUsualEq :> ComparableUsualEq AlphabetComparable;
AlphabetComparableLeibnizEq :> ComparableLeibnizEq AlphabetComparable;
AlphabetFinite :> Finite A
}.
(** The [Numbered] class provides a conveniant way to build [Alphabet] instances,
with a good computationnal complexity. It is mainly a injection from it to
[Int31] **)
[positive] **)
Class Numbered (A:Type) := {
inj : A -> int31;
surj : int31 -> A;
inj : A -> positive;
surj : positive -> A;
surj_inj_compat : forall x, surj (inj x) = x;
inj_bound : int31;
inj_bound_spec : forall x, (phi (inj x) < phi inj_bound)%Z
inj_bound : positive;
inj_bound_spec : forall x, (inj x < Pos.succ inj_bound)%positive
}.
Program Instance NumberedAlphabet {A:Type} (N:Numbered A) : Alphabet A :=
{ AlphabetComparable :=
{| compare := fun x y => compare31 (inj x) (inj y) |};
{ AlphabetComparable := {| compare := fun x y => Pos.compare (inj x) (inj y) |};
AlphabetFinite :=
{| all_list := fst (iter_int31 inj_bound _
(fun p => (cons (surj (snd p)) (fst p), incr (snd p))) ([], 0%int31)) |} }.
Next Obligation. apply Zcompare_antisym. Qed.
Next Obligation.
destruct c. unfold compare31 in *.
rewrite Z.compare_eq_iff in *. congruence.
eapply Zcompare_Lt_trans. apply H. apply H0.
eapply Zcompare_Gt_trans. apply H. apply H0.
Qed.
Next Obligation.
intros x y H. unfold compare, compare31 in H.
rewrite Z.compare_eq_iff in *.
rewrite <- surj_inj_compat, <- phi_inv_phi with (inj y), <- H.
rewrite phi_inv_phi, surj_inj_compat; reflexivity.
Qed.
{| all_list := fst (Pos.iter
(fun '(l, p) => (surj p::l, Pos.succ p))
([], 1%positive) inj_bound) |} }.
Next Obligation. simpl. now rewrite <- Pos.compare_antisym. Qed.
Next Obligation.
rewrite iter_int31_iter_nat.
pose proof (inj_bound_spec x).
match goal with |- In x (fst ?p) => destruct p as [] eqn:? end.
replace inj_bound with i in H.
revert l i Heqp x H.
induction (Z.abs_nat (phi inj_bound)); intros.
inversion Heqp; clear Heqp; subst.
rewrite spec_0 in H. pose proof (phi_bounded (inj x)). omega.
simpl in Heqp.
destruct nat_rect; specialize (IHn _ _ (eq_refl _) x); simpl in *.
inversion Heqp. subst. clear Heqp.
rewrite phi_incr in H.
pose proof (phi_bounded i0).
pose proof (phi_bounded (inj x)).
destruct (Z_lt_le_dec (Z.succ (phi i0)) (2 ^ Z.of_nat size)%Z).
rewrite Zmod_small in H by omega.
apply Zlt_succ_le, Zle_lt_or_eq in H.
destruct H; simpl; auto. left.
rewrite <- surj_inj_compat, <- phi_inv_phi with (inj x), H, phi_inv_phi; reflexivity.
replace (Z.succ (phi i0)) with (2 ^ Z.of_nat size)%Z in H by omega.
rewrite Z_mod_same_full in H.
exfalso; omega.
rewrite <- phi_inv_phi with i, <- phi_inv_phi with inj_bound; f_equal.
pose proof (phi_bounded inj_bound); pose proof (phi_bounded i).
rewrite <- Z.abs_eq with (phi i), <- Z.abs_eq with (phi inj_bound) by omega.
clear H H0 H1.
do 2 rewrite <- Zabs2Nat.id_abs.
f_equal.
revert l i Heqp.
assert (Z.abs_nat (phi inj_bound) < Z.abs_nat (2^31)).
apply Zabs_nat_lt, phi_bounded.
induction (Z.abs_nat (phi inj_bound)); intros.
inversion Heqp; reflexivity.
inversion Heqp; clear H1 H2 Heqp.
match goal with |- _ (_ (_ (snd ?p))) = _ => destruct p end.
pose proof (phi_bounded i0).
erewrite <- IHn, <- Zabs2Nat.inj_succ in H |- *; eauto; try omega.
rewrite phi_incr, Zmod_small; intuition; try omega.
apply inj_lt in H.
pose proof Z.le_le_succ_r.
do 2 rewrite Zabs2Nat.id_abs, Z.abs_eq in H; now eauto.
match goal with c : comparison |- _ => destruct c end.
- rewrite Pos.compare_eq_iff in *. congruence.
- rewrite Pos.compare_lt_iff in *. eauto using Pos.lt_trans.
- rewrite Pos.compare_gt_iff in *. eauto using Pos.lt_trans.
Qed.
(** Previous class instances for [option A] **)
Program Instance OptionComparable {A:Type} (C:Comparable A) : Comparable (option A) :=
{ compare := fun x y =>
match x, y return comparison with
| None, None => Eq
| None, Some _ => Lt
| Some _, None => Gt
| Some x, Some y => compare x y
end }.
Next Obligation.
destruct x, y; intuition.
apply compare_antisym.
Qed.
intros x y. unfold compare. intros Hxy.
assert (Hxy' : inj x = inj y).
(* We do not use [Pos.compare_eq_iff] directly to make sure the
proof is executable. *)
{ destruct (Pos.eq_dec (inj x) (inj y)) as [|[]]; [now auto|].
now apply Pos.compare_eq_iff. }
(* Using rewrite here leads to non-executable proofs. *)
transitivity (surj (inj x)).
{ apply eq_sym, surj_inj_compat. }
transitivity (surj (inj y)); cycle 1.
{ apply surj_inj_compat. }
apply f_equal, Hxy'.
Defined.
Next Obligation.
destruct x, y, z; try now intuition;
try (rewrite <- H in H0; discriminate).
apply (compare_trans _ _ _ _ H H0).
Qed.
Instance OptionComparableUsualEq {A:Type} {C:Comparable A} (U:ComparableUsualEq C) :
ComparableUsualEq (OptionComparable C).
Proof.
intros x y.
destruct x, y; intuition; try discriminate.
rewrite (compare_eq a a0); intuition.
rewrite <-(surj_inj_compat x).
generalize (inj_bound_spec x). generalize (inj x). clear x. intros x.
match goal with |- ?Hx -> In ?s (fst ?p) =>
assert ((Hx -> In s (fst p)) /\ snd p = Pos.succ inj_bound); [|now intuition] end.
rewrite Pos.lt_succ_r.
induction inj_bound as [|y [IH1 IH2]] using Pos.peano_ind;
(split; [intros Hx|]); simpl.
- rewrite (Pos.le_antisym _ _ Hx); auto using Pos.le_1_l.
- auto.
- rewrite Pos.iter_succ. destruct Pos.iter; simpl in *. subst.
rewrite Pos.le_lteq in Hx. destruct Hx as [?%Pos.lt_succ_r| ->]; now auto.
- rewrite Pos.iter_succ. destruct Pos.iter. simpl in IH2. subst. reflexivity.
Qed.
Program Instance OptionFinite {A:Type} (E:Finite A) : Finite (option A) :=
{ all_list := None :: map Some all_list }.
Next Obligation.
destruct x; intuition.
right.
apply in_map.
apply all_list_forall.
Defined.
(** Definitions of [FSet]/[FMap] from [Comparable] **)
Require Import OrderedTypeAlt.
Require FSetAVL.
......
(* *********************************************************************)
(* *)
(* The Compcert verified compiler *)
(* *)
(* Jacques-Henri Jourdan, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright Institut National de Recherche en Informatique et en *)
(* Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation, either version 2 of the License, or *)
(* (at your option) any later version. This file is also distributed *)
(* under the terms of the INRIA Non-Commercial License Agreement. *)
(* *)
(* *********************************************************************)
(****************************************************************************)
(* *)
(* Menhir *)
(* *)
(* Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud *)
(* *)
(* Copyright Inria. All rights reserved. This file is distributed under *)
(* the terms of the GNU Lesser General Public License as published by the *)
(* Free Software Foundation, either version 3 of the License, or (at your *)
(* option) any later version, as described in the file LICENSE. *)
(* *)
(****************************************************************************)
Require Grammar.
Require Import Orders.
Require Export Alphabet.
Require Export List.
Require Export Syntax.
From Coq Require Import Orders.
From Coq Require Export List Syntax.
Module Type AutInit.
(** The grammar of the automaton. **)
......
(* *********************************************************************)
(* *)
(* The Compcert verified compiler *)
(* *)
(* Jacques-Henri Jourdan, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright Institut National de Recherche en Informatique et en *)
(* Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation, either version 2 of the License, or *)
(* (at your option) any later version. This file is also distributed *)
(* under the terms of the INRIA Non-Commercial License Agreement. *)
(* *)
(* *********************************************************************)
Require Import List.
Require Import Syntax.
(****************************************************************************)
(* *)
(* Menhir *)
(* *)
(* Jacques-Henri Jourdan, CNRS, LRI, Université Paris Sud *)
(* *)
(* Copyright Inria. All rights reserved. This file is distributed under *)
(* the terms of the GNU Lesser General Public License as published by the *)
(* Free Software Foundation, either version 3 of the License, or (at your *)
(* option) any later version, as described in the file LICENSE. *)
(* *)
(****************************************************************************)
From Coq Require Import List Syntax Orders.
Require Import Alphabet.
Require Import Orders.
Require Tuples.
(** The terminal non-terminal alphabets of the grammar. **)
Module Type Alphs.
......@@ -45,29 +40,31 @@ Module Symbol(Import A:Alphs).
AlphabetFinite := {| all_list :=
map T all_list++map NT all_list |} }.
Next Obligation.
destruct x; destruct y; intuition; apply compare_antisym.
destruct x; destruct y; intuition; apply compare_antisym.
Qed.
Next Obligation.
destruct x; destruct y; destruct z; intuition; try discriminate.
apply (compare_trans _ t0); intuition.
apply (compare_trans _ n0); intuition.
destruct x; destruct y; destruct z; intuition; try discriminate.
apply (compare_trans _ t0); intuition.
apply (compare_trans _ n0); intuition.
Qed.
Next Obligation.
intros x y.
destruct x; destruct y; try discriminate; intros.
rewrite (compare_eq t t0); intuition.
rewrite (compare_eq n n0); intuition.
Qed.
intros x y.
destruct x; destruct y; try discriminate; intros.
rewrite (compare_eq t t0); now intuition.
rewrite (compare_eq n n0); now intuition.
Defined.
Next Obligation.
rewrite in_app_iff.
destruct x; [left | right]; apply in_map; apply all_list_forall.
rewrite in_app_iff.
destruct x; [left | right]; apply in_map; apply all_list_forall.
Qed.
End Symbol.
Module Type T.
Export Tuples.
(** A curryfied function with multiple parameters **)
Definition arrows_right: Type -> list Type -> Type :=
fold_right (fun A B => A -> B).
Module Type T.
Include Alphs <+ Symbol.
(** [symbol_semantic_type] maps a symbols to the type of its semantic
......@@ -82,85 +79,84 @@ Module Type T.
and semantic action. The semantic actions are given in the form
of curryfied functions, that take arguments in the reverse order. **)
Parameter prod_lhs: production -> nonterminal.
(* The RHS of a production is given in reversed order, so that symbols *)
Parameter prod_rhs_rev: production -> list symbol.
Parameter prod_action:
forall p:production,
arrows_left
(map symbol_semantic_type (rev (prod_rhs_rev p)))
(symbol_semantic_type (NT (prod_lhs p))).
arrows_right
(symbol_semantic_type (NT (prod_lhs p)))
(map symbol_semantic_type (prod_rhs_rev p)).
(** Tokens are the atomic elements of the input stream: they contain
a terminal and a semantic value of the type corresponding to this
terminal. *)
Parameter token : Type.
Parameter token_term : token -> terminal.
Parameter token_sem :
forall tok : token, symbol_semantic_type (T (token_term tok)).
End T.
Module Defs(Import G:T).
(** A token is a terminal and a semantic value for this terminal. **)
Definition token := {t:terminal & symbol_semantic_type (T t)}.
(** The semantics of a grammar is defined in two stages. First, we
define the notion of parse tree, which represents one way of
recognizing a word with a head symbol. Semantic values are stored
at the leaves.
(** A grammar creates a relation between word of tokens and semantic values.
This relation is parametrized by the head symbol. It defines the
"semantics" of the grammar. This relation is defined by a notion of
parse tree. **)
This notion is defined in two mutually recursive flavours:
either for a single head symbol, or for a list of head symbols. *)
Inductive parse_tree:
forall (head_symbol:symbol) (word:list token)
(semantic_value:symbol_semantic_type head_symbol), Type :=
forall (head_symbol:symbol) (word:list token), Type :=
(** A single token has its semantic value as semantic value, for the
corresponding terminal as head symbol. **)
(** Parse tree for a terminal symbol. *)
| Terminal_pt:
forall (t:terminal) (sem:symbol_semantic_type (T t)),
parse_tree (T t)
[existT (fun t => symbol_semantic_type (T t)) t sem] sem
(** Given a production, if a word has a list of semantic values for the
right hand side as head symbols, then this word has the semantic value
given by the semantic action of the production for the left hand side
as head symbol.**)
forall (tok:token), parse_tree (T (token_term tok)) [tok]
(** Parse tree for a non-terminal symbol. *)
| Non_terminal_pt:
forall {p:production} {word:list token}
{semantic_values:tuple (map symbol_semantic_type (rev (prod_rhs_rev p)))},
parse_tree_list (rev (prod_rhs_rev p)) word semantic_values ->
parse_tree (NT (prod_lhs p)) word (uncurry (prod_action p) semantic_values)
(** Basically the same relation as before, but for list of head symbols (ie.
We are building a forest of syntax trees. It is mutually recursive with the
previous relation **)
forall (prod:production) {word:list token},
parse_tree_list (prod_rhs_rev prod) word ->
parse_tree (NT (prod_lhs prod)) word
(* Note : the list head_symbols_rev is reversed. *)
with parse_tree_list:
forall (head_symbols:list symbol) (word:list token)
(semantic_values:tuple (map symbol_semantic_type head_symbols)),
Type :=
forall (head_symbols_rev:list symbol) (word:list token), Type :=
(** The empty word has [()] as semantic for [[]] as head symbols list **)
| Nil_ptl: parse_tree_list [] [] ()
| Nil_ptl: parse_tree_list [] []
(** The cons of the semantic value for one head symbol and for a list of head
symbols **)
| Cons_ptl:
(** The semantic for the head **)