like this
).
Non-terminal symbols are set in italic font
(like that). Square brackets
[...] denote
optional components. Curly brackets <...> denotes
zero, one or several repetitions of the enclosed components. Curly
bracket with a trailing plus sign <...>+ denote one or
several repetitions of the enclosed components. Parentheses
(...) denote grouping. ident | ::= | (letter | _ ) <letter | 0 ...9 | _ | ' > |
letter | ::= | A ...Z | a ...z |
infix-symbol | ::= | (= | < | > | @ | ^ | | | & | + | - |
* | / | $ | % ) <operator-char> |
prefix-symbol | ::= | (! | ? | ~ ) <operator-char> |
operator-char | ::= | ! | $ | % | & | + | - | . | / | :
< | = | > | ? | @ | ^ | | | ~ |
`
) and immutable ones (string-literal),
between double quotes ("
). It is worth noting that escape
sequences are the same for both. In particular, \`
is not a
valid escape sequence, even between `
, so one has to write
\096
.integer-literal | ::= | [- ] <0 ...9 >+ |
| | [- ] (0x | 0X ) <0 ...9 | A ...F | a ...f >+ |
|
| | [- ] (0o | 0O ) <0 ...7 >+ |
|
| | [- ] (0b | 0B ) <0 ...1 >+ |
|
float-literal | ::= | [- ] <0 ...9 >+ [. <0 ...9 >]
[(e | E ) [+ | - ] <0 ...9 >+] |
char-literal | ::= | ' regular-char ' |
| | ' escape-sequence ' |
|
escape-sequence | ::= | \ (\ | " | ' | n | t | b | t ) |
| | \ (0 ...9 ) (0 ...9 ) (0 ...9 ) |
|
string-literal | ::= | " <string-character> " |
charray-literal | ::= | ` <charray-character> ` |
string-character | ::= | regular-char-string |
| | escape-sequence | |
charray-character | ::= | regular-char-charray |
| | escape-sequence |
and as assert asr begin class closed constraint do done downto else end exception external false for fun function functor if in include inherit land lazy let lor lsl lsr lxor match method mod module mutable new of open or parser private rec sig struct then to true try type val virtual when while with affects content finally flow greater less level noneq propagate raise raises row thanThe following character sequences are also keywords:
# & ' ( ) * , -> ? ?? . .. .( .[ : :: := ; ;; <- = [ [| [< {< ] |] >] >} _ ` { | } ~ -{ }-> ={ }=>
· Value names: | value-name | ::= | lowercase-ident | ( operator-name ) |
|
operator-name | ::= | prefix-symbol | infix-symbol | ||
| | * | = | or | & | := |
|||
· Value constructors: | constr-name | ::= | capitalized-ident | false | true | [] | () | :: |
|
· Record fields: | field-name | ::= | lowercase-ident | |
· Type constructors: | typeconstr-name | ::= | lowercase-ident | |
· Level names: | level-name | ::= | uppercase-ident | |
· Principals: | principal | ::= | ! lowercase-ident |
|
· Exception names: | exception-name | ::= | capitalized-ident | |
· Module name: | module-name | ::= | capitalized-ident | |
· Module type names: | modtype-name | ::= | ident |
.
name, where prefix designates a module
and name is the name of an object defined in that module. The
first component of the path, prefix is either a simple module name
or an access path name1.
name2..., in case the
defining module is itself nested inside other modules. For referring
to type constructors, levels, exceptions (in type expressions) or
module types, the prefix can also contain simple functor
applications (as in the syntactic class ext-module-path), in case
the defining module is the result of a functor application.value-path | ::= | value-name | module-path . lowercase-ident |
constr | ::= | constr-name | module-path . capitalized-ident |
typeconstr | ::= | typeconstr-name | extended-module-path . lowercase-ident |
level | ::= | level-name | extended-module-path . capitalized-ident |
exception | ::= | exception-name | extended-module-path . capitalized-ident |
field | ::= | field-name | module-path . lowercase-ident |
module-path | ::= | module-name | module-path . capitalized-ident |
ext-module-path | ::= | module-name |
| | ext-module-path . capitalized-ident |
|
| | ext-module-path ( ext-module-path ) |
|
modtype-path | ::= | modtype-name | module-path . ident |
<
, although it is not strict). The lattice must include
principals (principal) and levels introduced by level
declarations (level), which form ``(constant) security levels'':flow
declarations (see section 3.3.3),
<
security-level2 holds.level
definitions.level-definition | ::= | level level-name level-repr |
level-repr | ::= | [greater than security-level-list]
[less than security-level-list] |
| | = security-level |
|
security-level-list | ::= | security-level <, security-level> |
level
keyword. It consists
in a capitalized identifier followed by two optional sets of
assumptions or bounds. The identifier is the name of the level
being defined. The assumptions relate this new level with existing
ones:
greater
than
security-level1 ,
... ,
security-leveln is provided, then the new
level is made greater than or equal to security-leveli, for
all i.
less
than
security-level1 ,
... ,
security-leveln is provided, then the new
level is made less than or equal to security-leveli, for all i.
=
security-level is a shorthand for
greater
than
security-level less
than
security-level.
The definition cannot introduce new relationships about levels listed in
these assumptions: every level which appears in the former must be
known to be less than or equal to each of those appearing in the latter.row
[
exception1,
...,
exceptionn]
is a mapping from exceptions distinct of
exception1, ..., exceptionn to security
levels.typexpr | ::= | ' ident |
| | ( typeexpr ) |
|
| | typexpr -{ typexpr | typexpr | typexpr
}-> typexpr |
|
| | typexpr <* typexpr>+ |
|
| | typeconstr | |
| | typeexpr typeconstr | |
| | ( typexpr <, typexpr> ) typeconstr |
|
| | exception : typexpr ; typexpr |
'
ident. A
type variable can be used with any kind (i.e. there is a not a
distinguished name-space for every kind of variables); however in a
given context (i.e. a type scheme, a data-type definition or a type
constraint), every occurrence of a given type variable must be used
with the same kind. In type definitions, type variables are names for
the type parameters. In type schemes, they are implicitly
universally quantified.-{
typexpr2 |
typexpr3 |
typexpr4}->
typexpr5. typexpr1 and
typexpr5 have the kind type
; the former is the type of the
argument of the function and the latter that of its result.
typexpr2 and typexpr4 are levels (of kind level
). The
former is the security level of the context (generally written
pc in the literature) where the
function is called while the latter is the annotation attached to the
function's identity. Lastly, typexpr3 is the row (of kind
row []
) describing the exceptions raised by the function.*
... *
typexprn is the type of tuples whose elements belong
to types typexpr1, ..., typexprn respectively.(
typeexpr <,
typeexpr> )
)
arguments. Every type constructor is supposed to have a
signature which gives the number of parameters it expects and
their respective kind, see section 3.2.7.:
typexpr1 ;
typexpr2 stands for the row whose entry at index
exception is typexpr1 and whose other entries are given
by the row typexpr2.type-scheme | ::= | typexpr [with constraint <and constraint>] |
constraint | ::= | left-hand-side <, left-hand-side> <
right-hand-side <, right-hand-side> |
| | typexpr <~ typexpr>+ |
|
left-hand-side | ::= | typexpr | content ( typexpr) |
right-hand-side | ::= | typexpr | level ( typexpr) |
<
, or
a same-skeleton constraint, i.e. a ~
-separated list of type
expressions.'a
with the two constraints
security-level <
'a
and
'a
<
security-level.
[<
security-level1 ,
... ,
security-leveln]
is a shorthand for a fresh level
variable 'a
with the constraint 'a
<
security-level1 ,
... ,
security-leveln.
Similarly, [>
security-level1 ,
... ,
security-leveln]
is a shorthand for a fresh level
variable 'a
with the constraint security-level1
,
... ,
security-leveln <
'a
. Lastly,
[<
security-level1 ,
... ,
security-leveln |>
security-leveln+ 1 ,
... ,
security-leveln+ k]
is a shorthand for a fresh
level variable 'a
with the constraints
security-level1 ,
... ,
security-leveln
<
'a
and
'a
<
security-leveln+ 1 ,
... ,
security-leveln+ k.
_
stands for an anonymous fresh variable of any kind.
-{|
typexpr1 |
typexpr2
}->
is a shorthand for -{
'a
|
typexpr1 |
typexpr2 }->
where 'a
is
a fresh variable. Furthermore, an arrow whose three annotations are
omitted, -{ | | | }->
, can be written ->
.
type-definition | ::= | type typedef <and typedef> |
typedef | ::= | [noneq ] [type-params] typeconstr-name [= typexpr]
[type-repr] |
type-params | ::= | type-param | ( type-param <, type-param> ) |
type-param | ::= | [+ | - | = | # ] ' ident
[: (level | type row [ [exception-list] ] )] |
type-repr | ::= | constr-decl <| constr-decl> [# ' ident] |
| | { field-decl <; field-decl> } [# ' ident] |
|
constr-decl | ::= | constr-name | constr-name of typexpr |
field-decl | ::= | [mutable ] field-name : typexpr |
type
keyword, and consist in
one or several simple definitions, possibly mutually recursive,
separated by the and
keyword. Each simple definition defines one
type constructor. A simple definition consists in a lowercase
identifier, possibly preceded by a noneq
flag and one or several
type parameters, and followed by an optional type equation, and then
an optional type representation. The identifier is the name of the
type constructor being defined.'
ident or a list of type variables (
'
ident1
,
... ,
identn)
for type constructors with several
parameters. Each parameter may be annotated by its variance and its
kind. In the case where the type definition introduces an abstract
type (i.e. no type equation is provided), these annotations are
mandatory and reproduced in the signature of the type constructor. In
other cases, the signature computed for the type constructor is the
minimal one which fits the type equation, the type representation and
these annotations.=
typexpr makes the
defined type equivalent to the type expression typexpr on the
right of the =
sign: one can be substituted for the other during
typing. If no type equation is given, a new type is generated which
is incompatible with any other type.=
constr-decl <|
constr-decl>
[#
'
ident] describes a variant type. The optional
annotation [#
'
ident] declares the security level
attached to variant values. It must be one of the parameters of the
type constructor and it is required if the variant type comprises
several constructors.
=
{
field-decl <;
field-decl > }
describes a record type. The optional
annotation [#
'
ident] declares the security level
attached to records values. It must be one of the parameter of the
type constructor and it is required if the record type comprises one
or several mutable fields.
exntypexpr | ::= | ' ident |
| | security-level | |
| | ( typeexpr ) |
|
| | exntypexpr -{ exntypexpr | exntypexpr | exntypexpr
}-> exntypexpr |
|
| | exntypexpr <* exntypexpr>+ |
|
| | typeconstr | |
| | typeexpr typeconstr | |
| | ( exntypexpr <, exntypexpr> ) typeconstr |
|
| | exception : exntypexpr ; exntypexpr |
|
exception-definition | ::= | exception exception-name [exception-argument]
[= exception-name] |
exception-argument | ::= | [: ' ident] of exntypexpr |
'
ident which can appear in the type expression. The type
expression exntypexpr gives the type of the exception's argument,
it is a type expression which may involve constant security levels.constant | ::= | integer-literal |
| | float-literal | |
| | char-literal | |
| | string-literal | |
| | charray-literal | |
| | constr |
pattern | ::= | value-name |
| | _ |
|
| | pattern as value-name |
|
| | ( pattern ) |
|
| | ( pattern : type-scheme ) |
|
| | pattern | pattern |
|
| | constr pattern | |
| | { field = pattern <; field = pattern> } |
|
| | [ pattern <; pattern> ] |
|
| | pattern :: pattern |
|
| | [| pattern <; pattern> |] |
expr | ::= | value-path |
| | constant | |
| | ( expr ) |
|
| | begin expr end |
|
| | ( expr : type-scheme ) |
|
| | expr , expr <, expr> |
|
| | ncconstr expr | |
| | expr :: expr |
|
| | [ expr <; expr> ] |
|
| | [| expr <; expr> |] |
|
| | { field = expr <; field = expr> } |
|
| | { expr with
field = expr <; field = expr> } |
|
| | expr <expr>+ | |
| | prefix-symbol expr | |
| | expr (infix-symbol | * | = | or | & ) expr |
|
| | expr . field |
|
| | expr . field <- expr |
|
| | expr .( expr ) |
|
| | expr .( expr ) <- expr |
|
| | expr .[ expr ] |
|
| | expr .[ expr ] <- expr |
|
| | if expr then expr [else expr] |
|
| | while expr do expr done |
|
| | for ident = expr (to | downto ) expr
do expr done |
|
| | expr ; expr |
|
| | match expr with pattern-matching |
|
| | function pattern-matching |
|
| | fun multiple-matching |
|
| | raise (exception | ( exception expr ) ) |
|
| | try expr with [| ] handler <| handler> |
|
| | try expr finally expr |
|
| | let [rec ] let-binding <and let-binding> in expr |
|
pattern-matching | ::= | [| ] pattern [when expr] -> expr <|
pattern [when expr] -> expr> |
multiple-matching | ::= | <pattern>+ [when expr] -> expr |
let-binding | ::= | pattern [: type-scheme] = expr |
| | value-name <pattern>+ [: type-scheme] = expr |
|
handler | ::= | exception-pattern -> expr [propagate ] |
raise
is no longer a regular function but a construct of the
language. Two exceptions handlers are provided: the expression
try |
|
expr | |
with |
|
pattern1 -> expr1 [propagate ] |
|
... | |
| patternn -> exprn [propagate ] |
propagate
, the
trapped exception is propagated (in this case, exceptions raised by
expri are not thrown), otherwise the value produced by the
evaluation of expri becomes that of the whole
try
expression. If none of the patterns matches
the exception raised by expr, the exception is raised again,
thereby transparently ``passing through'' the try
construct.try
expr1 finally
expr2 evaluates the expression expr1. This
produces a result which is either a value of a raised exception. In
both cases, the expression expr2 is evaluated and its result
(value or exception) discarded. Finally, the result produced by
expr1 becomes the result of the whole expression.module-type | ::= | modtype-path |
| | sig <specification [;; ]> end |
|
| | functor ( module-name : module-type )
functor-arrow module-type |
|
| | module-type with mod-constraint <and mod-constraint> |
|
| | ( module-type ) |
|
specification | ::= | val value-name : type-scheme |
| | external value-name : type-scheme =
external-declaration |
|
| | type-definition | |
| | level-definition | |
| | exception-definition | |
| | module module-name module-args : module-type |
|
| | module type modtype-name = [module-type] |
|
| | open module-path |
|
| | include module-type |
|
module-args | ::= | <( module-name : module-type ) > |
mod-constraint | ::= | type [type-parameters] typeconstr = typexpr |
| | level level level-repr |
|
| | module module-path = ext-module-path |
|
functor-arrow | ::= | -> | -{ [security-level-list] | [security-level-list] }-> |
exception
) may mention an equality between exceptions
(as in structures). This is made necessary because exceptions
appears in types for values.
module-expr | ::= | module-path |
| | struct <definition [;; ]> end |
|
| | functor ( module-name : module-type ) ->
module-expr |
|
| | module-expr ( module-expr ) |
|
| | ( module-expr ) |
|
| | ( module-expr : module-type ) |
|
definition | ::= | let [rec ] let-binding <and let-binding> |
| | external value-name : type-scheme =
external-declaration |
|
| | type-definition | |
| | level-definition | |
| | exception-definition | |
| | module module-name module-args
= module-expr |
|
| | module type modtype-name = module-type |
|
| | open module-path |
|
| | include module-expr |
interface | ::= | flows-declaration [affects security-level-list]
[raises security-level-list]
<specification> |
implementation | ::= | flows-declaration <specification> |
flows-declaration | ::= | flow principal-list < principal-list
<and principal-list < principal-list> |
principal-list | ::= | principal <, principal> |
flow
declarations and a specification. The flow
declarations define
the partial order <
between principals which is used throughout
the type-checking of the specification: it is the smallest one which
satisfies all the listed inequalities. The specification is the body
of a structure which lists the values, types, levels, exceptions,
modules and module types implemented by the unit.flow
declarations, the affects
and raises
statements and a
specification. The flow
declarations define the partial order <
between principals which has been used throughout the type-checking of
the unit: in short, it provides a description of the possible
information flow generated by the code of the unit. The inequality
between principals provided in the interface of a unit must imply
(possibly by transitivity) all those mentioned in the implementation
of the unit. Lastly, the statements affects
and raises
mentions respectively the lower and upper bounds of the module
expression underlying the compilation unit. They are omitted when the
bound is empty.