← Back to branch summary

~npalix/coccinelle/upstream

« back to all changes in this revision

Viewing changes to bundles/stdcompat/stdcompat-8/stdcompat__arg.ml.in

  • Committer: Thierry Martinez
  • Date: 2019-08-20 13:37:04 UTC
  • Revision ID: git-v1:0214afad4a32c95349c2c5a38e37cea407c455d0
Update bundles

Show diffs side-by-side

added added

removed removed

Lines of Context:
bundles/stdcompat/stdcompat-8/stdcompat__arg.ml.in
1
 
@BEGIN_FROM_4_05_0@
2
 
include Arg
3
 
@END_FROM_4_05_0@
4
 
@BEGIN_BEFORE_4_05_0@
5
 
exception Help of string
6
 
 
7
 
exception Bad of string
8
 
 
9
 
let not_implemented () =
10
 
  failwith "Stdcompat.Arg is not fully implemented yet. Please fill an issue: https://github.com/thierry-martinez/stdcompat/issues ."
11
 
 
12
 
type spec =
13
 
  | Unit of (unit -> unit)
14
 
  | Bool of (bool -> unit)
15
 
  | Set of bool ref
16
 
  | Clear of bool ref
17
 
  | String of (string -> unit)
18
 
  | Set_string of string ref
19
 
  | Int of (int -> unit)
20
 
  | Set_int of int ref
21
 
  | Float of (float -> unit)
22
 
  | Set_float of float ref
23
 
  | Tuple of spec list
24
 
  | Symbol of string list * (string -> unit)
25
 
  | Rest of (string -> unit)
26
 
  | Expand of (string -> string array)
27
 
 
28
 
type key = string
29
 
 
30
 
type doc = string
31
 
 
32
 
type usage_msg = string
33
 
 
34
 
type anon_fun = string -> unit
35
 
 
36
 
let rec no_expand spec =
37
 
  match spec with
38
 
  | Unit f -> Arg.Unit f
39
 
  | Bool f -> Arg.Bool f
40
 
  | Set r -> Arg.Set r
41
 
  | Clear c -> Arg.Clear c
42
 
  | String f -> Arg.String f
43
 
  | Set_string r -> Arg.Set_string r
44
 
  | Int f -> Arg.Int f
45
 
  | Set_int r -> Arg.Set_int r
46
 
  | Float f -> Arg.Float f
47
 
  | Set_float r -> Arg.Set_float r
48
 
  | Tuple l -> Arg.Tuple (List.map no_expand l)
49
 
  | Symbol (l, f) -> Arg.Symbol (l, f)
50
 
  | Rest f -> Arg.Rest f
51
 
  | Expand _ -> not_implemented ()
52
 
 
53
 
let rec expand spec =
54
 
  match spec with
55
 
  | Arg.Unit f -> Unit f
56
 
  | Arg.Bool f -> Bool f
57
 
  | Arg.Set r -> Set r
58
 
  | Arg.Clear c -> Clear c
59
 
  | Arg.String f -> String f
60
 
  | Arg.Set_string r -> Set_string r
61
 
  | Arg.Int f -> Int f
62
 
  | Arg.Set_int r -> Set_int r
63
 
  | Arg.Float f -> Float f
64
 
  | Arg.Set_float r -> Set_float r
65
 
  | Arg.Tuple l -> Tuple (List.map expand l)
66
 
  | Arg.Symbol (l, f) -> Symbol (l, f)
67
 
  | Arg.Rest f -> Rest f
68
 
 
69
 
let no_expand_list l =
70
 
  List.map (fun (k, s, d) -> k, no_expand s, d) l
71
 
 
72
 
let expand_list l =
73
 
  List.map (fun (k, s, d) -> k, expand s, d) l
74
 
 
75
 
@BEGIN_FROM_3_12_0@
76
 
let usage_string l msg =
77
 
  Arg.usage_string (no_expand_list l) msg
78
 
@END_FROM_3_12_0@
79
 
@BEGIN_BEFORE_3_12_0@
80
 
let usage_string l msg =
81
 
  not_implemented ()
82
 
@END_BEFORE_3_12_0@
83
 
 
84
 
@BEGIN_FROM_3_08_0@
85
 
let align ?limit l =
86
 
  expand_list (Arg.align (no_expand_list l))
87
 
@END_FROM_3_08_0@
88
 
@BEGIN_BEFORE_3_08_0@
89
 
let align ?limit l =
90
 
  not_implemented ()
91
 
@END_BEFORE_3_08_0@
92
 
 
93
 
let parse l anon msg =
94
 
  Arg.parse (no_expand_list l) anon msg
95
 
 
96
 
let parse_argv ?current argv l anon msg =
97
 
  Arg.parse_argv ?current argv (no_expand_list l) anon msg
98
 
 
99
 
let usage l msg =
100
 
  Arg.usage (no_expand_list l) msg
101
 
 
102
 
let current = Arg.current
103
 
 
104
 
let read_aux trim sep file =
105
 
  let channel = open_in_bin file in
106
 
  try
107
 
    let buffer = Buffer.create 20 in
108
 
    let accu = ref [] in
109
 
    let push () =
110
 
      let s = Buffer.contents buffer in
111
 
      let s =
112
 
        if trim && s <> "" && s.[String.length s - 1] = '\r' then
113
 
          String.sub s 0 (String.length s - 1)
114
 
        else
115
 
          s in
116
 
      accu := s :: !accu in
117
 
    try
118
 
      while true do
119
 
        let c = input_char channel in
120
 
        if c = sep then
121
 
          begin
122
 
            push ();
123
 
            Buffer.clear buffer
124
 
          end
125
 
        else
126
 
          Buffer.add_char buffer c
127
 
      done;
128
 
      assert false
129
 
    with End_of_file ->
130
 
      if Buffer.length buffer > 0 then
131
 
        push ();
132
 
      close_in channel;
133
 
      Array.of_list (List.rev !accu)
134
 
  with e ->
135
 
    close_in_noerr channel;
136
 
    raise e
137
 
 
138
 
let read_arg =
139
 
  read_aux true '\n'
140
 
 
141
 
let read_arg0 =
142
 
  read_aux false '\x00'
143
 
 
144
 
let write_aux sep file args =
145
 
  let channel = open_out_bin file in
146
 
  try
147
 
    Array.iter (fun s -> Printf.fprintf channel "%s%c" s sep) args
148
 
  with e ->
149
 
    close_out_noerr channel;
150
 
    raise e
151
 
 
152
 
let write_arg =
153
 
  write_aux '\n'
154
 
 
155
 
let write_arg0 =
156
 
  write_aux '\x00'
157
 
 
158
 
let parse_argv_dynamic ?current _ =
159
 
  not_implemented ()
160
 
 
161
 
let parse_dynamic _ =
162
 
  not_implemented ()
163
 
 
164
 
let parse_expand _ =
165
 
  not_implemented ()
166
 
 
167
 
let parse_and_expand_argv_dynamic _ =
168
 
  not_implemented ()
169
 
@END_BEFORE_4_05_0@