1
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
2
"http://www.w3.org/TR/REC-html40/loose.dtd">
6
<META http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
7
<META name="GENERATOR" content="hevea 1.06">
9
Extending the syntax of OCaml
12
<BODY TEXT=black BGCOLOR=white>
13
<A HREF="tutorial006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
14
<A HREF="index.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
15
<A HREF="tutorial008.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
17
<TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
18
<TR><TD BGCOLOR="#2de52d"><DIV ALIGN=center><TABLE>
19
<TR><TD><A NAME="htoc56"><B><FONT SIZE=6>Chapter 7</FONT></B></A></TD>
20
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=6>Extending the syntax of OCaml</FONT></B></TD>
21
</TR></TABLE></DIV></TD>
23
<A NAME="c:tutext"></A>
24
<A NAME="toc48"></A><TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
25
<TR><TD BGCOLOR="#66ff66"><DIV ALIGN=center><TABLE>
26
<TR><TD><A NAME="htoc57"><B><FONT SIZE=5>7.1</FONT></B></A></TD>
27
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=5>Introduction</FONT></B></TD>
28
</TR></TABLE></DIV></TD>
30
Syntax extensions in <CODE>OCaml</CODE> can be done by extending the
31
grammars entries of the OCaml syntax. All grammars entries are defined
32
in the module named <CODE>Pcaml</CODE>. They all return values of types
33
defined in the module <CODE>MLast</CODE>: nodes of these types can be
34
created using the predefined quotation expansion <CODE>q_MLast.cmo</CODE>.<BR>
38
The entries in <CODE>Pcaml</CODE> are:
39
<UL><LI><CODE>expr</CODE> for expressions, returning values of type
40
<CODE>MLast.expr</CODE>.<BR>
42
<LI><CODE>patt</CODE> for patterns, returning values of type
43
<CODE>MLast.patt</CODE>.<BR>
45
<LI><CODE>ctyp</CODE> for types, returning values of type
46
<CODE>MLast.ctyp</CODE>.<BR>
48
<LI><CODE>module_type</CODE> for module types, returning values of type
49
<CODE>MLast.module_type</CODE>.<BR>
51
<LI><CODE>module_expr</CODE> for module expressions, returning values of type
52
<CODE>MLast.module_expr</CODE>.<BR>
54
<LI><CODE>sig_item</CODE> for signature items, returning values of type
55
<CODE>MLast.sig_item</CODE>.<BR>
57
<LI><CODE>str_item</CODE> for structure items, returning values of type
58
<CODE>MLast.str_item</CODE>.</UL>
59
Most of these entries are generally defined (``extended'') with
60
several ``levels'' (see chapter <A HREF="tutorial003.html#c:tutgram">3</A>). Some of them
61
are labelled, in order to be able to extend them or to insert other
66
The levels and their possible labels are not predefined. It depend on
67
how the syntax define them. To see which labels are defined and which
68
rule they contain, enter the toplevel and type for the normal syntax:
71
Grammar.Entry.print Pcaml.expr;; (* for the expressions *)
72
Grammar.Entry.print Pcaml.patt;; (* for the patterns *)
75
For the revised syntax, load <CODE>"camlp4r.cma"</CODE> instead. If you
76
defined another syntax of the whole language or want to see the other
77
syntaxes provided, load it before, and call <CODE>Grammar.Entry.print</CODE>
78
of the desired grammar entry. Look at the manual page
79
(<CODE>man camlp4</CODE> in the shell) to see all available syntaxes and
84
Once you have the list of the grammar entry you want to extend and the
85
possible level label, you can do your extension.<BR>
89
<A NAME="toc49"></A><TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
90
<TR><TD BGCOLOR="#66ff66"><DIV ALIGN=center><TABLE>
91
<TR><TD><A NAME="htoc58"><B><FONT SIZE=5>7.2</FONT></B></A></TD>
92
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=5>Example: ``repeat until'' like in Pascal</FONT></B></TD>
93
</TR></TABLE></DIV></TD>
95
If you read all this tutorial, you are able to understand this
96
complete example. If you did not, just create the files and type the
97
indicated commands.<BR>
101
Write first a file named <CODE>foo.ml</CODE> containing:
106
[[ "repeat"; e1 = expr; "until"; e2 = expr ->
107
<:expr< do { $e1$; while not $e2$ do { $e1$; } } >> ]];
110
The compilation of this file can be done by typing under the shell
111
(the dollar is the shell prompt):
113
$ ocamlc -pp "camlp4o pa_extend.cmo q_MLast.cmo" -I +camlp4 \
116
Here is the file <CODE>bar.ml</CODE> containing a <CODE>repeat..until</CODE> statement:
120
repeat print_int !i; incr i until !i = 10;
124
You can compile it by typing:
126
$ ocamlc -pp "camlp4o ./foo.cmo" bar.ml
133
Or just pretty print the program with the expanded syntax:
135
$ camlp4o ./foo.cmo pr_o.cmo bar.ml
139
begin print_int !i; incr i end;
140
while not (!i = 10) do print_int !i; incr i done;
146
<A NAME="toc50"></A><TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
147
<TR><TD BGCOLOR="#66ff66"><DIV ALIGN=center><TABLE>
148
<TR><TD><A NAME="htoc59"><B><FONT SIZE=5>7.3</FONT></B></A></TD>
149
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=5>Example: a constant</FONT></B></TD>
150
</TR></TABLE></DIV></TD>
152
If you want to have the equivalent of a <CODE>#define</CODE> of C, you can
153
write for example, if you want <CODE>FOO</CODE> to be replaced by <CODE>54</CODE>
154
in expressions and patterns:
159
[[ UIDENT "FOO" -> <:expr< 54 >> ]];
161
[[ UIDENT "FOO" -> <:patt< 54 >> ]];
164
The compilation of this file can be done by typing:
166
$ ocamlc -pp "camlp4o pa_extend.cmo q_MLast.cmo" -I +camlp4 \
169
Here is the file <CODE>bar.ml</CODE> containing <CODE>FOO</CODE> constants:
172
function FOO -> 22;;
174
You can compile it by typing:
176
$ ocamlc -pp "camlp4o ./foo.cmo" bar.ml
178
You can just pretty print the program with the expanded syntax:
180
$ camlp4o ./foo.cmo pr_o.cmo bar.ml
182
function 54 -> 22;;
184
<A NAME="toc51"></A><TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
185
<TR><TD BGCOLOR="#66ff66"><DIV ALIGN=center><TABLE>
186
<TR><TD><A NAME="htoc60"><B><FONT SIZE=5>7.4</FONT></B></A></TD>
187
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=5>Example: a ``for'' loop like in C</FONT></B></TD>
188
</TR></TABLE></DIV></TD>
190
Here is an example of an syntax extension allowing to write a ``for''
191
loop like in C. A construction is added with the loop variable and 3
192
parameters, simple expressions: the first one is the initial value,
193
the second the test, the third the way to change the loop variable.<BR>
197
Note that we use here the directives <CODE>#load</CODE> inside the source of
198
the syntax extension, allowing to parse it with <CODE>camlp4o</CODE> without
199
having to specify these files in the command line.<BR>
205
#load "q_MLast.cmo";;
206
#load "pa_extend.cmo";;
213
let x = incr cnt; !cnt in
214
var ^ "_gensym" ^ string_of_int x
216
let gen_for loc v iv wh nx e =
217
let loop_fun = gensym "iter" in
219
let rec $lid:loop_fun$ $lid:v$ =
220
if $wh$ then do { $e$; $lid:loop_fun$ $nx$ } else ()
222
$lid:loop_fun$ $iv$ >>
226
[ [ "for"; v = LIDENT; iv = expr LEVEL "simple";
227
wh = expr LEVEL "simple"; nx = expr LEVEL "simple";
228
"do"; e = expr; "done" ->
229
gen_for loc v iv wh nx e ] ]
233
Compile this file with:
235
$ ocamlc -pp camlp4o -I +camlp4 -c cloop.ml
237
Example under the toplevel:
240
Objective Caml version 3.02+7 (2001-09-29)
242
# #load "camlp4o.cma";;
243
Camlp4 Parsing version 3.02+7 (2001-09-29)
245
# #load "cloop.cmo";;
246
# for i = 0 to 10 do print_int i; done;; (* normal loop *)
247
012345678910- : unit = ()
248
# for c 0 (c<10) (c+1) do print_int c; done;;
249
0123456789- : unit = ()
250
# for c 0 (c<10) (c+3) do print_int c; done;;
253
Exemple of compilation of a program using this construction:
256
for c 0 (c<10) (c+2) do print_int c; done
257
$ ocamlc -pp "camlp4o ./cloop.cmo" -c foo.ml
259
And if you want to see the generated program (for example to check
260
that the extension is correct):
262
$ camlp4o ./cloop.cmo pr_o.cmo foo.ml
263
let rec iter_gensym1 c =
264
if c < 10 then begin print_int c; iter_gensym1 (c + 2) end
268
<A NAME="toc52"></A><TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
269
<TR><TD BGCOLOR="#66ff66"><DIV ALIGN=center><TABLE>
270
<TR><TD><A NAME="htoc61"><B><FONT SIZE=5>7.5</FONT></B></A></TD>
271
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=5>Example: generating printers of types</FONT></B></TD>
272
</TR></TABLE></DIV></TD>
274
We are going to define a syntax extension, so that for all types
275
definitions, the definition of printers of the values of this types
276
is automatically added. In this example, we limit to sum types (types
277
with constructors), but it can be easily extensible for record types,
278
abstract types, types renaming.<BR>
280
<TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
281
<TR><TD BGCOLOR="#7fff7f"><DIV ALIGN=center><TABLE>
282
<TR><TD><A NAME="htoc62"><B><FONT SIZE=4>7.5.1</FONT></B></A></TD>
283
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=4>First version: monomorphic sum types with constant constructors</FONT></B></TD>
284
</TR></TABLE></DIV></TD>
286
The example, which is going to be our test, is the following file
287
``<CODE>col.ml</CODE>'':
289
type colour = Red | Green | Blue
291
We want that, when preprocessed with the correct syntax extension,
292
this file be interpreted like this:
294
type colour = Red | Green | Blue
297
Red -> print_string "Red"
298
| Green -> print_string "Green"
299
| Blue -> print_string "Blue"
301
The syntax extension will be defined in the following file
302
``<CODE>pa_type.ml</CODE>''. As a beginning, let us just see how we insert
303
the grammar rule. The function ``<CODE>gen_print_funs</CODE>'' generating
304
the printer functions just generates a phony statement:
306
#load "pa_extend.cmo";;
307
#load "q_MLast.cmo";;
309
let gen_print_funs loc tdl =
310
<:str_item< not yet implemented >>
315
[ [ "type"; tdl = LIST1 Pcaml.type_declaration SEP "and" ->
316
let si1 = <:str_item< type $list:tdl$ >> in
317
let si2 = gen_print_funs loc tdl in
318
<:str_item< declare $si1$; $si2$; end >> ] ]
322
Remark the ``<CODE>declare</CODE>'' statement in the ``<CODE>str_item</CODE>''
323
syntax tree at the end of this file, destinated to group two structure
324
items together: 1/ the type definition 2/ the printer.<BR>
328
This file can be compiled like this:
330
$ ocamlc -pp camlp4o -I +camlp4 -c pa_type.ml
332
We can test the example file, ``<CODE>col.ml</CODE>'', but not yet with the
333
compiler, since it would generate semantic error because of the ``not
334
yet implemented'' statement. Let us test it therefore with a pretty
337
$ camlp4o ./pa_type.cmo pr_o.cmo col.ml
338
<W> Grammar extension: in [str_item], some rule has been masked
343
let _ = not yet implemented
345
See the extra generated statement ``not yet implemented''. You remark,
346
also, that there is a warning in the beginning: it means that the
347
syntax rule we added in <CODE>str_item</CODE> was already present in the
352
To avoid such a warning message, the solution is to add, before the
353
<CODE>EXTEND</CODE> statement, a <CODE>DELETE_RULE</CODE> statement:
356
Pcaml.str_item: "type"; LIST1 Pcaml.type_declaration SEP "and"
359
Let us attack now the function <CODE>gen_print_funcs</CODE>. It receives a
360
list (since the ``<CODE>type</CODE>'' declaration can define several types,
361
possibly mutually recursive) of types definitions. We know that we
362
have to generate a definition, recursive, with as many printing
363
functions as types. The following function,
364
<CODE>gen_one_type_print_fun</CODE>, will generate the printer for one type
365
definition. For the moment, the body is a ``not yet implemented''
368
let fun_name n = "print_" ^ n
370
let gen_one_print_fun loc ((loc, n), tpl, tk, cl) =
371
<:patt< $lid:fun_name n$ >>, <:expr< not yet implemented >>
373
let gen_print_funs loc tdl =
374
let pel = List.map (gen_one_print_fun loc) tdl in
375
<:str_item< value rec $list:pel$ >>
377
Recompile the syntax expander file with these functions and test with
378
``<CODE>col.ml</CODE>'': you can see a function named ``<CODE>print_colour</CODE>''.<BR>
382
Let use improve now ``<CODE>gen_one_print_fun</CODE>''. It has to generate a
383
let binding definition, composed of the couple of a pattern (the name
384
of the function) and an expression. Our function receives as parameter
385
a type definition which is a t-uple of 4 values: 1/ the type name
386
(with his location), 2/ the list of its possible parameters, 3/ the
387
type kind (a type, actually) and 4/ a list of possible constraints.<BR>
391
In a first version, we are going to ignore the type parameters
392
``<CODE>tpl</CODE>'': we see later how they intervene in the generated
393
function and our code will work, for the moment, only for monomorphic
398
We limit also to the ``sum'' types (i.e. types with constructors); for
399
other types kinds, we shall generate a function which fails.<BR>
403
We added the function ``<CODE>gen_print_sum</CODE>'' which treats a sum type
404
by generating a match association for each constructor (function
405
``<CODE>gen_print_cons</CODE>'') and building the function with the
410
That function ``<CODE>gen_print_cons</CODE>'' gets a constructor definition,
411
i.e. a tuple with: 1/ a location, 2/ a string (the constructor name)
412
and 3/ a list of types parameters (ctyp list). We ignore for the
413
moments the constructors parameters. The function
414
``<CODE>gen_print_cons_patt</CODE>'' generates the pattern part of the case,
415
and ``<CODE>gen_print_cons_expr</CODE>'' the expression part of the
416
function, the print statement:<BR>
420
Here is a first (but complete) version of our syntax extension (file
421
``<CODE>pa_type.ml</CODE>''):
423
#load "pa_extend.cmo";;
424
#load "q_MLast.cmo";;
426
let fun_name n = "print_" ^ n
428
let gen_print_cons_patt loc c tl =
429
<:patt< $uid:c$ >>
431
let gen_print_cons_expr loc c tl =
432
<:expr< print_string $str:c$ >>
434
let gen_print_cons (loc, c, tl) =
435
let p = gen_print_cons_patt loc c tl in
436
let e = gen_print_cons_expr loc c tl in
439
let gen_print_sum loc cdl =
440
let pwel = List.map gen_print_cons cdl in
441
<:expr< fun [ $list:pwel$ ] >>
443
let gen_one_print_fun loc ((loc, n), tpl, tk, cl) =
446
<:ctyp< [ $list:cdl$ ] >> -> gen_print_sum loc cdl
447
| _ -> <:expr< fun _ -> failwith $str:fun_name n$ >>
449
<:patt< $lid:fun_name n$ >>, body
451
let gen_print_funs loc tdl =
452
let pel = List.map (gen_one_print_fun loc) tdl in
453
<:str_item< value rec $list:pel$ >>
457
Pcaml.str_item: "type"; LIST1 Pcaml.type_declaration SEP "and"
461
[ [ "type"; tdl = LIST1 Pcaml.type_declaration SEP "and" ->
462
let si1 = <:str_item< type $list:tdl$ >> in
463
let si2 = gen_print_funs loc tdl in
464
<:str_item< declare $si1$; $si2$; end >> ] ]
468
We can recompile this version, and test on the example file
469
``<CODE>col.ml</CODE>'' by pretty printing the result:
471
$ ocamlc -pp camlp4o -I +camlp4 -c pa_type.ml
472
$ camlp4o ./pa_type.cmo pr_o.cmo col.ml
477
let rec print_colour =
479
Red -> print_string "Red"
480
| Green -> print_string "Green"
481
| Blue -> print_string "Blue"
483
It is what we wanted! This can be used, now, directly with the
484
compiler without the pretty printing phase:
486
$ ocamlc -pp "camlp4o ./pa_type.cmo" -c col.ml
488
We could also add the directive ``<CODE>#load "./pa_type.cmo";;</CODE>'' in
489
the beginning of ``<CODE>col.ml</CODE>'' and just compile with:
491
$ ocamlc -pp camlp4o -c col.ml
493
but it is not a good idea, since we may want to use the same source
494
with the preprocessing or without it.<BR>
496
<TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
497
<TR><TD BGCOLOR="#7fff7f"><DIV ALIGN=center><TABLE>
498
<TR><TD><A NAME="htoc63"><B><FONT SIZE=4>7.5.2</FONT></B></A></TD>
499
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=4>Second version: constructors with parameters</FONT></B></TD>
500
</TR></TABLE></DIV></TD>
502
Let us add the case of sum types having constructors with
503
parameters. Our example for testing that will be the definition of
504
lambda terms of section <A HREF="tutorial004.html#lambda terms">4.7</A>. File ``<CODE>term.ml</CODE>'':
508
| Func of string * term
509
| Appl of term * term
511
The desired result should be something like this:
515
| Func of string * term
516
| Appl of term * term
520
print_string "Var"; print_string " ("; print_string x1;
522
| Func (x1, x2) ->
523
print_string "Func"; print_string " ("; print_string x1
524
print_string ", "; print_term x2; print_string ")"
525
| Appl (x1, x2) ->
526
print_string "Appl"; print_string " ("; print_term x1
527
print_string ", "; print_term x2; print_string ")"
529
Like in the above desired result, we decide to name the parameters
530
with ``<CODE>x</CODE>'' followed by the number of the parameter, defined by
531
the following function ``<CODE>param_name</CODE>'':
533
let param_name cnt = "x" ^ string_of_int cnt
535
We need a function ``<CODE>list_mapi</CODE>'', which is like
536
``<CODE>List.map</CODE>'' but the function applied receives the number of
537
the list element as first parameter. This allows us to generate the
538
name of the constructor parameter while exploring the type list:
543
x :: l -> f cnt x :: loop (cnt + 1) l
548
The function ``<CODE>gen_print_cons_patt</CODE>'' which treats the pattern
549
part of the match association, is changed like this:
551
let gen_print_cons_patt loc c tl =
553
list_mapi (fun n _ -> <:patt< $lid:param_name n$ >>)
556
List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>)
557
<:patt< $uid:c$ >> pl
559
With these changes, the pattern part of the generated function
560
``<CODE>print_term</CODE>'' is correct. Test it.<BR>
564
For the expression part, we have to generate the call to the printers
565
for all the constructors parameters. We add a function
566
``<CODE>gen_print_type</CODE>'' to generate a printer associated with a
567
type. For the moment, it just generates it for a simple type name. For
568
other types, it generates a printer displaying an ellipsis:
570
let gen_print_type loc =
572
<:ctyp< $lid:s$ >> -> <:expr< $lid:fun_name s$ >>
573
| _ -> <:expr< fun _ -> print_string "..." >>
575
We need also a function which generates the call to this printer
576
function with the constructor parameter:
578
let gen_call loc n f = <:expr< $f$ $lid:param_name n$ >>
580
and a function adding the extra syntax: spaces, parentheses and
583
let gen_print_con_extra_syntax loc el =
586
[] | [_] as e -> e
587
| e :: el -> e :: <:expr< print_string ", " >> :: loop el
589
<:expr< print_string " (" >> :: loop el @
590
[<:expr< print_string ")" >>]
592
Now, we can change the function ``<CODE>gen_print_cons_expr</CODE>'' using
595
let gen_print_cons_expr loc c tl =
596
let pr_con = <:expr< print_string $str:c$ >> in
601
let type_funs = List.map (gen_print_type loc) tl in
602
list_mapi (gen_call loc) type_funs
604
let pr_all = gen_print_con_extra_syntax loc pr_params in
605
let el = pr_con :: pr_all in
606
<:expr< do { $list:el$ } >>
608
Grouping all these functions together, you can make a second version
609
of ``<CODE>pa_type.ml</CODE>'' which works with the file ``<CODE>term.ml</CODE>''.
610
Test it! Try it also with your own programs having sum type definitions.<BR>
612
<TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
613
<TR><TD BGCOLOR="#7fff7f"><DIV ALIGN=center><TABLE>
614
<TR><TD><A NAME="htoc64"><B><FONT SIZE=4>7.5.3</FONT></B></A></TD>
615
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=4>Third version: polymorphic types</FONT></B></TD>
616
</TR></TABLE></DIV></TD>
618
This time, we are going to generate the good code for polymorphic
619
types, i.e. types defined with types variables. Our example will be
620
the definition of the type ``<CODE>mlist</CODE>'' like this. File
621
``<CODE>mlist.ml</CODE>'':
623
type 'a mlist = Nil | Cons of 'a * 'a mlist
625
The printer of such a type will receive as parameter the print
626
functions of the instantiated type. As many as the type has type
627
variables. We can then call ``<CODE>print_mlist</CODE>
628
<CODE>print_int</CODE>'' for an ``<CODE>int mlist</CODE>'', ``<CODE>print_mlist</CODE>
629
<CODE>print_string</CODE>'' for a ``<CODE>string mlist</CODE>'' and so on.<BR>
633
The desired result for the type ``<CODE>mlist</CODE>'' is:
635
type 'a mlist = Nil | Cons of 'a * 'a mlist
636
let rec print_mlist pr_a =
638
Nil -> print_string "Nil"
639
| Cons (x1, x2) ->
640
print_string "Cons"; print_string " ("; pr_a x1;
641
print_string ", "; print_mlist pr_a x2; print_string ")"
643
The name of the printer function for a type variable will be
644
``<CODE>pr_</CODE>'' followed by the type variable name:
646
let fun_param_name n = "pr_" ^ n
648
To add the function parameters to the printer definition (``<CODE>let</CODE>
649
<CODE>print_mlist</CODE> <CODE>pr_a</CODE> <CODE>= ...</CODE>'' in our example), we
650
change our function ``<CODE>gen_one_print_func</CODE>'' by inserting them in
651
the body of the function, just before its result, like this:
656
<:expr< fun $lid:fun_param_name v$ -> $e$ >>)
660
For the printing of a type variable (``<CODE>pr_a</CODE> <CODE>x1</CODE>'' in our
661
example), we add the case of type variables in our function
662
``<CODE>gen_print_type</CODE>'':
664
| <:ctyp< '$s$ >> -> <:expr< $lid:fun_param_name s$ >>
666
And to generate the printing of types with parameters (we have a
667
recursive case in our example: ``<CODE>print_mlist</CODE> <CODE>pr_a</CODE>
668
<CODE>x2</CODE>'' for the constructor parameter of type ``<CODE>'a</CODE>
669
<CODE>mlist</CODE>''), we add, in the same function, the case of types
670
applications. But since it needs a recursive call, the function
671
``<CODE>gen_print_type</CODE>'' is rewritten with a internal recursive
676
Here is the complete version:
678
#load "pa_extend.cmo";;
679
#load "q_MLast.cmo";;
681
let fun_name n = "print_" ^ n
682
let fun_param_name n = "pr_" ^ n
683
let param_name cnt = "x" ^ string_of_int cnt
688
x :: l -> f cnt x :: loop (cnt + 1) l
693
let gen_print_type loc t =
696
<:ctyp< $t1$ $t2$ >> -> <:expr< $eot t1$ $eot t2$ >>
697
| <:ctyp< $lid:s$ >> -> <:expr< $lid:fun_name s$ >>
698
| <:ctyp< '$s$ >> -> <:expr< $lid:fun_param_name s$ >>
699
| _ -> <:expr< fun _ -> print_string "..." >>
703
let gen_call loc n f = <:expr< $f$ $lid:param_name n$ >>
705
let gen_print_cons_patt loc c tl =
707
list_mapi (fun n _ -> <:patt< $lid:param_name n$ >>)
710
List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>)
711
<:patt< $uid:c$ >> pl
713
let gen_print_con_extra_syntax loc el =
716
[] | [_] as e -> e
717
| e :: el -> e :: <:expr< print_string ", " >> :: loop el
719
<:expr< print_string " (" >> :: loop el @
720
[<:expr< print_string ")" >>]
722
let gen_print_cons_expr loc c tl =
723
let pr_con = <:expr< print_string $str:c$ >> in
728
let type_funs = List.map (gen_print_type loc) tl in
729
list_mapi (gen_call loc) type_funs
731
let pr_all = gen_print_con_extra_syntax loc pr_params in
732
let el = pr_con :: pr_all in
733
<:expr< do { $list:el$ } >>
735
let gen_print_cons (loc, c, tl) =
736
let p = gen_print_cons_patt loc c tl in
737
let e = gen_print_cons_expr loc c tl in
740
let gen_print_sum loc cdl =
741
let pwel = List.map gen_print_cons cdl in
742
<:expr< fun [ $list:pwel$ ] >>
744
let gen_one_print_fun loc ((loc, n), tpl, tk, cl) =
747
<:ctyp< [ $list:cdl$ ] >> -> gen_print_sum loc cdl
748
| _ -> <:expr< fun _ -> failwith $str:fun_name n$ >>
753
<:expr< fun $lid:fun_param_name v$ -> $e$ >>)
756
<:patt< $lid:fun_name n$ >>, body
758
let gen_print_funs loc tdl =
759
let pel = List.map (gen_one_print_fun loc) tdl in
760
<:str_item< value rec $list:pel$ >>
764
Pcaml.str_item: "type"; LIST1 Pcaml.type_declaration SEP "and"
768
[ [ "type"; tdl = LIST1 Pcaml.type_declaration SEP "and" ->
769
let si1 = <:str_item< type $list:tdl$ >> in
770
let si2 = gen_print_funs loc tdl in
771
<:str_item< declare $si1$; $si2$; end >> ] ]
775
<TABLE CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
776
<TR><TD BGCOLOR="#7fff7f"><DIV ALIGN=center><TABLE>
777
<TR><TD><A NAME="htoc65"><B><FONT SIZE=4>7.5.4</FONT></B></A></TD>
778
<TD WIDTH="100%" ALIGN=center><B><FONT SIZE=4>Improvements</FONT></B></TD>
779
</TR></TABLE></DIV></TD>
781
It is possible to add, the same way, the other kind of types: record
782
types, abstract types, and so on.<BR>
786
Another interesting improvement is to generate, instead of
787
``<CODE>print_string</CODE>'' statements, functions of the
788
``<CODE>Format</CODE>'' library, with pretty printing boxes.<BR>
792
Further, that version can be still improved, by generating only one
793
``<CODE>Format.fprintf</CODE>'' by printing case (instead of a sequence of
794
printing statements), using the very useful abbreviations provided by
795
that library by the prefixes ``<CODE>@</CODE>'' inside the format strings.
798
<I><FONT COLOR=maroon>
800
For remarks about Camlp4, write to:
801
<img src="http://cristal.inria.fr/~ddr/images/email.jpg" alt=email align=top>
803
<A HREF="tutorial006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
804
<A HREF="index.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
805
<A HREF="tutorial008.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
added
removed
camlp4-tutorial.html/tutorial007.html
