Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
119
Issues
119
List
Boards
Labels
Service Desk
Milestones
Merge Requests
16
Merge Requests
16
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
6a159d62
Commit
6a159d62
authored
Dec 29, 2010
by
Jean-Christophe Filliâtre
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
programs are now parsed with src/parser/
parent
7d2eca12
Changes
18
Hide whitespace changes
Inline
Side-by-side
Showing
18 changed files
with
88 additions
and
1180 deletions
+88
-1180
Makefile.in
Makefile.in
+2
-3
modules/stdlib.mlw
modules/stdlib.mlw
+1
-1
src/parser/lexer.mli
src/parser/lexer.mli
+2
-0
src/parser/lexer.mll
src/parser/lexer.mll
+2
-0
src/parser/parser.pre.mly
src/parser/parser.pre.mly
+1
-0
src/programs/pgm_lexer.mll
src/programs/pgm_lexer.mll
+0
-252
src/programs/pgm_main.ml
src/programs/pgm_main.ml
+3
-2
src/programs/pgm_module.ml
src/programs/pgm_module.ml
+4
-17
src/programs/pgm_module.mli
src/programs/pgm_module.mli
+2
-3
src/programs/pgm_parser.mly
src/programs/pgm_parser.mly
+0
-709
src/programs/pgm_ptree.ml
src/programs/pgm_ptree.ml
+0
-121
src/programs/pgm_ttree.ml
src/programs/pgm_ttree.ml
+3
-3
src/programs/pgm_types.mli
src/programs/pgm_types.mli
+1
-1
src/programs/pgm_typing.ml
src/programs/pgm_typing.ml
+51
-51
src/programs/pgm_typing.mli
src/programs/pgm_typing.mli
+1
-1
src/programs/pgm_wp.ml
src/programs/pgm_wp.ml
+6
-6
tests/test-pgm-jcf.mlw
tests/test-pgm-jcf.mlw
+5
-5
theories/programs.why
theories/programs.why
+4
-5
No files found.
Makefile.in
View file @
6a159d62
...
...
@@ -282,10 +282,9 @@ install_no_local::
# Whyml
########
PGMGENERATED
=
src/programs/pgm_parser.mli src/programs/pgm_parser.ml
\
src/programs/pgm_lexer.ml
PGMGENERATED
=
PGM_FILES
=
pgm_ttree
pgm_ptree pgm_parser pgm_lexer
\
PGM_FILES
=
pgm_ttree
\
pgm_types pgm_module pgm_wp pgm_env pgm_typing pgm_main
PGMMODULES
=
$(
addprefix
src/programs/,
$(PGM_FILES)
)
...
...
modules/stdlib.mlw
View file @
6a159d62
module Ref
{ use import programs.Prelude }
use import programs.Prelude
mutable type ref 'a model 'a
...
...
src/parser/lexer.mli
View file @
6a159d62
...
...
@@ -29,6 +29,8 @@ val parse_list0_decl :
val
parse_lexpr
:
Lexing
.
lexbuf
->
Ptree
.
lexpr
val
parse_program_file
:
Lexing
.
lexbuf
->
Ptree
.
program_file
(** other functions to be re-used in other lexers/parsers *)
val
newline
:
Lexing
.
lexbuf
->
unit
...
...
src/parser/lexer.mll
View file @
6a159d62
...
...
@@ -301,6 +301,8 @@ and string = parse
let
parse_lexpr
=
with_location
(
lexpr_eof
token
)
let
parse_program_file
=
with_location
(
program_file
token
)
let
read_channel
env
file
c
=
let
lb
=
Lexing
.
from_channel
c
in
Loc
.
set_file
file
lb
;
...
...
src/parser/parser.pre.mly
View file @
6a159d62
...
...
@@ -1144,6 +1144,7 @@ simple_type_c:
;
annotation
:
|
LEFTBRC
RIGHTBRC
{
mk_pp
PPtrue
}
|
LEFTBRC
lexpr
RIGHTBRC
{
$
2
}
;
...
...
src/programs/pgm_lexer.mll
deleted
100644 → 0
View file @
7d2eca12
(**************************************************************************)
(* *)
(* Copyright (C) 2010- *)
(* François Bobot *)
(* Jean-Christophe Filliâtre *)
(* Claude Marché *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
{
open
Format
open
Lexing
open
Why
open
Lexer
open
Term
open
Pgm_parser
exception
UnterminatedLogic
exception
IllegalCharacter
of
char
let
()
=
Exn_printer
.
register
(
fun
fmt
exn
->
match
exn
with
|
UnterminatedLogic
->
fprintf
fmt
"unterminated logic block"
|
IllegalCharacter
c
->
fprintf
fmt
"illegal character %c"
c
|
Parsing
.
Parse_error
->
fprintf
fmt
"syntax error"
|
_
->
raise
exn
)
let
keywords
=
Hashtbl
.
create
97
let
()
=
List
.
iter
(
fun
(
x
,
y
)
->
Hashtbl
.
add
keywords
x
y
)
[
"absurd"
,
ABSURD
;
"and"
,
AND
;
"any"
,
ANY
;
"as"
,
AS
;
"assert"
,
ASSERT
;
"assume"
,
ASSUME
;
"begin"
,
BEGIN
;
"check"
,
CHECK
;
"do"
,
DO
;
"done"
,
DONE
;
"downto"
,
DOWNTO
;
"else"
,
ELSE
;
"export"
,
EXPORT
;
"end"
,
END
;
"exception"
,
EXCEPTION
;
"for"
,
FOR
;
"fun"
,
FUN
;
"ghost"
,
GHOST
;
"if"
,
IF
;
"import"
,
IMPORT
;
"in"
,
IN
;
"invariant"
,
INVARIANT
;
"label"
,
LABEL
;
"let"
,
LET
;
"match"
,
MATCH
;
"model"
,
MODEL
;
"module"
,
MODULE
;
"mutable"
,
MUTABLE
;
"namespace"
,
NAMESPACE
;
"not"
,
NOT
;
"of"
,
OF
;
"parameter"
,
PARAMETER
;
"raise"
,
RAISE
;
"raises"
,
RAISES
;
"reads"
,
READS
;
"rec"
,
REC
;
"then"
,
THEN
;
"to"
,
TO
;
"try"
,
TRY
;
"type"
,
TYPE
;
"use"
,
USE
;
"variant"
,
VARIANT
;
"while"
,
WHILE
;
"with"
,
WITH
;
"writes"
,
WRITES
;
]
let
update_loc
lexbuf
file
line
chars
=
let
pos
=
lexbuf
.
lex_curr_p
in
let
new_file
=
match
file
with
None
->
pos
.
pos_fname
|
Some
s
->
s
in
lexbuf
.
lex_curr_p
<-
{
pos
with
pos_fname
=
new_file
;
pos_lnum
=
int_of_string
line
;
pos_bol
=
pos
.
pos_cnum
-
int_of_string
chars
;
}
let
logic_start_loc
=
ref
Loc
.
dummy_position
let
logic_buffer
=
Buffer
.
create
1024
let
loc
lb
=
(
lexeme_start_p
lb
,
lexeme_end_p
lb
)
}
let
newline
=
'\n'
let
space
=
[
'
'
'\t'
'\r'
]
let
lalpha
=
[
'
a'
-
'
z'
'
_'
]
let
ualpha
=
[
'
A'
-
'
Z'
]
let
alpha
=
lalpha
|
ualpha
let
digit
=
[
'
0
'
-
'
9
'
]
let
lident
=
lalpha
(
alpha
|
digit
|
'\''
)
*
let
uident
=
ualpha
(
alpha
|
digit
|
'\''
)
*
let
decimal_literal
=
[
'
0
'
-
'
9
'
]
[
'
0
'
-
'
9
'
'
_'
]
*
let
hex_literal
=
'
0
'
[
'
x'
'
X'
]
[
'
0
'
-
'
9
'
'
A'
-
'
F'
'
a'
-
'
f'
][
'
0
'
-
'
9
'
'
A'
-
'
F'
'
a'
-
'
f'
'
_'
]
*
let
oct_literal
=
'
0
'
[
'
o'
'
O'
]
[
'
0
'
-
'
7
'
]
[
'
0
'
-
'
7
'
'
_'
]
*
let
bin_literal
=
'
0
'
[
'
b'
'
B'
]
[
'
0
'
-
'
1
'
]
[
'
0
'
-
'
1
'
'
_'
]
*
let
int_literal
=
decimal_literal
|
hex_literal
|
oct_literal
|
bin_literal
let
hexadigit
=
[
'
0
'
-
'
9
'
'
a'
-
'
f'
'
A'
-
'
F'
]
let
op_char_1
=
[
'
=
'
'
<
'
'
>
'
'
~
'
]
let
op_char_2
=
[
'
+
'
'
-
'
]
let
op_char_3
=
[
'
*
'
'
/
'
'
%
'
]
let
op_char_4
=
[
'
!
'
'
$
'
'
&
'
'
?
'
'
@
'
'
^
'
'.'
'
:
'
'
|
'
'
#
'
]
let
op_char_34
=
op_char_3
|
op_char_4
let
op_char_234
=
op_char_2
|
op_char_34
let
op_char_1234
=
op_char_1
|
op_char_234
let
op_char_pref
=
[
'
!
'
'
?
'
]
rule
token
=
parse
|
"#"
space
*
(
"
\"
"
([
^
'\010'
'\013'
'
"' ]* as file) "
\
""
)
?
space
*
(
digit
+
as
line
)
space
*
(
digit
+
as
char
)
space
*
"#"
{
update_loc
lexbuf
file
line
char
;
token
lexbuf
}
|
newline
{
newline
lexbuf
;
token
lexbuf
}
|
space
+
{
token
lexbuf
}
|
'
_'
{
UNDERSCORE
}
|
lident
as
id
{
try
Hashtbl
.
find
keywords
id
with
Not_found
->
LIDENT
id
}
|
uident
as
id
{
UIDENT
id
}
|
int_literal
as
s
{
INTEGER
s
}
|
(
digit
+
as
i
)
(
""
as
f
)
[
'
e'
'
E'
]
([
'
-
'
'
+
'
]
?
digit
+
as
e
)
|
(
digit
+
as
i
)
'.'
(
digit
*
as
f
)
([
'
e'
'
E'
]
([
'
-
'
'
+
'
]
?
digit
+
as
e
))
?
|
(
digit
*
as
i
)
'.'
(
digit
+
as
f
)
([
'
e'
'
E'
]
([
'
-
'
'
+
'
]
?
digit
+
as
e
))
?
{
REAL
(
RConstDecimal
(
i
,
f
,
Util
.
option_map
remove_leading_plus
e
))
}
|
'
0
'
[
'
x'
'
X'
]
((
hexadigit
*
as
i
)
'.'
(
hexadigit
+
as
f
)
|
(
hexadigit
+
as
i
)
'.'
(
hexadigit
*
as
f
)
|
(
hexadigit
+
as
i
)
(
""
as
f
))
[
'
p'
'
P'
]
([
'
-
'
'
+
'
]
?
digit
+
as
e
)
{
REAL
(
RConstHexa
(
i
,
f
,
remove_leading_plus
e
))
}
|
"(*)"
{
LEFTPAR_STAR_RIGHTPAR
}
|
"(*"
{
comment
lexbuf
;
token
lexbuf
}
|
"'"
{
QUOTE
}
|
"`"
{
BACKQUOTE
}
|
","
{
COMMA
}
|
"("
{
LEFTPAR
}
|
")"
{
RIGHTPAR
}
|
":"
{
COLON
}
|
";"
{
SEMICOLON
}
|
":="
{
COLONEQUAL
}
|
"->"
{
ARROW
}
|
"="
{
EQUAL
}
|
"<>"
{
LTGT
}
|
"@"
{
AT
}
|
"."
{
DOT
}
|
"["
{
LEFTSQ
}
|
"]"
{
RIGHTSQ
}
|
"{"
{
logic_start_loc
:=
loc
lexbuf
;
let
s
=
logic
lexbuf
in
LOGIC
((
fst
!
logic_start_loc
,
snd
(
loc
lexbuf
))
,
s
)
}
(* FIXME: allow newlines as well *)
|
"{"
space
*
"}"
{
LOGIC
(
loc
lexbuf
,
"true"
)
}
|
"{{"
{
LEFTBLEFTB
}
|
"}}"
{
RIGHTBRIGHTB
}
|
"|"
{
BAR
}
|
"||"
{
BARBAR
}
|
"&&"
{
AMPAMP
}
|
op_char_pref
op_char_4
*
as
s
{
OPPREF
s
}
|
op_char_1234
*
op_char_1
op_char_1234
*
as
s
{
OP1
s
}
|
op_char_234
*
op_char_2
op_char_234
*
as
s
{
OP2
s
}
|
op_char_34
*
op_char_3
op_char_34
*
as
s
{
OP3
s
}
|
op_char_4
+
as
s
{
OP4
s
}
|
"
\"
"
{
STRING
(
string
lexbuf
)
}
|
eof
{
EOF
}
|
_
as
c
{
raise
(
IllegalCharacter
c
)
}
and
logic
=
parse
|
"}"
{
let
s
=
Buffer
.
contents
logic_buffer
in
Buffer
.
clear
logic_buffer
;
s
}
|
newline
{
newline
lexbuf
;
Buffer
.
add_char
logic_buffer
'\n'
;
logic
lexbuf
}
|
eof
{
raise
(
Loc
.
Located
(
!
logic_start_loc
,
UnterminatedLogic
))
}
|
_
as
c
{
Buffer
.
add_char
logic_buffer
c
;
logic
lexbuf
}
{
let
parse_file
=
with_location
(
file
token
)
}
(*
Local Variables:
compile-command: "unset LANG; make -C ../.. testl"
End:
*)
src/programs/pgm_main.ml
View file @
6a159d62
...
...
@@ -24,13 +24,14 @@ open Why
open
Util
open
Ident
open
Ptree
open
Pgm_ptree
open
Pgm_module
let
add_module
?
(
type_only
=
false
)
env
penv
lmod
m
=
let
wp
=
not
type_only
in
let
id
=
m
.
mod_name
in
let
uc
=
create_module
(
Ident
.
id_user
id
.
id
id
.
id_loc
)
in
let
prelude
=
Env
.
find_theory
env
[
"programs"
]
"Prelude"
in
let
uc
=
use_export_theory
uc
prelude
in
let
uc
=
List
.
fold_left
(
Pgm_typing
.
decl
~
wp
env
penv
lmod
)
uc
m
.
mod_decl
in
let
m
=
close_module
uc
in
Mnm
.
add
id
.
id
m
lmod
...
...
@@ -38,7 +39,7 @@ let add_module ?(type_only=false) env penv lmod m =
let
retrieve
penv
file
c
=
let
lb
=
Lexing
.
from_channel
c
in
Loc
.
set_file
file
lb
;
let
ml
=
Pgm_lexer
.
parse
_file
lb
in
let
ml
=
Lexer
.
parse_program
_file
lb
in
if
Debug
.
test_flag
Typing
.
debug_parse_only
then
Mnm
.
empty
else
...
...
src/programs/pgm_module.ml
View file @
6a159d62
...
...
@@ -175,24 +175,11 @@ let use_export uc m =
uc_th
=
Theory
.
use_export
uc
.
uc_th
m
.
m_th
;
}
|
_
->
assert
false
(* parsing LOGIC strings using functions from src/parser/
requires proper relocation *)
let
use_export_theory
uc
th
=
{
uc
with
uc_th
=
Theory
.
use_export
uc
.
uc_th
th
}
let
reloc
loc
lb
=
lb
.
Lexing
.
lex_curr_p
<-
loc
;
lb
.
Lexing
.
lex_abs_pos
<-
loc
.
Lexing
.
pos_cnum
+
1
let
parse_string
f
loc
s
=
let
lb
=
Lexing
.
from_string
s
in
reloc
loc
lb
;
f
lb
let
logic_lexpr
((
pos
,
_
)
,
s
)
=
parse_string
Lexer
.
parse_lexpr
pos
s
let
parse_logic_decls
env
((
loc
,
_
)
,
s
)
uc
=
let
parse
=
Lexer
.
parse_list0_decl
env
Theory
.
Mnm
.
empty
uc
.
uc_th
in
{
uc
with
uc_th
=
parse_string
parse
loc
s
}
let
add_logic_pdecl
env
d
uc
=
{
uc
with
uc_th
=
Typing
.
add_decl
env
Theory
.
Mnm
.
empty
uc
.
uc_th
d
}
...
...
src/programs/pgm_module.mli
View file @
6a159d62
...
...
@@ -40,6 +40,7 @@ val open_namespace : uc -> uc
val
close_namespace
:
uc
->
bool
->
string
option
->
uc
val
use_export
:
uc
->
t
->
uc
val
use_export_theory
:
uc
->
Theory
.
theory
->
uc
(** insertion *)
...
...
@@ -51,9 +52,7 @@ val add_mtsymbol : mtsymbol -> uc -> uc
val
add_decl
:
Pgm_ttree
.
decl
->
uc
->
uc
val
add_logic_decl
:
Decl
.
decl
->
uc
->
uc
(** TODO: *)
val
parse_logic_decls
:
Env
.
env
->
Loc
.
position
*
string
->
uc
->
uc
val
logic_lexpr
:
Loc
.
position
*
string
->
Ptree
.
lexpr
val
add_logic_pdecl
:
Env
.
env
->
Ptree
.
decl
->
uc
->
uc
(** exceptions *)
...
...
src/programs/pgm_parser.mly
deleted
100644 → 0
View file @
7d2eca12
/**************************************************************************/
/*
*/
/*
Copyright
(
C
)
2010
-
*/
/*
Fran
ç
ois
Bobot
*/
/*
Jean
-
Christophe
Filli
â
tre
*/
/*
Claude
March
é
*/
/*
Andrei
Paskevich
*/
/*
*/
/*
This
software
is
free
software
;
you
can
redistribute
it
and
/
or
*/
/*
modify
it
under
the
terms
of
the
GNU
Library
General
Public
*/
/*
License
version
2
.
1
,
with
the
special
exception
on
linking
*/
/*
described
in
file
LICENSE
.
*/
/*
*/
/*
This
software
is
distributed
in
the
hope
that
it
will
be
useful
,
*/
/*
but
WITHOUT
ANY
WARRANTY
;
without
even
the
implied
warranty
of
*/
/*
MERCHANTABILITY
or
FITNESS
FOR
A
PARTICULAR
PURPOSE
.
*/
/*
*/
/**************************************************************************/
%
{
open
Parsing
open
Lexing
open
Why
open
Ptree
open
Pgm_ptree
let
loc
()
=
(
symbol_start_pos
()
,
symbol_end_pos
()
)
let
loc_i
i
=
(
rhs_start_pos
i
,
rhs_end_pos
i
)
let
loc_ij
i
j
=
(
rhs_start_pos
i
,
rhs_end_pos
j
)
let
mk_expr
d
=
{
expr_loc
=
loc
()
;
expr_desc
=
d
}
let
mk_expr_i
i
d
=
{
expr_loc
=
loc_i
i
;
expr_desc
=
d
}
let
mk_pat
p
=
{
pat_loc
=
loc
()
;
pat_desc
=
p
}
let
add_lab
id
l
=
{
id
with
id_lab
=
l
}
let
user_loc
fname
lnum
bol
cnum1
cnum2
=
let
pos
=
{
Lexing
.
pos_fname
=
fname
;
Lexing
.
pos_lnum
=
lnum
;
Lexing
.
pos_bol
=
bol
;
Lexing
.
pos_cnum
=
cnum1
}
in
pos
,
{
pos
with
Lexing
.
pos_cnum
=
cnum2
}
(* FIXME: factorize with parser/parser.mly *)
let
infix
s
=
"infix "
^
s
let
prefix
s
=
"prefix "
^
s
let
postfix
s
=
"postfix "
^
s
let
join
(
b
,_
)
(
_
,
e
)
=
(
b
,
e
)
let
rec
mk_apply
f
=
function
|
[]
->
assert
false
|
[
a
]
->
Eapply
(
f
,
a
)
|
a
::
l
->
let
loc
=
join
f
.
expr_loc
a
.
expr_loc
in
mk_apply
{
expr_loc
=
loc
;
expr_desc
=
Eapply
(
f
,
a
)
}
l
let
mk_apply_id
id
=
let
e
=
{
expr_desc
=
Eident
(
Qident
id
);
expr_loc
=
id
.
id_loc
}
in
mk_apply
e
let
mk_infix
e1
op
e2
=
let
id
=
{
id
=
infix
op
;
id_lab
=
[]
;
id_loc
=
loc_i
2
}
in
mk_expr
(
mk_apply_id
id
[
e1
;
e2
])
let
mk_binop
e1
op
e2
=
let
id
=
{
id
=
op
;
id_lab
=
[]
;
id_loc
=
loc_i
2
}
in
mk_expr
(
mk_apply_id
id
[
e1
;
e2
])
let
mk_prefix
op
e1
=
let
id
=
{
id
=
prefix
op
;
id_lab
=
[]
;
id_loc
=
loc_i
1
}
in
mk_expr
(
mk_apply_id
id
[
e1
])
let
id_unit
()
=
{
id
=
"unit"
;
id_lab
=
[]
;
id_loc
=
loc
()
}
let
id_result
()
=
{
id
=
"result"
;
id_lab
=
[]
;
id_loc
=
loc
()
}
let
id_anonymous
()
=
{
id
=
"_"
;
id_lab
=
[]
;
id_loc
=
loc
()
}
let
exit_exn
()
=
Qident
{
id
=
"%Exit"
;
id_lab
=
[]
;
id_loc
=
loc
()
}
let
id_lt_nat
()
=
Qident
{
id
=
"lt_nat"
;
id_lab
=
[]
;
id_loc
=
loc
()
}
let
ty_unit
()
=
Tpure
(
PPTtyapp
([]
,
Qident
(
id_unit
()
)))
let
lexpr_true
()
=
loc
()
,
"true"
let
lexpr_false
()
=
loc
()
,
"false"
let
empty_effect
=
{
pe_reads
=
[]
;
pe_writes
=
[]
;
pe_raises
=
[]
}
let
type_c
p
ty
ef
q
=
{
pc_result_type
=
ty
;
pc_effect
=
ef
;
pc_pre
=
p
;
pc_post
=
q
;
}
let
cast_body
c
((
p
,
e
,
q
)
as
t
)
=
match
c
with
|
None
->
t
|
Some
pt
->
p
,
{
e
with
expr_desc
=
Ecast
(
e
,
pt
)
}
,
q
%
}
/*
Tokens
*/
%
token
<
string
>
LIDENT
UIDENT
%
token
<
string
>
INTEGER
%
token
<
string
>
OP1
OP2
OP3
OP4
OPPREF
%
token
<
Why
.
Ptree
.
real_constant
>
REAL
%
token
<
string
>
STRING
%
token
<
Why
.
Loc
.
position
*
string
>
LOGIC
/*
keywords
*/
%
token
ABSURD
AND
ANY
AS
ASSERT
ASSUME
BEGIN
CHECK
DO
DONE
DOWNTO
ELSE
END
%
token
EXCEPTION
EXPORT
FOR
%
token
FUN
GHOST
IF
IMPORT
IN
INVARIANT
LABEL
LET
MATCH
MODEL
MODULE
MUTABLE
%
token
NAMESPACE
NOT
OF
PARAMETER
%
token
RAISE
RAISES
READS
REC
%
token
THEN
TO
TRY
TYPE
USE
VARIANT
WHILE
WITH
WRITES
/*
symbols
*/
%
token
UNDERSCORE
QUOTE
COMMA
LEFTPAR
RIGHTPAR
COLON
SEMICOLON
%
token
COLONEQUAL
ARROW
EQUAL
LTGT
AT
DOT
LEFTSQ
RIGHTSQ
%
token
LEFTBLEFTB
RIGHTBRIGHTB
BAR
BARBAR
AMPAMP
%
token
BACKQUOTE
LEFTPAR_STAR_RIGHTPAR
EOF
/*
Precedences
*/
%
nonassoc
prec_post
%
nonassoc
BAR
%
nonassoc
prec_id_pattern
%
nonassoc
prec_recfun
%
nonassoc
prec_triple
%
left
LEFTBLEFTB
%
left
prec_simple
%
left
COLON
%
left
prec_letrec
%
left
IN
%
nonassoc
GHOST
%
right
SEMICOLON
%
left
prec_no_else
%
left
ELSE
%
left
COLONEQUAL
%
right
BARBAR
%
right
AMPAMP
%
right
prec_if
%
left
EQUAL
LTGT
OP1
%
left
OP2
%
left
OP3
%
left
OP4
%
nonassoc
prefix_op
%
right
unary_op
%
left
prec_app
%
left
prec_ident
%
left
LEFTSQ
%
nonassoc
prec_decls
%
nonassoc
LOGIC
TYPE
INDUCTIVE
/*
Entry
points
*/
%
type
<
Pgm_ptree
.
file
>
file
%
start
file
%%
file
:
|
list0_module_
EOF
{
$
1
}
;
list0_module_
:
|
/*
epsilon
*/
{
[]
}
|
list1_module_
{
$
1
}
;
list1_module_
:
|
module_
{
[
$
1
]
}
|
module_
list1_module_
{
$
1
::
$
2
}
;
module_
:
|
MODULE
uident
list0_decl
END
{
{
mod_name
=
$
2
;
mod_decl
=
$
3
}
}
;
list0_decl
:
|
/*
epsilon
*/
{
[]
}
|
list1_decl
{
$
1
}
;
list1_decl
:
|
decl
{
[
$
1
]
}
|
decl
list1_decl
{
$
1
::
$
2
}
;
decl
:
|
LOGIC
{
Dlogic
$
1
}
|
LET
lident
labels
list1_type_v_binder
opt_cast
EQUAL
triple
{
Dlet
(
add_lab
$
2
$
3
,
mk_expr_i
7
(
Efun
(
$
4
,
cast_body
$
5
$
7
)))
}
|
LET
lident
labels
EQUAL
FUN
list1_type_v_binder
ARROW
triple
{
Dlet
(
add_lab
$
2
$
3
,
mk_expr_i
8
(
Efun
(
$
6
,
$
8
)))
}
|
LET
REC
list1_recfun_sep_and
{
Dletrec
$
3
}
|
PARAMETER
lident
labels
COLON
type_v