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
open Lang
module Make (M : sig
val get_old_name : string -> string
module Error : sig
exception Scope_too_large of string
end
end) =
struct
let is_used id e =
let rec is_used = function
| Const (Var x) when x = id ->
true
| Const _ ->
false
| Apply (e1, e2) ->
is_used e1 || is_used e2
| Bind (_, e1, e2) ->
is_used e1 || is_used e2
| Abstract (_, _, e) ->
is_used e
| Match (_orig, match_expr, cases) ->
List.fold_left
(fun acc e -> acc || is_used e)
(is_used match_expr) (List.map snd cases)
| Type (_id, _cons, e) ->
is_used e
in
is_used e
let is_used_directly id e =
let is_used = is_used id in
let is_used_directly = function
| Const _ as e ->
is_used e
| Bind (_, _, e2) ->
is_used e2
| Abstract (_, _, _) ->
false
| Apply (e1, e2) ->
let ue1 = is_used e1 in
let ue2 = is_used e2 in
ue1 && ue2
| Match (_orig, match_expr, cases) ->
let count = ref 0 in
List.iter
(fun el -> if is_used el then incr count)
(match_expr :: List.map snd cases) ;
!count >= 2
| Type (_id, _cons, e) ->
is_used e
in
is_used_directly e
let rec expr = function
| Const _ ->
()
| Bind (id, e1, e2) ->
if not (is_used_directly id e2) then
raise @@ M.Error.Scope_too_large (M.get_old_name id) ;
expr_list [e1; e2]
| Abstract (_, _, e) ->
expr e
| Apply (e1, e2) ->
expr_list [e1; e2]
| Match (_origin, e, cases) ->
expr_list (e :: List.map snd cases)
| Type (_id, _cons, e) ->
expr e
and expr_list l = List.iter expr l
end