Commit 16d4beeb authored by POTTIER Francois's avatar POTTIER Francois

Coq sources, Makefiles, opam package configuration.

parents
# -------------------------------------------------------------------------
# Private Makefile for package maintenance.
SHELL := bash
export CDPATH=
.PHONY: package export opam submit pin unpin
# -------------------------------------------------------------------------
include Makefile
# -------------------------------------------------------------------------
# Distribution.
# The version number is automatically set to the current date,
# unless DATE is defined on the command line.
DATE := $(shell /bin/date +%Y%m%d)
# The project name on gitlab.
PROJECT := coq-menhirlib
# The opam package name.
PACKAGE := coq-menhirlib
# The repository URL (https).
REPO := https://gitlab.inria.fr/fpottier/$(PROJECT)
# The archive URL (https).
ARCHIVE := $(REPO)/repository/$(DATE)/archive.tar.gz
# The local repository directory.
PWD := $(shell pwd)
# -------------------------------------------------------------------------
# Prepare a release.
package:
# Make sure the correct version can be installed.
@ make uninstall
@ make install
# -------------------------------------------------------------------------
# Publish a release. (Remember to commit everything first!)
export:
# Check if everything has been committed.
@ if [ -n "$$(git status --porcelain)" ] ; then \
echo "Error: there remain uncommitted changes." ; \
git status ; \
exit 1 ; \
else \
echo "Now making a release..." ; \
fi
# Create a git tag.
@ git tag -a $(DATE) -m "Release $(DATE)."
# Upload. (This automatically makes a .tar.gz archive available on gitlab.)
@ git push
@ git push --tags
# -------------------------------------------------------------------------
# Updating the opam package.
# This entry assumes that "make package" and "make export"
# have just been run (on the same day).
# You need opam-publish:
# sudo apt-get install libssl-dev
# opam install tls opam-publish
# In fact, you need a version of opam-publish that supports --subdirectory:
# git clone git@github.com:fpottier/opam-publish.git
# cd opam-publish
# git checkout 1.3
# opam pin add opam-publish `pwd` -k git
# The following command should have been run once:
# opam-publish repo add opam-coq-archive coq/opam-coq-archive
PUBLISH_OPTIONS := \
--repo opam-coq-archive \
--subdirectory released \
opam:
@ opam lint
@ opam-publish prepare $(PUBLISH_OPTIONS) $(PACKAGE).$(DATE) $(ARCHIVE)
submit:
@ opam-publish submit $(PUBLISH_OPTIONS) $(PACKAGE).$(DATE)
# -------------------------------------------------------------------------
# Pinning.
pin:
opam pin add $(PACKAGE) `pwd` -k git
unpin:
opam pin remove $(PACKAGE)
# Delegate the following commands:
.PHONY: all clean install uninstall
all clean install uninstall:
@ $(MAKE) -C src --no-print-directory $@
name: "coq-menhirlib"
opam-version: "1.2"
maintainer: "francois.pottier@inria.fr"
authors: [
"Jacques-Henri Jourdan <jacques-henri.jourdan@lri.fr>"
]
homepage: "https://gitlab.inria.fr/fpottier/coq-menhirlib"
dev-repo: "https://gitlab.inria.fr/fpottier/coq-menhirlib.git"
bug-reports: "jacques-henri.jourdan@lri.fr"
build: [
[make "-j%{jobs}%"]
]
install: [
[make "install"]
]
remove: [
[make "uninstall"]
]
depends: [
"coq" { >= "8.6" }
]
*.vo
*.glob
*.v.d
.*.aux
_CoqProject
This diff is collapsed.
(* *********************************************************************)
(* *)
(* 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. *)
(* *)
(* *********************************************************************)
From MenhirLib Require Grammar.
From MenhirLib Require Export Alphabet.
From Coq Require Import Orders.
From Coq Require Export List Syntax.
Module Type AutInit.
(** The grammar of the automaton. **)
Declare Module Gram:Grammar.T.
Export Gram.
(** The set of non initial state is considered as an alphabet. **)
Parameter noninitstate : Type.
Declare Instance NonInitStateAlph : Alphabet noninitstate.
Parameter initstate : Type.
Declare Instance InitStateAlph : Alphabet initstate.
(** When we are at this state, we know that this symbol is the top of the
stack. **)
Parameter last_symb_of_non_init_state: noninitstate -> symbol.
End AutInit.
Module Types(Import Init:AutInit).
(** In many ways, the behaviour of the initial state is different from the
behaviour of the other states. So we have chosen to explicitaly separate
them: the user has to provide the type of non initial states. **)
Inductive state :=
| Init: initstate -> state
| Ninit: noninitstate -> state.
Program Instance StateAlph : Alphabet state :=
{ AlphabetComparable := {| compare := fun x y =>
match x, y return comparison with
| Init _, Ninit _ => Lt
| Init x, Init y => compare x y
| Ninit _, Init _ => Gt
| Ninit x, Ninit y => compare x y
end |};
AlphabetFinite := {| all_list := map Init all_list ++ map Ninit all_list |} }.
Local Obligation Tactic := intros.
Next Obligation.
destruct x, y; intuition; apply compare_antisym.
Qed.
Next Obligation.
destruct x, y, z; intuition.
apply (compare_trans _ i0); intuition.
congruence.
congruence.
apply (compare_trans _ n0); intuition.
Qed.
Next Obligation.
intros x y.
destruct x, y; intuition; try discriminate.
rewrite (compare_eq i i0); intuition.
rewrite (compare_eq n n0); intuition.
Qed.
Next Obligation.
apply in_or_app; destruct x; intuition;
[left|right]; apply in_map; apply all_list_forall.
Qed.
Coercion Ninit : noninitstate >-> state.
Coercion Init : initstate >-> state.
(** For an LR automaton, there are four kind of actions that can be done at a
given state:
- Shifting, that is reading a token and putting it into the stack,
- Reducing a production, that is popping the right hand side of the
production from the stack, and pushing the left hand side,
- Failing
- Accepting the word (special case of reduction)
As in the menhir parser generator, we do not want our parser to read after
the end of stream. That means that once the parser has read a word in the
grammar language, it should stop without peeking the input stream. So, for
the automaton to be complete, the grammar must be particular: if a word is
in its language, then it is not a prefix of an other word of the language
(otherwise, menhir reports an end of stream conflict).
As a consequence of that, there is two notions of action: the first one is
an action performed before having read the stream, the second one is after
**)
Inductive lookahead_action (term:terminal) :=
| Shift_act: forall s:noninitstate,
T term = last_symb_of_non_init_state s -> lookahead_action term
| Reduce_act: production -> lookahead_action term
| Fail_act: lookahead_action term.
Arguments Shift_act [term].
Arguments Reduce_act [term].
Arguments Fail_act [term].
Inductive action :=
| Default_reduce_act: production -> action
| Lookahead_act : (forall term:terminal, lookahead_action term) -> action.
(** Types used for the annotations of the automaton. **)
(** An item is a part of the annotations given to the validator.
It is acually a set of LR(1) items sharing the same core. It is needed
to validate completeness. **)
Record item := {
(** The pseudo-production of the item. **)
prod_item: production;
(** The position of the dot. **)
dot_pos_item: nat;
(** The lookahead symbol of the item. We are using a list, so we can store
together multiple LR(1) items sharing the same core. **)
lookaheads_item: list terminal
}.
End Types.
Module Type T.
Include AutInit <+ Types.
Module Export GramDefs := Grammar.Defs Gram.
(** For each initial state, the non terminal it recognizes. **)
Parameter start_nt: initstate -> nonterminal.
(** The action table maps a state to either a map terminal -> action. **)
Parameter action_table:
state -> action.
(** The goto table of an LR(1) automaton. **)
Parameter goto_table: state -> forall nt:nonterminal,
option { s:noninitstate | NT nt = last_symb_of_non_init_state s }.
(** Some annotations on the automaton to help the validation. **)
(** When we are at this state, we know that these symbols are just below
the top of the stack. The list is ordered such that the head correspond
to the (almost) top of the stack. **)
Parameter past_symb_of_non_init_state: noninitstate -> list symbol.
(** When we are at this state, the (strictly) previous states verify these
predicates. **)
Parameter past_state_of_non_init_state: noninitstate -> list (state -> bool).
(** The items of the state. **)
Parameter items_of_state: state -> list item.
(** The nullable predicate for non terminals :
true if and only if the symbol produces the empty string **)
Parameter nullable_nterm: nonterminal -> bool.
(** The first predicates for non terminals, symbols or words of symbols. A
terminal is in the returned list if, and only if the parameter produces a
word that begins with the given terminal **)
Parameter first_nterm: nonterminal -> list terminal.
End T.
(* *********************************************************************)
(* *)
(* 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. *)
(* *)
(* *********************************************************************)
From Coq Require Import List Syntax Orders.
From MenhirLib Require Import Alphabet Tuples.
(** The terminal non-terminal alphabets of the grammar. **)
Module Type Alphs.
Parameters terminal nonterminal : Type.
Declare Instance TerminalAlph: Alphabet terminal.
Declare Instance NonTerminalAlph: Alphabet nonterminal.
End Alphs.
(** Definition of the alphabet of symbols, given the alphabet of terminals
and the alphabet of non terminals **)
Module Symbol(Import A:Alphs).
Inductive symbol :=
| T: terminal -> symbol
| NT: nonterminal -> symbol.
Program Instance SymbolAlph : Alphabet symbol :=
{ AlphabetComparable := {| compare := fun x y =>
match x, y return comparison with
| T _, NT _ => Gt
| NT _, T _ => Lt
| T x, T y => compare x y
| NT x, NT y => compare x y
end |};
AlphabetFinite := {| all_list :=
map T all_list++map NT all_list |} }.
Next Obligation.
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.
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.
Next Obligation.
rewrite in_app_iff.
destruct x; [left | right]; apply in_map; apply all_list_forall.
Qed.
End Symbol.
Module Type T.
Export Tuples.
Include Alphs <+ Symbol.
(** [symbol_semantic_type] maps a symbols to the type of its semantic
values. **)
Parameter symbol_semantic_type: symbol -> Type.
(** The type of productions identifiers **)
Parameter production : Type.
Declare Instance ProductionAlph : Alphabet production.
(** Accessors for productions: left hand side, right hand side,
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.
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))).
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)}.
(** 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. **)
Inductive parse_tree:
forall (head_symbol:symbol) (word:list token)
(semantic_value:symbol_semantic_type head_symbol), Type :=
(** A single token has its semantic value as semantic value, for the
corresponding terminal as head 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.**)
| 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 **)
with parse_tree_list:
forall (head_symbols:list symbol) (word:list token)
(semantic_values:tuple (map symbol_semantic_type head_symbols)),
Type :=
(** The empty word has [()] as semantic for [[]] as head symbols 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 **)
forall {head_symbolt:symbol} {wordt:list token}
{semantic_valuet:symbol_semantic_type head_symbolt},
parse_tree head_symbolt wordt semantic_valuet ->
(** and the semantic for the tail **)
forall {head_symbolsq:list symbol} {wordq:list token}
{semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)},
parse_tree_list head_symbolsq wordq semantic_valuesq ->
(** give the semantic of the cons **)
parse_tree_list
(head_symbolt::head_symbolsq)
(wordt++wordq)
(semantic_valuet, semantic_valuesq).
Fixpoint pt_size {head_symbol word sem} (tree:parse_tree head_symbol word sem) :=
match tree with
| Terminal_pt _ _ => 1
| Non_terminal_pt l => S (ptl_size l)
end
with ptl_size {head_symbols word sems} (tree:parse_tree_list head_symbols word sems) :=
match tree with
| Nil_ptl => 0
| Cons_ptl t q =>
pt_size t + ptl_size q
end.
End Defs.
(* *********************************************************************)
(* *)
(* 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. *)
(* *)
(* *********************************************************************)
From Coq Require Import Streams List Syntax.
From MenhirLib Require Automaton.
From MenhirLib Require Import Alphabet.
Module Make(Import A:Automaton.T).
(** The error monad **)
Inductive result (A:Type) :=
| Err: result A
| OK: A -> result A.
Arguments Err [A].
Arguments OK [A].
Definition bind {A B: Type} (f: result A) (g: A -> result B): result B :=
match f with
| OK x => g x
| Err => Err
end.
Definition bind2 {A B C: Type} (f: result (A * B)) (g: A -> B -> result C):
result C :=
match f with
| OK (x, y) => g x y
| Err => Err
end.
Notation "'do' X <- A ; B" := (bind A (fun X => B))
(at level 200, X ident, A at level 100, B at level 200).
Notation "'do' ( X , Y ) <- A ; B" := (bind2 A (fun X Y => B))
(at level 200, X ident, Y ident, A at level 100, B at level 200).
(** Some operations on streams **)
(** Concatenation of a list and a stream **)
Fixpoint app_str {A:Type} (l:list A) (s:Stream A) :=
match l with
| nil => s
| cons t q => Cons t (app_str q s)
end.
Infix "++" := app_str (right associativity, at level 60).
Lemma app_str_app_assoc {A:Type} (l1 l2:list A) (s:Stream A) :
l1 ++ (l2 ++ s) = (l1 ++ l2) ++ s.
Proof.
induction l1.
reflexivity.
simpl.
rewrite IHl1.
reflexivity.
Qed.
(** The type of a non initial state: the type of semantic values associated
with the last symbol of this state. *)
Definition noninitstate_type state :=
symbol_semantic_type (last_symb_of_non_init_state state).
(** The stack of the automaton : it can be either nil or contains a non
initial state, a semantic value for the symbol associted with this state,
and a nested stack. **)
Definition stack := list (sigT noninitstate_type). (* eg. list {state & state_type state} *)
Section Init.
Variable init : initstate.
(** The top state of a stack **)
Definition state_of_stack (stack:stack): state :=
match stack with
| [] => init
| existT _ s _::_ => s
end.
(** [pop] pops some symbols from the stack. It returns the popped semantic
values using [sem_popped] as an accumulator and discards the popped
states.**)
Fixpoint pop (symbols_to_pop:list symbol) (stack_cur:stack):
forall {A:Type} (action:arrows_right A (map symbol_semantic_type symbols_to_pop)),
result (stack * A) :=
match symbols_to_pop return forall {A:Type} (action:arrows_right A (map _ symbols_to_pop)), result (stack * A) with
| [] => fun A action => OK (stack_cur, action)
| t::q => fun A action =>
match stack_cur with
| existT _ state_cur sem::stack_rec =>
match compare_eqdec (last_symb_of_non_init_state state_cur) t with
| left e =>
let sem_conv := eq_rect _ symbol_semantic_type sem _ e in
pop q stack_rec (action sem_conv)
| right _ => Err
end
| [] => Err
end
end.
(** [step_result] represents the result of one step of the automaton : it can
fail, accept or progress. [Fail_sr] means that the input is incorrect.
[Accept_sr] means that this is the last step of the automaton, and it
returns the semantic value of the input word. [Progress_sr] means that
some progress has been made, but new steps are needed in order to accept
a word.
For [Accept_sr] and [Progress_sr], the result contains the new input buffer.
[Fail_sr] means that the input word is rejected by the automaton. It is
different to [Err] (from the error monad), which mean that the automaton is
bogus and has perfomed a forbidden action. **)
Inductive step_result :=
| Fail_sr: step_result
| Accept_sr: symbol_semantic_type (NT (start_nt init)) -> Stream token -> step_result
| Progress_sr: stack -> Stream token -> step_result.
Program Definition prod_action':
forall p,
arrows_right (symbol_semantic_type (NT (prod_lhs p)))
(map symbol_semantic_type (prod_rhs_rev p)):=
fun p =>
eq_rect _ (fun x => x) (prod_action p) _ _.
Next Obligation.
unfold arrows_left, arrows_right; simpl.
rewrite <- fold_left_rev_right, <- map_rev, rev_involutive.
reflexivity.
Qed.
(** [reduce_step] does a reduce action :
- pops some elements from the stack
- execute the action of the production
- follows the goto for the produced non terminal symbol **)
Definition reduce_step stack_cur production buffer: result step_result :=
do (stack_new, sem) <-
pop (prod_rhs_rev production) stack_cur (prod_action' production);
match goto_table (state_of_stack stack_new) (prod_lhs production) with
| Some (exist _ state_new e) =>
let sem := eq_rect _ _ sem _ e in
OK (Progress_sr (existT noninitstate_type state_new sem::stack_new) buffer)
| None =>
match stack_new with
| [] =>
match compare_eqdec (prod_lhs production) (start_nt init) with
| left e =>
let sem := eq_rect _ (fun nt => symbol_semantic_type (NT nt)) sem _ e in
OK (Accept_sr sem buffer)
| right _ => Err
end
| _::_ => Err
end
end.
(** One step of parsing. **)
Definition step stack_cur buffer: result step_result :=
match action_table (state_of_stack stack_cur) with
| Default_reduce_act production =>
reduce_step stack_cur production buffer
| Lookahead_act awt =>
match Streams.hd buffer with
| existT _ term sem =>
match awt term with
| Shift_act state_new e =>
let sem_conv := eq_rect _ symbol_semantic_type sem _ e in
OK (Progress_sr (existT noninitstate_type state_new sem_conv::stack_cur)
(Streams.tl buffer))
| Reduce_act production =>
reduce_step stack_cur production buffer
| Fail_action =>
OK Fail_sr
end
end
end.
(** The parsing use a [nat] parameter [n_steps], so that we do not have to prove
terminaison, which is difficult. So the result of a parsing is either
a failure (the automaton has rejected the input word), either a timeout
(the automaton has spent all the given [n_steps]), either a parsed semantic
value with a rest of the input buffer.
**)
Inductive parse_result :=
| Fail_pr: parse_result
| Timeout_pr: parse_result
| Parsed_pr: symbol_semantic_type (NT (start_nt init)) -> Stream token -> parse_result.
Fixpoint parse_fix stack_cur buffer n_steps: result parse_result:=
match n_steps with
| O => OK Timeout_pr
| S it =>
do r <- step stack_cur buffer;
match r with
| Fail_sr => OK Fail_pr
| Accept_sr t buffer_new => OK (Parsed_pr t buffer_new)
| Progress_sr s buffer_new => parse_fix s buffer_new it
end
end.
Definition parse buffer n_steps: result parse_result :=
parse_fix [] buffer n_steps.
End Init.
Arguments Fail_sr [init].
Arguments Accept_sr [init] _ _.
Arguments Progress_sr [init] _ _.
Arguments Fail_pr [init].
Arguments Timeout_pr [init].
Arguments Parsed_pr [init] _ _.
End Make.
Module Type T(A:Automaton.T).
Include (Make A).
End T.
This diff is collapsed.
(* *********************************************************************)
(* *)
(* 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. *)
(* *)