1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
(* $Id: pr_local.ml,v 1.2 2007/01/03 09:42:46 deraugla Exp $ *)
(* Copyright (c) 2001-2007 INRIA *)
#load "q_MLast.cmo";
#load "pa_extfun.cmo";
open Pcaml;
open Spretty;
value _loc = Token.dummy_loc;
value expr e dg k = pr_expr.pr_fun "top" e dg k;
value patt e dg k = pr_patt.pr_fun "top" e dg k;
value expr_fun_args ge = Extfun.apply pr_expr_fun_args.val ge;
value is_local_def p pel1 pel2 e =
try
let dl1 =
let pl =
match p with
[ <:patt< ($list:pl$) >> -> pl
| p -> [p] ]
in
List.map (fun [ <:patt< $lid:s$ >> -> s | _ -> raise Not_found ]) pl
in
let (dl2, el) =
let (pl, el) = List.split pel2 in
let dl2 =
List.map (fun [ <:patt< $lid:s$ >> -> s | _ -> raise Not_found ]) pl
in
(dl2, el)
in
let dl3 =
let el =
match e with
[ <:expr< ($list:el$) >> -> el
| e -> [e] ]
in
List.map (fun [ <:expr< $lid:s$ >> -> s | _ -> raise Not_found ]) el
in
dl1 = dl2 && dl1 = dl3
with
[ Not_found -> False ]
;
value rec list elem =
fun
[ [] -> fun _ k -> k
| [x] -> fun dg k -> [: `elem x dg k :]
| [x :: l] -> fun dg k -> [: `elem x "" [: :]; list elem l dg k :] ]
;
value rec listwbws elem b sep el k =
match el with
[ [] -> [: b; k :]
| [x] -> [: `elem b x k :]
| [x :: l] -> [: `elem b x [: :]; listwbws elem [: `sep :] sep l k :] ]
;
value rec bind_list b pel k =
match pel with
[ [pe] -> let_binding b pe k
| pel ->
Vbox [: `HVbox [: :]; listwbws let_binding b (S LR "and") pel k :] ]
and let_binding b (p, e) k =
BEbox [: let_binding0 [: b; `patt p "" [: :] :] e [: :]; k :]
and let_binding0 b e k =
let (pl, e) = expr_fun_args e in
[: `HVbox [: `HVbox b; `HOVbox (list patt pl "" [: `S LR "=" :]) :];
`expr e "" k :]
;
let lev = find_pr_level "top" pr_str_item.pr_levels in
lev.pr_rules :=
extfun lev.pr_rules with
[ <:str_item< value $p$ = let $p1$ = $e1$ in let $list:pel2$ in $e$ >>
when is_local_def p [(p1, e1)] pel2 e ->
fun curr next _ k ->
let pel1 = [(p1, e1)] in
let r = [: :] in
[: `Vbox
[: `HVbox [: :];
`bind_list [: `S LR "local"; r :] pel1 [: `S LR "in" :];
curr <:str_item< value $list:pel2$ >> "" k :] :] ];
|
