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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
open Types
open Common
let bpos = -1, -1
let msg_with_pos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg
let die_with_pos raw_pos msg = failwith (msg_with_pos raw_pos msg)
let warn raw_pos msg = prerr_endline (msg_with_pos raw_pos msg)
let die_rule msg = die_with_pos (Parsing.symbol_start(), Parsing.symbol_end()) msg
let debug msg = if false then prerr_endline msg
let raw_pos2pos(a, b) = !Info.current_file, a, b
let get_pos (_, (_, pos)) = raw_pos2pos pos
let warn_too_many_space start = warn (start, start) "you should have only one space here"
let warn_no_space start = warn (start, start) "you should have a space here"
let warn_cr start = warn (start, start) "you should not have a carriage-return (\\n) here"
let warn_space start = warn (start, start) "you should not have a space here"
let sp_0(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0 -> ()
| Space_1
| Space_n -> warn_space start
| Space_cr -> warn_cr start
let sp_0_or_cr(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0 -> ()
| Space_1
| Space_n -> warn_space start
| Space_cr -> ()
let sp_1(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0 -> warn_no_space start
| Space_1 -> ()
| Space_n -> warn_too_many_space start
| Space_cr -> warn_cr start
let sp_n(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0 -> warn_no_space start
| Space_1 -> ()
| Space_n -> ()
| Space_cr -> warn_cr start
let sp_p(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0 -> warn_no_space start
| Space_1 -> ()
| Space_n -> ()
| Space_cr -> ()
let sp_cr(_, (spaces, (start, _))) =
match spaces with
| Space_none -> ()
| Space_0
| Space_1
| Space_n -> warn (start, start) "you should have a carriage-return (\\n) here"
| Space_cr -> ()
let not_complex = function
| Call_op("?:", _) -> false
| _ -> true
let string_of_Ident = function
| Ident(None, s, _) -> s
| Ident(Some fq, s, _) -> fq ^ "::" ^ s
| _ -> internal_error "string_of_Ident"
let check_parenthesized_first_argexpr word (e, (_, (start, _)) as ex) =
let want_space = word.[0] = '-' in
match e with
| List[List[_]] :: l ->
if want_space then
if l = [] then sp_n(ex) else die_with_pos (start, start) "can't handle this nicely"
else
if l = [] then sp_0(ex) else die_with_pos (start, start) "you must not have a space here"
| _ -> sp_p(ex)
let check_foreach (s, (_, pos)) = if s = "for" then warn pos "write \"foreach\" instead of \"for\""
let check_for (s, (_, pos)) = if s = "foreach" then warn pos "write \"for\" instead of \"foreach\""
let check_no_paren f_name (e, (_, pos)) =
match e with
| List[List[List[e]]] when not_complex e -> warn pos (Printf.sprintf "''... %s (...)'' can be written ''... %s ...''" f_name f_name)
| _ -> ()
let to_Ident ((fq, name), (_, pos)) = Ident(fq, name, raw_pos2pos pos)
let to_String (s, (_, pos)) = String(s, raw_pos2pos pos)
let rec only_one (l, (spaces, pos)) =
match l with
| [List l'] -> only_one (l', (spaces, pos))
| [e] -> e
| [] -> die_with_pos pos "you must give one argument"
| _ -> die_with_pos pos "you must give only one argument"
let only_one_in_List (e, both) =
match e with
| List l -> only_one(l, both)
| _ -> e
let array_ident_to_hash_ident (e, (_, pos)) =
match e with
| Deref(I_array, e) -> Deref(I_hash, e)
| _ -> die_with_pos pos "internal error (array_ident_to_hash_ident)"
let from_PATTERN ((s, opts), (_, pos)) = [ String(s, raw_pos2pos pos) ; String(opts, raw_pos2pos pos) ]
let from_PATTERN_SUBST ((s1, s2, opts), (_, pos)) = [ String(s1, raw_pos2pos pos) ; String(s2, raw_pos2pos pos) ; String(opts, raw_pos2pos pos) ]
let to_List = function
| [e] -> e
| l -> List l
let sub_declaration (name, proto) body = Sub_declaration(name, proto, body)
let var_dollar_ = Deref(I_scalar, Ident(None, "_", raw_pos2pos bpos))
let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos))
|
