Chapter 7 |
Camlp4 library modules |
|
When linking an application using this library modules, you have to
add the file gramlib.cma
in the command line. For example, with
the line:
ocamlc -I +camlp4 gramlib.cma <the_files>
7.1 |
Module MLast: abstract syntax tree |
|
This library module is accessible, but not documented. The creation of
abstract syntax tree nodes must be done using quotations, defined in
the file q_MLast.cmo
. See appendix A.
However, some functions are provided to access the ``location'' field
in nodes. They are:
-
loc_of_expr
for expressions.
-
loc_of_patt
for patterns.
-
loc_of_ctyp
for types.
-
loc_of_module_type
for module types.
-
loc_of_module_expr
for module expressions.
-
loc_of_sig_item
for signature items.
-
loc_of_str_item
for structure items.
-
loc_of_phrase
for phrases.
7.2 |
Module Grammar: extensible grammars |
|
-
This module implements the Camlp4 extensible grammars system.
Grammars entries can be extended using the EXTEND statement,
added by loading the Camlp4 pa_extend.cmo file.
type g;;
-
The type for grammars, holding entries.
val create : Token.lexer -> g;;
-
Create a new grammar, without keywords, using the lexer given
as parameter.
val tokens : g -> string -> (string * int) list;;
-
Given a grammar and a token pattern constructor, returns the list of
the corresponding values currently used in all entries of this grammar.
The integer is the number of times this pattern value is used.
Examples:
If the associated lexer uses ("", xxx) to represent a keyword
(what is represented by then simple string xxx in an EXTEND
statement rule), the call Grammar.token g "" returns the keywords
list.
The call Grammar.token g "IDENT" returns the list of all usages
of the pattern "IDENT" in the EXTEND statements.
module Entry :
sig
type 'a e;;
val create : g -> string -> 'a e;;
val parse : 'a e -> char Stream.t -> 'a;;
val parse_token : 'a e -> Token.t Stream.t -> 'a;;
val name : 'a e -> string;;
val of_parser : g -> string -> (Token.t Stream.t -> 'a) -> 'a e;;
val print : 'a e -> unit;;
val find : 'a e -> string -> Obj.t e;;