My working unpac space for OCaml projects in development
Merge opam/patches/ocaml-syntax-shims
+481
+1
vendor/opam/ocaml-syntax-shims/.ocamlformat
+1
vendor/opam/ocaml-syntax-shims/.ocamlformat
···
1
+
version=0.12
+4
vendor/opam/ocaml-syntax-shims/CHANGES.md
+4
vendor/opam/ocaml-syntax-shims/CHANGES.md
+21
vendor/opam/ocaml-syntax-shims/LICENSE.md
+21
vendor/opam/ocaml-syntax-shims/LICENSE.md
···
1
+
The MIT License
2
+
3
+
Copyright (c) 2016 Jane Street Group, LLC <opensource@janestreet.com>
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+17
vendor/opam/ocaml-syntax-shims/README.md
+17
vendor/opam/ocaml-syntax-shims/README.md
···
1
+
ocaml-syntax-shims
2
+
==================
3
+
4
+
This package provides a small utility that backports some of the newer
5
+
OCaml syntax to older OCaml compilers. This allows adopting new
6
+
features such as `let+` while still keeping compatibility with older
7
+
OCaml compiler.
8
+
9
+
To use it, simply depend on this package and add the following field
10
+
to your `library` or `executable` stanzas in your `dune` files:
11
+
`(preprocess future_syntax)`. For instance:
12
+
13
+
```scheme
14
+
(library
15
+
(name mylib)
16
+
(preprocess future_syntax))
17
+
```
+20
vendor/opam/ocaml-syntax-shims/dune-project
+20
vendor/opam/ocaml-syntax-shims/dune-project
···
1
+
(lang dune 2.0)
2
+
(name ocaml-syntax-shims)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(license "MIT")
7
+
(maintainers jeremie@dimino.org)
8
+
(authors "Jérémie Dimino <jeremie@dimino.org>")
9
+
(source (github ocaml-ppx/ocaml-syntax-shims))
10
+
(documentation https://ocaml-ppx.github.io/ocaml-syntax-shims/)
11
+
12
+
(package
13
+
(name ocaml-syntax-shims)
14
+
(depends
15
+
("ocaml" (>= "4.02.3")))
16
+
(synopsis "Backport new syntax to older OCaml versions")
17
+
(description "\
18
+
This packages backports new features of the language to older
19
+
compilers, such as let+.
20
+
"))
+9
vendor/opam/ocaml-syntax-shims/dune-workspace.dev
+9
vendor/opam/ocaml-syntax-shims/dune-workspace.dev
+32
vendor/opam/ocaml-syntax-shims/ocaml-syntax-shims.opam
+32
vendor/opam/ocaml-syntax-shims/ocaml-syntax-shims.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Backport new syntax to older OCaml versions"
4
+
description: """
5
+
This packages backports new features of the language to older
6
+
compilers, such as let+.
7
+
"""
8
+
maintainer: ["jeremie@dimino.org"]
9
+
authors: ["Jérémie Dimino <jeremie@dimino.org>"]
10
+
license: "MIT"
11
+
homepage: "https://github.com/ocaml-ppx/ocaml-syntax-shims"
12
+
doc: "https://ocaml-ppx.github.io/ocaml-syntax-shims/"
13
+
bug-reports: "https://github.com/ocaml-ppx/ocaml-syntax-shims/issues"
14
+
depends: [
15
+
"dune" {>= "2.0"}
16
+
"ocaml" {>= "4.02.3"}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {pinned}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
dev-repo: "git+https://github.com/ocaml-ppx/ocaml-syntax-shims.git"
+32
vendor/opam/ocaml-syntax-shims/src/dune
+32
vendor/opam/ocaml-syntax-shims/src/dune
···
1
+
(executable
2
+
(name pp)
3
+
(public_name ocaml-syntax-shims)
4
+
(libraries compiler-libs.common))
5
+
6
+
(ocamllex let_trail)
7
+
8
+
(rule
9
+
(with-stdout-to
10
+
impl
11
+
(run ocaml %{dep:select-impl} %{ocaml_version})))
12
+
13
+
(rule
14
+
(with-stdout-to
15
+
shims
16
+
(run ocaml %{dep:select-shims} %{ocaml_version})))
17
+
18
+
(rule
19
+
(copy# pp.%{read:impl}.ml pp.ml))
20
+
21
+
(rule
22
+
(copy# shims.%{read:shims}.ml shims.ml))
23
+
24
+
(rule
25
+
(with-stdout-to
26
+
pp.nop.ml
27
+
(echo "")))
28
+
29
+
(rule
30
+
(with-stdout-to
31
+
shims.nop.ml
32
+
(echo "")))
+1
vendor/opam/ocaml-syntax-shims/src/let_trail.mli
+1
vendor/opam/ocaml-syntax-shims/src/let_trail.mli
···
1
+
val op : Lexing.lexbuf -> string option
+37
vendor/opam/ocaml-syntax-shims/src/let_trail.mll
+37
vendor/opam/ocaml-syntax-shims/src/let_trail.mll
···
1
+
{
2
+
let name = function
3
+
| '!' -> "bang"
4
+
| '$' -> "dollar"
5
+
| '%' -> "percent"
6
+
| '&' -> "ampersand"
7
+
| '*' -> "star"
8
+
| '+' -> "plus"
9
+
| '-' -> "minus"
10
+
| '/' -> "slash"
11
+
| ':' -> "colon"
12
+
| '<' -> "lesser"
13
+
| '=' -> "equal"
14
+
| '>' -> "greater"
15
+
| '?' -> "question"
16
+
| '@' -> "at"
17
+
| '^' -> "circumflex"
18
+
| '|' -> "pipe"
19
+
| _ -> assert false
20
+
21
+
let expand s =
22
+
let buf = Buffer.create 128 in
23
+
for i = 0 to String.length s - 1 do
24
+
if i > 0 then Buffer.add_char buf '_';
25
+
Buffer.add_string buf (name s.[i])
26
+
done;
27
+
Buffer.contents buf
28
+
}
29
+
30
+
let dotsymbolchar =
31
+
['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
32
+
let kwdopchar =
33
+
['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
34
+
35
+
rule op = parse
36
+
| kwdopchar dotsymbolchar* as s { Some (expand s) }
37
+
| "" { None }
+239
vendor/opam/ocaml-syntax-shims/src/pp.real.ml
+239
vendor/opam/ocaml-syntax-shims/src/pp.real.ml
···
1
+
open StdLabels
2
+
open Shims
3
+
4
+
let prog_name = Filename.basename Sys.executable_name
5
+
6
+
let dump_ast = ref false
7
+
8
+
(* Table from positions to custom operators at these positions *)
9
+
let custom_operators = Hashtbl.create 128
10
+
11
+
module Wrap_lexer = struct
12
+
let save_loc = Location.curr
13
+
14
+
let restore_loc (lexbuf : Lexing.lexbuf) (loc : Location.t) =
15
+
lexbuf.lex_start_p <- loc.loc_start;
16
+
lexbuf.lex_curr_p <- loc.loc_end
17
+
18
+
let encode_op (tok : Parser.token) op =
19
+
(match tok with LET -> "let__" | AND -> "and__" | _ -> assert false) ^ op
20
+
21
+
let pending = Queue.create ()
22
+
23
+
let add (x : Parser.token * _) = Queue.push x pending
24
+
25
+
let register_custom_operator tok op (loc1 : Location.t) (loc2 : Location.t) =
26
+
let op = encode_op tok op in
27
+
Hashtbl.add custom_operators loc1.loc_start
28
+
({ loc1 with loc_end = loc2.loc_end }, op)
29
+
30
+
let wrap (lexer : Lexing.lexbuf -> Parser.token) lb =
31
+
if not (Queue.is_empty pending) then (
32
+
let tok, loc = Queue.pop pending in
33
+
restore_loc lb loc;
34
+
tok )
35
+
else
36
+
match lexer lb with
37
+
| (LET | AND) as tok ->
38
+
let loc = save_loc lb in
39
+
( match Let_trail.op lb with
40
+
| None -> ()
41
+
| Some op -> register_custom_operator tok op loc (save_loc lb) );
42
+
restore_loc lb loc;
43
+
tok
44
+
| LPAREN ->
45
+
let loc1 = save_loc lb in
46
+
let tok2 = lexer lb in
47
+
let loc2 = save_loc lb in
48
+
let tok, loc =
49
+
match tok2 with
50
+
| LET | AND -> (
51
+
match Let_trail.op lb with
52
+
| None ->
53
+
add (tok2, loc2);
54
+
(Parser.LPAREN, loc1)
55
+
| Some op -> (
56
+
let loc3 = save_loc lb in
57
+
match lexer lb with
58
+
| RPAREN ->
59
+
( LIDENT (encode_op tok2 op),
60
+
{ loc2 with loc_end = loc3.loc_end } )
61
+
| tok4 ->
62
+
let loc4 = save_loc lb in
63
+
add (tok2, loc2);
64
+
add (tok4, loc4);
65
+
register_custom_operator tok2 op loc2 loc3;
66
+
(LPAREN, loc1) ) )
67
+
| _ ->
68
+
add (tok2, loc2);
69
+
(LPAREN, loc1)
70
+
in
71
+
restore_loc lb loc;
72
+
tok
73
+
| tok -> tok
74
+
75
+
let () = Lexer.set_preprocessor (fun () -> Queue.clear pending) wrap
76
+
end
77
+
78
+
module Map_ast = struct
79
+
open Ast_mapper
80
+
open Asttypes
81
+
open Parsetree
82
+
open Ast_helper
83
+
84
+
let get_op vb =
85
+
match Hashtbl.find custom_operators vb.pvb_loc.loc_start with
86
+
| exception Not_found -> None
87
+
| loc, op -> Some (Exp.ident ~loc { txt = Lident op; loc })
88
+
89
+
let mapper =
90
+
let super = default_mapper in
91
+
let expr self expr =
92
+
let expr =
93
+
match expr.pexp_desc with
94
+
| Pexp_let (rf, (vb :: _ as vbs), body) -> (
95
+
match get_op vb with
96
+
| None -> expr
97
+
| Some op ->
98
+
if rf = Recursive then
99
+
Location.raise_errorf ~loc:expr.pexp_loc
100
+
"Custom 'let' operators cannot be recursive";
101
+
let patts, exprs =
102
+
List.map vbs ~f:(fun vb ->
103
+
let {
104
+
pvb_pat = patt;
105
+
pvb_expr = expr;
106
+
pvb_attributes = attrs;
107
+
pvb_loc = loc;
108
+
} =
109
+
vb
110
+
in
111
+
( match attrs with
112
+
| [] -> ()
113
+
| ({ loc; _ }, _) :: _ ->
114
+
Location.raise_errorf ~loc
115
+
"This attribute will be discarded" );
116
+
let op =
117
+
match get_op vb with
118
+
| Some op ->
119
+
Hashtbl.remove custom_operators vb.pvb_loc.loc_start;
120
+
op
121
+
| None ->
122
+
Location.raise_errorf ~loc
123
+
"Custom 'and' operator expected, got stantard \
124
+
'and' keyword"
125
+
in
126
+
(patt, (loc, op, expr)))
127
+
|> List.split
128
+
in
129
+
let patt =
130
+
List.fold_left (List.tl patts) ~init:(List.hd patts)
131
+
~f:(fun acc patt ->
132
+
let loc = patt.ppat_loc in
133
+
Pat.tuple ~loc [ acc; patt ])
134
+
in
135
+
let vars =
136
+
List.mapi exprs ~f:(fun i _ ->
137
+
Printf.sprintf "__future_syntax__%d__" i)
138
+
in
139
+
let pvars =
140
+
List.map2 vars patts ~f:(fun v p ->
141
+
let loc = { p.ppat_loc with loc_ghost = true } in
142
+
Pat.var ~loc { txt = v; loc })
143
+
in
144
+
let evars =
145
+
List.map2 vars exprs ~f:(fun v (_, _, e) ->
146
+
let loc = { e.pexp_loc with loc_ghost = true } in
147
+
Exp.ident ~loc { txt = Lident v; loc })
148
+
in
149
+
let expr =
150
+
List.fold_left2 (List.tl evars) (List.tl exprs)
151
+
~init:(List.hd evars) ~f:(fun acc var (loc, op, _) ->
152
+
Exp.apply ~loc op [ (nolabel, acc); (nolabel, var) ])
153
+
in
154
+
let body =
155
+
let loc = expr.pexp_loc in
156
+
Exp.apply ~loc op
157
+
[
158
+
(nolabel, expr);
159
+
(nolabel, Exp.fun_ ~loc nolabel None patt body);
160
+
]
161
+
in
162
+
List.fold_right2 pvars exprs ~init:body
163
+
~f:(fun var (loc, _, expr) acc ->
164
+
Exp.let_ Nonrecursive ~loc [ Vb.mk ~loc var expr ] acc) )
165
+
| _ -> expr
166
+
in
167
+
super.expr self expr
168
+
in
169
+
{ super with expr }
170
+
171
+
let map f ast =
172
+
let ast = f mapper ast in
173
+
let fail _ (loc, _) =
174
+
Location.raise_errorf ~loc "Invalid use of custom 'let' or 'and' operator"
175
+
in
176
+
Hashtbl.iter fail custom_operators;
177
+
ast
178
+
179
+
let structure = mapper.structure mapper
180
+
181
+
let signature = mapper.signature mapper
182
+
end
183
+
184
+
let process_file fn ~magic ~parse ~print ~map ~mk_ext =
185
+
let lexbuf = Lexing.from_channel (open_in_bin fn) in
186
+
Location.init lexbuf fn;
187
+
Location.input_lexbuf := Some lexbuf;
188
+
let ast =
189
+
try map (parse lexbuf)
190
+
with exn -> (
191
+
match error_of_exn exn with
192
+
| Some error ->
193
+
if !dump_ast then
194
+
[
195
+
mk_ext ?loc:None ?attrs:None (Ast_mapper.extension_of_error error);
196
+
]
197
+
else (
198
+
Location.report_error Format.err_formatter error;
199
+
exit 1 )
200
+
| None -> raise exn )
201
+
in
202
+
if !dump_ast then (
203
+
set_binary_mode_out stdout true;
204
+
output_string stdout magic;
205
+
output_value stdout fn;
206
+
output_value stdout ast;
207
+
flush stdout )
208
+
else Format.printf "%a@?" print ast
209
+
210
+
let process_file fn =
211
+
let ext =
212
+
match String.rindex fn '.' with
213
+
| exception Not_found -> ""
214
+
| i -> String.sub fn ~pos:i ~len:(String.length fn - i)
215
+
in
216
+
match ext with
217
+
| ".ml" ->
218
+
process_file fn ~magic:Config.ast_impl_magic_number
219
+
~parse:Parse.implementation ~print:Pprintast.structure
220
+
~map:Map_ast.structure ~mk_ext:Ast_helper.Str.extension
221
+
| ".mli" ->
222
+
process_file fn ~magic:Config.ast_intf_magic_number ~parse:Parse.interface
223
+
~print:Pprintast.signature ~map:Map_ast.signature
224
+
~mk_ext:Ast_helper.Sig.extension
225
+
| _ ->
226
+
Printf.eprintf "%s: Don't know what to do with %s.\n%!" prog_name fn;
227
+
exit 2
228
+
229
+
let () =
230
+
let args =
231
+
Arg.align
232
+
[
233
+
( "-dump-ast",
234
+
Arg.Set dump_ast,
235
+
" Output a binary AST rather than a pretty-printed source file" );
236
+
]
237
+
in
238
+
let usage = Printf.sprintf "Usage: %s [-dump-ast] FILES" prog_name in
239
+
Arg.parse args process_file usage
+9
vendor/opam/ocaml-syntax-shims/src/select-impl
+9
vendor/opam/ocaml-syntax-shims/src/select-impl
+13
vendor/opam/ocaml-syntax-shims/src/select-shims
+13
vendor/opam/ocaml-syntax-shims/src/select-shims
+3
vendor/opam/ocaml-syntax-shims/src/shims.402.ml
+3
vendor/opam/ocaml-syntax-shims/src/shims.402.ml
+3
vendor/opam/ocaml-syntax-shims/src/shims.403.ml
+3
vendor/opam/ocaml-syntax-shims/src/shims.403.ml
+7
vendor/opam/ocaml-syntax-shims/src/shims.406.ml
+7
vendor/opam/ocaml-syntax-shims/src/shims.406.ml
+3
vendor/opam/ocaml-syntax-shims/test/dune
+3
vendor/opam/ocaml-syntax-shims/test/dune
+27
vendor/opam/ocaml-syntax-shims/test/test.ml
+27
vendor/opam/ocaml-syntax-shims/test/test.ml
···
1
+
let ( let+ ) x f = `Let (x, f)
2
+
3
+
let ( and+ ) a b = `And (a, b)
4
+
5
+
let t =
6
+
let+ x = 1 and+ y = 2 and+ z = 3 in
7
+
(x, y, z)
8
+
9
+
let () =
10
+
match t with
11
+
| `Let (`And (`And (1, 2), 3), f) -> assert (f ((1, 2), 3) = (1, 2, 3))
12
+
| _ -> assert false
13
+
14
+
(* Make sure the evaluation order is the same as with OCaml >= 4.08 *)
15
+
16
+
let ( let+ ) x f = f x
17
+
18
+
let ( and+ ) a b = (a, b)
19
+
20
+
let () =
21
+
let q1 = Queue.create () in
22
+
let q2 = Queue.create () in
23
+
let () = Queue.add 1 q1 and () = Queue.add 2 q1 and () = Queue.add 3 q1 in
24
+
let+ () = Queue.add 1 q2 and+ () = Queue.add 2 q2 and+ () = Queue.add 3 q2 in
25
+
let l1 = Queue.fold (fun l x -> x :: l) [] q1 in
26
+
let l2 = Queue.fold (fun l x -> x :: l) [] q2 in
27
+
assert (l1 = l2)