├── .gitignore ├── .merlin ├── .ocp-indent ├── B0.ml ├── BRZO ├── CHANGES.md ├── DEVEL.md ├── LICENSE.md ├── README.md ├── _tags ├── doc ├── index.mld └── manual.mld ├── opam ├── pkg ├── META └── pkg.ml ├── src ├── b0caml.ml ├── b0caml.mli ├── b0caml.mllib ├── b0caml_ocamlpath.ml ├── b0caml_ocamlpath.mli ├── b0caml_opam.ml ├── b0caml_opam.mli ├── b0caml_resolver.ml ├── b0caml_resolver.mli ├── b0caml_script.ml ├── b0caml_script.mli └── tool │ ├── b0caml_cli.ml │ ├── b0caml_cli.mli │ └── b0caml_main.ml └── test ├── conf.ml ├── echo ├── errors ├── deps ├── opam └── ptime ├── grep ├── local-time ├── miaow ├── mod-use ├── conf.ml ├── test ├── with_mli.ml └── with_mli.mli └── perf ├── README.md ├── b0caml ├── base ├── bos ├── containers ├── grep ├── hello ├── local-time ├── nop └── zero ├── python ├── hello ├── nop └── zero ├── sh ├── hello ├── nop └── zero └── topfind ├── base ├── bos ├── containers ├── grep ├── hello ├── local-time ├── nop └── zero /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _b0 3 | tmp 4 | *.install 5 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG cmdliner b0.kit 2 | B _b0/** 3 | B _build/** -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | 3 | (* OCaml library names *) 4 | 5 | let unix = B0_ocaml.libname "unix" 6 | let cmdliner = B0_ocaml.libname "cmdliner" 7 | let b0_std = B0_ocaml.libname "b0.std" 8 | let b0_memo = B0_ocaml.libname "b0.memo" 9 | let b0_file = B0_ocaml.libname "b0.file" 10 | let b0_kit = B0_ocaml.libname "b0.kit" 11 | let b0caml = B0_ocaml.libname "b0caml" 12 | 13 | (* Units *) 14 | 15 | let b0caml_lib = 16 | let requires = [unix; cmdliner; b0_std; b0_memo; b0_file; b0_kit] in 17 | let srcs = [`Dir ~/"src"] in 18 | B0_ocaml.lib b0caml ~name:"b0caml-lib" ~requires ~srcs 19 | 20 | let b0caml = 21 | let requires = [cmdliner; b0_std; b0_memo; b0_file; b0_kit; b0caml] in 22 | let srcs = [`Dir ~/"src/tool"] in 23 | B0_ocaml.exe "b0caml" ~public:true ~requires ~srcs 24 | 25 | (* Packs *) 26 | 27 | let default = 28 | let meta = 29 | B0_meta.empty 30 | |> ~~ B0_meta.authors ["The b0caml programmers"] 31 | |> ~~ B0_meta.maintainers ["Daniel Bünzli "] 32 | |> ~~ B0_meta.homepage "https://erratique.ch/software/b0caml" 33 | |> ~~ B0_meta.online_doc "https://erratique.ch/software/b0caml/doc" 34 | |> ~~ B0_meta.repo "git+https://erratique.ch/repos/b0caml.git" 35 | |> ~~ B0_meta.issues "https://github.com/b0-system/b0caml/issues" 36 | |> ~~ B0_meta.description_tags 37 | ["org:erratique"; "org:b0-system"; "build"; "dev"; "scripting"] 38 | |> ~~ B0_meta.licenses ["ISC"] 39 | |> ~~ B0_opam.build 40 | {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" ]]|} 41 | |> ~~ B0_opam.depends 42 | [ "ocaml", {|>= "4.14.0"|}; 43 | "ocamlfind", {|build|}; 44 | "ocamlbuild", {|build|}; 45 | "topkg", {|build & >= "1.0.3"|}; 46 | "cmdliner", {|>= "1.3.0"|}; 47 | "b0", {||}; ] 48 | |> ~~ B0_opam.pin_depends 49 | [ "b0.dev", "git+https://erratique.ch/repos/b0.git#master"] 50 | |> B0_meta.tag B0_opam.tag 51 | |> B0_meta.tag B0_release.tag 52 | in 53 | B0_pack.make "default" ~doc:"b0caml package" ~meta ~locked:true @@ 54 | B0_unit.list () 55 | -------------------------------------------------------------------------------- /BRZO: -------------------------------------------------------------------------------- 1 | (srcs-x pkg examples test) -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | vX.Y.Z YYYY-MM-DD Location 2 | -------------------------- 3 | 4 | First release. 5 | -------------------------------------------------------------------------------- /DEVEL.md: -------------------------------------------------------------------------------- 1 | # Testing 2 | 3 | b0 -- b0caml -- test/grep 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019 The b0caml programmers 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | b0caml — Easy OCaml scripts 2 | ============================ 3 | 4 | B0caml runs OCaml scripts like `ocaml`. However it provides direct 5 | support for using third-party modules and compiles scripts 6 | transparently to a cache of native (or bytecode) executables. 7 | 8 | B0caml is distributed under the ISC license and depends on [`b0`][b0] 9 | and [`cmdliner`][cmdliner]. It is pronounced /bokamɛl/ with a thick 10 | french accent. 11 | 12 | Homepage: https://erratique.ch/software/b0caml 13 | 14 | [b0]: https://erratique.ch/software/b0 15 | [cmdliner]: https://erratique.ch/software/cmdliner 16 | 17 | ## Installation 18 | 19 | b0caml can be installed with `opam`: 20 | 21 | opam install b0caml 22 | 23 | If you don't use `opam` consult the [`opam`](opam) file for build 24 | instructions. 25 | 26 | ## Quick start 27 | 28 | A few invocations to get you started: 29 | 30 | ```shell 31 | > cat > echo < chmod +x ./echo 38 | > ./echo Hello world 39 | Hello world 40 | ``` 41 | 42 | For more information on how to use third-party modules see the 43 | tutorial introduction of the [manual][doc] (also available via 44 | `odig doc b0caml`). 45 | 46 | ## Documentation & support 47 | 48 | The documentation can be consulted [online][doc] or via `odig doc 49 | b0caml`. 50 | 51 | Questions are welcome but better asked on the [OCaml forum][ocaml-forum] 52 | than on the issue tracker. 53 | 54 | [doc]: https://erratique.ch/software/b0caml/doc 55 | [ocaml-forum]: https://discuss.ocaml.org/ 56 | 57 | ## Examples 58 | 59 | A few examples can be found in the [`test`](test/) directory. 60 | 61 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | <_b0> : -traverse 3 | : include 4 | : include 5 | : package(unix b0.std b0.memo b0.file b0.kit) 6 | : package(cmdliner) -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 B0caml {%html: %%VERSION%%%}} 2 | 3 | [b0caml] runs OCaml scripts like [ocaml]. However it provides direct 4 | support for using third-party modules and compiles scripts 5 | transparently to a cache of native (or bytecode) executables. 6 | 7 | Consult the {{!page-manual}manual} and its 8 | {{!page-manual.intro}tutorial introduction}. 9 | 10 | {1:quick_start Quick start} 11 | 12 | A few invocations to get you started. 13 | 14 | {[ 15 | cat > echo < chmod +x ./echo 22 | > ./echo grunt 23 | grunt 24 | > b0caml ./echo grunt # for Windows compatible invocations 25 | grunt 26 | ]} 27 | 28 | Read how to {{!page-manual.intro_using_mods}use third-party modules} and more in 29 | the {{!page-manual.intro}tutorial introduction}. 30 | 31 | {1:library_b0caml Library [b0caml]} 32 | 33 | This is an unstable API subject to change even between minor versions 34 | of the tool. Use at your own risk. 35 | 36 | {!modules: 37 | B0caml_opam 38 | B0caml_ocamlpath 39 | B0caml_resolver 40 | B0caml 41 | B0caml_script 42 | } -------------------------------------------------------------------------------- /doc/manual.mld: -------------------------------------------------------------------------------- 1 | {0 B0Caml} 2 | 3 | {e Easy OCaml scripts} 4 | 5 | {1:intro Introduction} 6 | 7 | Write programs not {e scripts}. I know… but at least quit your abusive 8 | relationship to [sh] derived linguistic disasters. 9 | 10 | {2:getting_started Getting started} 11 | 12 | A [b0caml] script is not different from an [ocaml] one, it just 13 | restricts the toplevel directives you can use and makes it easy for 14 | you to tap into installed third-party modules. 15 | 16 | Here's a simple [echo] script: 17 | 18 | {[ 19 | cat > echo < chmod +x ./echo 26 | > ./echo grunt 27 | grunt 28 | > b0caml ./echo grunt # for Windows compatible invocations 29 | grunt 30 | ]} 31 | 32 | Except for the shebang line, nothing different. 33 | 34 | {2:intro_using_mods Using third-party modules} 35 | 36 | If you have compiled modules in a directory [DIR] that you want to use 37 | in your script, add the following directive after the shebang line, 38 | before the source and before any comment because [b0caml] authors are 39 | very lazy: 40 | 41 | {v 42 | #directory "DIR" 43 | v} 44 | 45 | If [DIR] is relative it is made absolute with respect to the directory 46 | of the script. Using the ["+DIR"] syntax looks for modules in the 47 | [DIR] directory of the directories mentioned in the [OCAMLPATH] 48 | environment variable. 49 | 50 | [ocaml] also has the [#directory] directive but [b0caml] treats it a 51 | bit differently. First [b0caml] errors if [DIR] or [+DIR] does not 52 | resolve to an existing directory. Second [b0caml] knows how to load 53 | the implementation and dependencies of the modules it finds in that 54 | directory. 55 | 56 | The following script uses the [Ptime] and [Ptime_clock] modules. These 57 | modules are installed by the [ptime] package in the [ptime] and 58 | [ptime/clock/os] of a directory assumed to be in the [OCAMLPATH]: 59 | 60 | {[ 61 | > cat > local-time < chmod +x local-time 75 | > ./local-time 76 | 1995-09-12 11:27:13 +02:00 77 | ]} 78 | 79 | {2:intro_repl_debug Toplevel (REPL) debugging} 80 | 81 | Since [ocaml] does not know how to load the implementation of the 82 | interfaces it finds in [#directory] directives you cannot directly 83 | load a [b0caml] script in the toplevel. 84 | 85 | [b0caml] provide the [--top] (or [--utop]) option which loads a script 86 | and the module it needs in the OCaml toplevel for interactive testing and 87 | debugging: 88 | 89 | {v 90 | > b0caml --top local-time # load script and deps in the toplevel 91 | OCaml version 4.08.0 92 | 93 | # Local_time.to_string ();; 94 | - : string = "1995-09-12 11:27:13 +02:00" 95 | v} 96 | 97 | The name of the module for the script is determined by 98 | {{!filename_mangling}mangling} the script filename. 99 | 100 | If your script parses command line arguments or uses {!exit} you 101 | should properly isolate these computations in a [main] function and 102 | prevent its invocation whenever {!Sys.interactive} is [true] (see for 103 | example the source of [local-time] above). 104 | 105 | {2:intro_modular_scripts Modular scripts} 106 | 107 | Repeat after me, write a program not a script. 108 | 109 | A [b0caml] script can import an OCaml implementation source [SRC] with 110 | the [#mod_use "SRC"] directive. [SRC] must be a regular OCaml 111 | implementation, it cannot be a [b0caml] script. A relative [SRC] is 112 | made absolute with respect to the directory of the script. 113 | 114 | These directives should also appear only after the shebang line and before the 115 | script source or comments. The file [SRC] must exist or the scripts 116 | errors. 117 | 118 | A quick and dirty configuration file for a script screams to [#mod_use]: 119 | 120 | {v 121 | > cat > conf.ml < cat > miaow < "Miaou!" | _ -> "Miaow!" 129 | let main () = print_endline scream 130 | let () = if !Sys.interactive then () else main () 131 | EOCAML 132 | > chmod +x miaow 133 | > ./miaow 134 | Miaou! 135 | v} 136 | 137 | [#mod_use] {{!filename_mangling}mangles} the filename of the path to 138 | define a module name and implementation in which the contents of the 139 | file is included litteraly. In the example above the line [#mod_use 140 | "conf.ml"] is simply expanded to: 141 | 142 | {[ 143 | module Conf = struct 144 | #1 "/absolute/path/to/conf.ml" 145 | let lang = "fr" 146 | end 147 | ]} 148 | 149 | Knowing OCaml's scoping rules it should be easy to see that a module 150 | you [#mod_use] can refer to the modules [#mod_use]d before. But it is 151 | your duty to provide them in the right order. The relative order 152 | between [#directory] and [#mod_use] directives doesn't matter, you can 153 | consider all [#directory] directives to be written before the first 154 | [#mod_use]. 155 | 156 | A [#mod_use]d implementation is constrained by an interface if there's 157 | a side [.mli] for the file you include. For the full details read 158 | {{!mod_use_directive}here}. 159 | 160 | If you want to see the [#mod_use] expansions that are performand by 161 | [b0caml] on a script, the following invocation prints the final script 162 | source before it gets compiled: 163 | {[ 164 | > b0caml --source miaow 165 | ]} 166 | 167 | {2:intro_deps Dependency management} 168 | 169 | No formal dependency management is provided for the third-party 170 | modules you use – WRITE A PROGRAM NOT A SCRIPT ! 171 | 172 | However the [#directory] and [#mod_use] directives of a script and can 173 | be resolved with the [deps] subcommand: 174 | 175 | {v 176 | > b0caml deps local-time 177 | /usr/lib/ocaml/ptime/ 178 | /usr/lib/ocaml/ptime/os/ 179 | > b0caml deps miaow 180 | /home/camelus/conf.ml 181 | v} 182 | 183 | These invocations error and the program exits with a non-zero exit 184 | code if the directives do not resolve. For a [+DIR] directory 185 | directive, resolution checks the directory [DIR] exists in at least 186 | one of the directories mentioned in the [OCAMLPATH] environment 187 | variable. 188 | 189 | The [--raw] option prevents resolution and reports the verbatim 190 | directive arguments. 191 | 192 | {v 193 | > b0caml deps --raw local-time 194 | +ptime 195 | +ptime/os 196 | > b0caml deps --raw miaow 197 | conf.ml 198 | v} 199 | 200 | The [--root] option also eschews resolution and outputs root directory 201 | names of [+] directory directives: 202 | 203 | {v 204 | > b0caml deps --root local-time # Extract +DIR roots 205 | ptime 206 | > opam install $(b0caml deps --root local-time) # You must be joking... 207 | v} 208 | 209 | {2:intro_cache Script cache and build log} 210 | 211 | The first time a [b0caml] script runs it gets compiled and cached. 212 | This incurs a small overhead. If you want to avoid it, or simply test 213 | that it compiles without running it use the [--compile] option: 214 | 215 | {v 216 | b0caml --compile local-time # compile and cache the script 217 | v} 218 | 219 | {v 220 | b0caml log local-time # Output build log of [local-time] 221 | b0caml log -l local-time # More details... 222 | v} 223 | 224 | By default the script compilation cache location is determined 225 | according to the [XDG_CACHE_HOME] convention. The actual location of 226 | the cache can be printed via 227 | 228 | {v 229 | b0caml cache path # print path to the cache 230 | b0caml cache delete local-time # delete local-time build 231 | b0caml cache # delete the cache 232 | b0caml cache size # print stats about the cache 233 | b0caml cache trim # trim the cache to 50% of its size 234 | v} 235 | 236 | {1:configuration Configuration} 237 | 238 | Configuration is looked up in [XDG_CONFIG_DIR/b0caml/config]. The 239 | configuration file is a sequence of 240 | {{!B0_sexp_serialk.sexp_syntax}s-expressions}. Here's a sample file: 241 | 242 | {v 243 | (max-cache-size-mb 500) 244 | (compilation-target byte) ; force use of bytecode 245 | (ocamlopt) 246 | (compilation-env ; Specify the OCaml compilation environment 247 | (OCAMLPATH /usr/local/ocaml) 248 | (PATH /usr/local/bin)) 249 | v} 250 | 251 | The following keys are defined: 252 | 253 | {ul 254 | {- ({e cache-dir} PATH) cache directory} 255 | {- ({e max-cache-size-mb} SIZE) maximal cache size} 256 | {- ({e compilation-target} CODE) if both native and byte code are 257 | available force to use [CODE] ([byte] or [native])}} 258 | 259 | {1:editor_conf Editor support} 260 | 261 | We hope to eventually convince [ocamlmerlin] to understand 262 | [#directory] directives and abide by [OCAMLPATH] the way [b0caml] 263 | does. This will have merlin work out of the box in your script without 264 | having to specify anything. If you are using [#mod_use] you will be 265 | punished accordingly. 266 | 267 | One thing that remains is for your editor to treat files with 268 | [b0caml]'s shebang line as an OCaml file. Follow the instructions 269 | below according to your editor. 270 | 271 | {2:emacs Emacs} 272 | 273 | Add one of the following line to your [.emacs] depending on the OCaml 274 | mode you are using. 275 | 276 | {v 277 | (add-to-list 'interpreter-mode-alist '("b0caml" . caml-mode)) 278 | (add-to-list 'interpreter-mode-alist '("b0caml" . tuareg-mode)) 279 | v} 280 | 281 | {1:ref_syntax Script language reference} 282 | 283 | {2:syntax Syntax} 284 | 285 | A [b0caml] script is an optional shebang line, followed by white space 286 | (no comments) separated directives, followed by an 287 | {{:http://caml.inria.fr/pub/docs/manual-ocaml-4.09/compunit.html#unit-implementation}OCaml unit implementation}. 288 | 289 | Using an {{:https://tools.ietf.org/html/rfc5234}RFC 5234} grammar this 290 | reads as: 291 | 292 | {v 293 | script = [shebang] *(ws directive) ws unit-implementation 294 | shebang = "!#" *(%x00-%xFF) nl 295 | directive = dir-dir / dir-use 296 | dir-dir = "#directory" ws %x22 dchar *dchar %x22 297 | dir-use = "#mod_use" ws %x22 dchar *dchar %x22 298 | dchar = escape / cont / ws / %x21 / %x23-%x5B / %x5D-%x7E / %x80-xFF 299 | escape = %x5C (%x20 / %x22 / %x5C) 300 | cont = %x5C nl ws 301 | ws = *(%x20 / %x09 / %x0A / %x0B / %x0C / %x0D) 302 | nl = %x0A / %x0D / %x0D %x0A 303 | unit-implementation = ... ; See the syntax in the OCaml manual 304 | v} 305 | 306 | This syntax is a subset of [ocaml]'s one. However [b0caml] attributes 307 | slightly different semantics to the directives. 308 | 309 | {2:semantics Semantics} 310 | 311 | The following parts can be distinguished in a [b0caml] script: 312 | 313 | {ol 314 | {- The optional shebang line. This is ignored by [b0caml].} 315 | {- The ordered sequence of directives. These can be separated in two 316 | ordered list: those of [#directory] directives and those of 317 | [#mod_use] directives.} 318 | {- The OCaml unit implementation.}} 319 | 320 | The final source of the script is created by concatenating the 321 | {{!mod_use_directive}expansion} of the [#mod_use] directives followed 322 | by the OCaml unit implementation. This source is 323 | {{!compilation}compiled} in a compilation environment defined by the 324 | [#directory] directives to a module or a program to be [exec]uted. 325 | 326 | {3:directory_directive [#directory] directive} 327 | 328 | The syntax of the [#directory] directive is: 329 | 330 | {[ 331 | #directory "DIR" 332 | ]} 333 | 334 | The semantics is to simply add the file path [DIR] to the ordered list 335 | of directories looked up for third-party modules. From a compilation 336 | perspective you can see that as [-I DIR] options given to the 337 | compiler. 338 | 339 | If [DIR] is relative it is made absolute with respect to the directory 340 | of the script. The [+DIR] syntax indicates to add all the existing 341 | [DIR] directories from the directories mentioned in the [OCAMLPATH] 342 | environment variable. 343 | 344 | The directories have to resolve to existing directories or the script 345 | errors. For [+DIR] it must exist in at least one of the directories of 346 | [OCAMLPATH]. 347 | 348 | {3:mod_use_directive [#mod_use] directive} 349 | 350 | The syntax of the [#mod_use] directive is: 351 | 352 | {[ 353 | #mod_use "PATH" 354 | ]} 355 | 356 | The semantics is to define a module with the contents of [PATH] at 357 | that location. The name of the module is defined by 358 | {{!filename_mangling}mangling} the file name of [PATH]. 359 | 360 | If [PATH] is relative it is interpreted relative to the script's 361 | directory. 362 | 363 | For example assuming the filename of [PATH] is [file.ml], the 364 | directive expands to: 365 | 366 | {[ 367 | module File = struct 368 | #1 "PATH" 369 | (* contents of PATH *) 370 | end 371 | ]} 372 | 373 | If [PATH] has a corresponding [.mli] file say [MLI] in the same 374 | directory, the directive expands to: 375 | 376 | {[ 377 | module File : sig 378 | #line 1 "MLI" 379 | (* contents of MLI *) 380 | end = struct 381 | #line 1 "PATH" 382 | (* contents of PATH *) 383 | end 384 | ]} 385 | 386 | {3:filename_mangling Filename mangling} 387 | 388 | [b0caml] uses the following filename mangling convention to produce 389 | OCaml module names from arbitrary filenames: 390 | 391 | {ol 392 | {- Remove any trailing [.ml] or [.mli].} 393 | {- Map any dash [-] (0x2D) or dot [.] (0x2E) to an underscore 394 | [_] (0x5F).} 395 | {- Map any byte not allowed in OCaml compilation unit names to its two digit 396 | capital hexadecimal encoding.} 397 | {- If the result does not start with an US-ASCII letter, prefix 398 | the unit name with ['M'].} 399 | {- Capitalize the first letter.}} 400 | 401 | Note that the transformation is not injective. Here are a few examples: 402 | 403 | {v 404 | filename Module name 405 | ---------------------------------------- 406 | publish-website Publish_website 407 | publish_website Publish_website 408 | import-data.ml Import_data 409 | import-data.xml.ml Import_data_xml 410 | import-data.script Import_data_script 411 | mix+match Mix2Bmatch 412 | _release.ml M_release 413 | v} 414 | 415 | {3:exec Execution and exit codes} 416 | 417 | On script execution [b0caml] terminates with the exit code of you 418 | script. However that code may be determined by [b0caml] itself in case 419 | it doesn't get to execute the script. These code may muddle with your 420 | own script's exit codes, here's the list of these: 421 | 422 | {ul 423 | {- [127], compilation error. This is what shells usually report with when 424 | they can't find a command in the tool search path.} 425 | {- [125], unexpected internal error.} 426 | {- [124], command line parsing error.} 427 | {- [123], configuration error.}} 428 | 429 | {2:compilation Compilation} 430 | 431 | Given a script [script.ml] its final source [SRC] is extracted 432 | as defined {{!semantics}here}. 433 | 434 | {ol 435 | {- Create the final source [SRC] by expanding [script.ml]'s 436 | [#mod_use] directive as described {{!directive_mod_use}here} 437 | and appending [script.ml]'s OCaml compilation unit.} 438 | {- [SRC] is compiled to a byte or native code executable via 439 | single invocation to the OCaml compiler, the includes specified 440 | via [#directory] directives and all the library archives that 441 | are found in these directories along with their dependencies 442 | as determined by {!archive_lookup}archive dependency lookup}} 443 | 444 | 445 | {2:archive_lookup Archive dependency lookup} 446 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "b0caml" 3 | synopsis: "Easy OCaml scripts" 4 | description: """\ 5 | B0caml runs OCaml scripts like `ocaml`. However it provides direct 6 | support for using third-party modules and compiles scripts 7 | transparently to a cache of native (or bytecode) executables. 8 | 9 | B0caml is distributed under the ISC license and depends on [`b0`][b0] 10 | and [`cmdliner`][cmdliner]. It is pronounced /bokamɛl/ with a thick 11 | french accent. 12 | 13 | Homepage: https://erratique.ch/software/b0caml 14 | 15 | [b0]: https://erratique.ch/software/b0 16 | [cmdliner]: https://erratique.ch/software/cmdliner""" 17 | maintainer: "Daniel Bünzli " 18 | authors: "The b0caml programmers" 19 | license: "ISC" 20 | tags: ["org:erratique" "org:b0-system" "build" "dev" "scripting"] 21 | homepage: "https://erratique.ch/software/b0caml" 22 | doc: "https://erratique.ch/software/b0caml/doc" 23 | bug-reports: "https://github.com/b0-system/b0caml/issues" 24 | depends: [ 25 | "ocaml" {>= "4.14.0"} 26 | "ocamlfind" {build} 27 | "ocamlbuild" {build} 28 | "topkg" {build & >= "1.0.3"} 29 | "cmdliner" {>= "1.3.0"} 30 | "b0" 31 | ] 32 | build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"] 33 | dev-repo: "git+https://erratique.ch/repos/b0caml.git" 34 | pin-depends: ["b0.dev" "git+https://erratique.ch/repos/b0.git#master"] 35 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "Easy OCaml scripts" 2 | version = "%%VERSION_NUM%%" 3 | requires = "unix cmdliner b0.std b0.memo b0.file b0.kit" 4 | archive(byte) = "b0caml.cma" 5 | archive(native) = "b0caml.cmxa" 6 | plugin(byte) = "b0caml.cma" 7 | plugin(native) = "b0caml.cmxs" 8 | exists_if = "b0caml.cma b0caml.cmxa" 9 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "topkg" 4 | open Topkg 5 | 6 | let () = 7 | Pkg.describe "b0caml" @@ fun c -> 8 | Ok [ Pkg.mllib "src/b0caml.mllib"; 9 | Pkg.bin "src/tool/b0caml_main" ~dst:"b0caml"; 10 | Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; 11 | Pkg.doc "doc/manual.mld" ~dst:"odoc-pages/manual.mld"; ] 12 | -------------------------------------------------------------------------------- /src/b0caml.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | open Fut.Syntax 8 | 9 | module Exit = struct 10 | type t = Code of int | Exec of Fpath.t * Cmd.t 11 | let code = function Code c -> c | _ -> invalid_arg "not an exit code" 12 | let conf_error = Code 123 13 | let comp_error = Code 127 14 | let ok = Code 0 15 | let miss_dep_error = Code 1 16 | let miss_log_error = Code 1 17 | let some_error = Code 122 18 | end 19 | 20 | module Env = struct 21 | let cache_dir = "B0CAML_CACHE_DIR" 22 | let color = "B0CAML_COLOR" 23 | let comp_target = "B0CAML_COMPILATION_TARGET" 24 | let verbosity = "B0CAML_VERBOSITY" 25 | end 26 | 27 | module Conf = struct 28 | type comp_target = [ `Auto | `Byte | `Native ] 29 | let get_comp_target = Option.value ~default:`Auto 30 | let comp_target_of_string s = match String.trim s with 31 | | "auto" -> Ok `Auto 32 | | "byte" -> Ok `Byte 33 | | "native" -> Ok `Native 34 | | e -> 35 | let pp_target = Fmt.code in 36 | let kind = Fmt.any "compilation target" in 37 | let dom = ["auto"; "byte"; "native"] in 38 | Fmt.error "%a" Fmt.(unknown' ~kind pp_target ~hint:must_be) (e, dom) 39 | 40 | let get_cache_dir ~cwd = function 41 | | Some d -> Ok Fpath.(cwd // d) 42 | | None -> 43 | Result.bind (Os.Dir.cache ()) @@ fun cache -> 44 | Ok Fpath.(cache / "b0caml") 45 | 46 | let get_memo ~cwd ~cache_dir script = 47 | let feedback = 48 | let op_howto ppf o = 49 | Fmt.pf ppf "b0caml log %a --id %d" 50 | Fpath.pp_quoted script (B0_zero.Op.id o) 51 | in 52 | let show_op = Log.Info and show_ui = Log.Error and level = Log.level () in 53 | B0_cli.Memo.pp_leveled_feedback ~op_howto ~show_op ~show_ui ~level 54 | Fmt.stderr 55 | in 56 | let trash_dir = Fpath.(cache_dir / B0_cli.Memo.trash_dir_name) in 57 | let jobs = 4 in 58 | B0_memo.make ~cwd ~cache_dir ~trash_dir ~jobs ~feedback () 59 | 60 | type t = 61 | { cache_dir : Fpath.t; 62 | b0_cache_dir : Fpath.t; 63 | comp_target : comp_target; 64 | cwd : Fpath.t; 65 | log_level : Log.level; 66 | memo : (Fpath.t -> (B0_memo.t, string) result) Lazy.t; 67 | ocamlpath : B0caml_ocamlpath.t; 68 | fmt_styler : Fmt.styler; } 69 | 70 | let v ~cache_dir ~comp_target ~cwd ~log_level ~ocamlpath ~fmt_styler () = 71 | let b0_cache_dir = Fpath.(cache_dir / B0_cli.Memo.cache_dir_name) in 72 | let memo = lazy (get_memo ~cwd ~cache_dir:b0_cache_dir) in 73 | { cache_dir; b0_cache_dir; comp_target; cwd; log_level; memo; ocamlpath; 74 | fmt_styler } 75 | 76 | let cache_dir c = c.cache_dir 77 | let b0_cache_dir c = c.b0_cache_dir 78 | let comp_target c = c.comp_target 79 | let cwd c = c.cwd 80 | let log_level c = c.log_level 81 | let memo c = Lazy.force c.memo 82 | let ocamlpath c = c.ocamlpath 83 | let fmt_styler c = c.fmt_styler 84 | 85 | let env_find parse var = 86 | Os.Env.find' ~empty_is_none:true parse var |> Log.if_error ~use:None 87 | 88 | let setup ~cache_dir ~comp_target ~log_level ~color () = 89 | let fmt_styler = B0_std_cli.get_styler color in 90 | let log_level = B0_std_cli.get_log_level log_level in 91 | B0_std_cli.setup fmt_styler log_level ~log_spawns:Log.Debug; 92 | Result.bind (Os.Dir.cwd ()) @@ fun cwd -> 93 | Result.bind (get_cache_dir ~cwd cache_dir) @@ fun cache_dir -> 94 | let comp_target = get_comp_target comp_target in 95 | Result.bind (B0caml_ocamlpath.get None) @@ fun ocamlpath -> 96 | Ok (v ~cache_dir ~comp_target ~cwd ~log_level ~ocamlpath ~fmt_styler ()) 97 | 98 | let setup_with_cli = setup 99 | let setup_without_cli () = 100 | let cache_dir = env_find Fpath.of_string Env.cache_dir in 101 | let comp_target = env_find comp_target_of_string Env.comp_target in 102 | let color = env_find B0_std_cli.styler_of_string Env.color in 103 | let log_level = env_find Log.level_of_string Env.verbosity in 104 | setup ~cache_dir ~comp_target ~color ~log_level () 105 | end 106 | 107 | module Err = struct 108 | let pp_logical_suggestions ~logical_dirs ~uninstalled ppf dir = 109 | let dirs = B0caml_ocamlpath.logical_dir_suggestions ~logical_dirs dir in 110 | let pkg = Option.get (B0caml_ocamlpath.logical_path_root_name dir) in 111 | let pkgs = B0caml_opam.pkg_suggestions ~pkgs:uninstalled ~pkg in 112 | match dirs, pkgs with 113 | | None, None -> () 114 | | Some dirs, None -> B0caml_ocamlpath.pp_did_you_mean_logical_dirs ppf dirs 115 | | None, Some opam -> B0caml_opam.pp_maybe_try_install ~alt:false ppf opam 116 | | Some dirs, Some opam -> 117 | B0caml_ocamlpath.pp_did_you_mean_logical_dirs ppf dirs; 118 | B0caml_opam.pp_maybe_try_install ~alt:true ppf opam 119 | 120 | let directories ~ocamlpath errs = 121 | let logical_dirs = 122 | Log.time (fun _ m -> m "logical dir domain") @@ fun () -> 123 | Log.if_error ~use:Fpath.Set.empty @@ 124 | B0caml_ocamlpath.logical_dirs ocamlpath 125 | in 126 | let uninstalled = 127 | Log.time (fun _ m -> m "opam list uninstalled") @@ fun () -> 128 | Log.if_error ~use:String.Set.empty @@ 129 | B0caml_opam.uninstalled () 130 | in 131 | let directory (dir, m, err) = match err with 132 | | `Error e -> B0caml_script.loc_errf m " %s" e 133 | | `Miss -> 134 | let pp_bold pp = Fmt.st' [`Bold] pp in 135 | match B0caml_ocamlpath.classify_path dir with 136 | | `Concrete dir -> 137 | B0caml_script.loc_errf 138 | m " Missing directory %a" (pp_bold Fpath.pp_unquoted) dir 139 | | `Logical rdir -> 140 | B0caml_script.loc_errf 141 | m " @[@[Directory %a not found in any %a directories.@]%a@]" 142 | (pp_bold Fpath.pp_unquoted) rdir 143 | (pp_bold Fmt.string) "OCAMLPATH" 144 | (pp_logical_suggestions ~logical_dirs ~uninstalled) dir 145 | in 146 | String.concat "\n\n" (List.map directory errs) 147 | 148 | let mod_uses errs = 149 | let mod_use (file, m, err) = match err with 150 | | `Error e -> B0caml_script.loc_errf m " %s" e 151 | | `Miss -> 152 | B0caml_script.loc_errf 153 | m " Missing file %a" (Fmt.st' [`Bold] Fpath.pp_unquoted) file 154 | in 155 | String.concat "\n\n" (List.map mod_use errs) 156 | end 157 | 158 | let get_script_file c file = 159 | if file = "-" then Ok Fpath.dash else 160 | Result.bind (Fpath.of_string file) @@ fun file -> 161 | Os.Path.realpath file 162 | 163 | let script_build_log ~build_dir = Fpath.(build_dir / "log") 164 | 165 | let script_build_dir c ~script_file = 166 | (* A bit unclear what we want to use here maybe add what 167 | affects compilation environment *) 168 | let file = Fpath.to_string @@ script_file in 169 | let hash = Hash.to_hex @@ Hash.Xxh3_64.string file in 170 | Fpath.(Conf.cache_dir c / hash) 171 | 172 | let get_script c file = 173 | Result.bind (get_script_file c file) @@ fun script -> 174 | Result.bind (Os.File.read script) @@ fun src -> 175 | Result.bind (B0caml_script.of_string ~file:script src) @@ fun s -> Ok s 176 | 177 | let get_source c s = 178 | let map_error = Result.map_error Err.mod_uses in 179 | Result.bind (map_error (B0caml_script.resolve_mod_uses s)) @@ 180 | fun mod_use_resolutions -> B0caml_script.src ~mod_use_resolutions s 181 | 182 | (* Compilation *) 183 | 184 | let write_source m build_dir s ~mod_uses ~src_file = 185 | let mod_use_files = B0caml_script.mod_use_resolution_files in 186 | let mod_uses_files = List.concat_map mod_use_files mod_uses in 187 | let reads = B0caml_script.file s :: mod_uses_files in 188 | B0_memo.ready_files m reads; 189 | B0_memo.write m ~reads src_file @@ fun () -> 190 | B0caml_script.src ~mod_use_resolutions:mod_uses s 191 | 192 | (* There are various way one could go about this. 193 | 194 | 1. ocamldep to get approx. of module names, resolve these module names 195 | in [dirs]. Get archives and their deps 196 | 2. compile with -c then ocamlobjinfo to get actual names. Then resolve 197 | these in -I dirs, find archives and their recursive deps. 198 | 3. Brutal like 1. but don't even call ocamldep. Give all the archives 199 | present in the -I dirs and find their rec. deps. Only depend 200 | on these files. *) 201 | 202 | let byte_comp m = B0_memo.tool m B0_ocaml.Tool.ocamlc, `Byte 203 | let native_comp m = B0_memo.tool m B0_ocaml.Tool.ocamlopt, `Native 204 | 205 | let find_comp c m = match Conf.comp_target c with 206 | | `Byte -> Fut.return (byte_comp m) 207 | | `Native -> Fut.return (native_comp m) 208 | | `Auto -> 209 | let* ocamlopt = B0_memo.tool_opt m B0_ocaml.Tool.ocamlopt in 210 | Fut.return @@ match ocamlopt with 211 | | None -> byte_comp m 212 | | Some comp -> comp, `Native 213 | 214 | let compile_source m (comp, code) r build_dir s ~dirs ~src_file = 215 | let dirs = List.map B0caml_script.directory_resolution_dir dirs in 216 | let ocamlpath = B0caml_resolver.ocamlpath r in 217 | (* Automatically add ocaml libs *) 218 | let dirs = B0caml_ocamlpath.ocaml_logical_dir ocamlpath :: dirs in 219 | let* archives = B0caml_resolver.find_archives_and_deps r ~code ~dirs in 220 | let archives = List.map B0_ocaml.Cobj.file archives in 221 | let incs = Cmd.unstamp @@ Cmd.paths ~slip:"-I" dirs in 222 | let base = Fpath.strip_ext src_file in 223 | let writes = match code with 224 | | `Byte -> [ Fpath.(base + ".cmo") ] 225 | | `Native -> [ Fpath.(base + ".cmx"); Fpath.(base + ".o") ] 226 | in 227 | let exe = Fpath.(build_dir / "exe" ) in 228 | let writes = exe :: Fpath.(base + ".cmi") :: writes in 229 | let reads = src_file :: archives (* FIXME add C libs. *) in 230 | B0_memo.ready_files m archives; 231 | B0_memo.spawn m ~reads ~writes @@ 232 | comp Cmd.(arg "-o" %% unstamp (path exe) %% arg "-opaque" %% 233 | (unstamp @@ (incs %% paths archives %% path src_file))); 234 | Fut.return () 235 | 236 | let maybe_write_build_log m ~build_dir = 237 | (* Only write log if there's a failure or something was spawned *) 238 | (* 239 | let spawn_execs m = 240 | let spawn_exec o = match B0_zero.Op.kind o with 241 | | B0_zero.Op.Spawn _ when not (B0_zero.Op.revived o) -> true | _ -> false 242 | in 243 | List.exists spawn_exec (B0_memo.ops m) 244 | in 245 | if not (B0_memo.has_failures m) && not (spawn_execs m) then () else 246 | *) 247 | (* For now always write log. Let's see how much it gets on the budget. *) 248 | let log_file = script_build_log ~build_dir in 249 | Log.if_error ~use:() (B0_memo_log.(write log_file (of_memo m))) 250 | 251 | let compile_script c s = 252 | let ocamlpath = Conf.ocamlpath c in 253 | let dirs = B0caml_script.resolve_directories ~ocamlpath s in 254 | let mod_uses = B0caml_script.resolve_mod_uses s in 255 | match dirs, mod_uses with 256 | | Ok dirs, Ok mod_uses -> 257 | Result.bind (Conf.memo c (B0caml_script.file s)) @@ fun m -> 258 | let memo_dir = Fpath.(Conf.cache_dir c / "lib_resolve") in 259 | let r = B0caml_resolver.create m ~memo_dir ~ocamlpath in 260 | let build_dir = script_build_dir c ~script_file:(B0caml_script.file s) in 261 | let src_file = Fpath.(build_dir / "src.ml") in 262 | let exe = Fpath.(build_dir / "exe") in 263 | begin 264 | ignore @@ 265 | let* comp = find_comp c m in 266 | (* FIXME gets also rid of log, but is needed 267 | for src updates. Needs to fix b0 268 | B0_memo.delete m build_dir @@ fun () -> *) 269 | let* () = B0_memo.mkdir m build_dir in 270 | write_source m build_dir s ~mod_uses ~src_file; 271 | compile_source m comp r build_dir s ~dirs ~src_file 272 | end; 273 | B0_memo.stir m ~block:true; 274 | let ret = match B0_memo.status m with 275 | | Ok () -> Ok exe 276 | | Error e -> 277 | let s = B0caml_script.file s in 278 | let read_howto ppf _ = 279 | Fmt.pf ppf "b0caml log %a -r " Fpath.pp_quoted s 280 | in 281 | let write_howto ppf _ = 282 | Fmt.pf ppf "b0caml log %a -w " Fpath.pp_quoted s 283 | in 284 | Fmt.error "%a" 285 | (B0_zero_conv.Op.pp_aggregate_error ~read_howto ~write_howto ()) e 286 | in 287 | maybe_write_build_log m ~build_dir; 288 | ret 289 | | dirs, mod_uses -> 290 | let dir_errs = Result.map_error (Err.directories ~ocamlpath) dirs in 291 | let dir_errs = match dir_errs with Error e -> e | Ok _ -> "" in 292 | let mod_errs = Result.map_error Err.mod_uses mod_uses in 293 | let mod_errs = match mod_errs with Error e -> e | Ok _ -> "" in 294 | Error (String.concat "\n\n" [dir_errs; mod_errs]) 295 | -------------------------------------------------------------------------------- /src/b0caml.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [b0caml] support. *) 7 | 8 | open B0_std 9 | 10 | (** [b0caml] exit codes. *) 11 | module Exit : sig 12 | 13 | type t = 14 | | Code of int 15 | | Exec of Fpath.t * Cmd.t (** *) 16 | (** The type for exits. Either an exit code or a command to [execv]. *) 17 | 18 | val code : t -> int 19 | (** [code c] is the code of [c] raises [Invalid_argument] if [c] 20 | is [Exec]. *) 21 | 22 | val conf_error : t 23 | (** [conf_error] is for configuration errors. *) 24 | 25 | val comp_error : t 26 | (** [comp_error] is for compilation errors. More specifically 27 | this is [127] (what shells use when the command 28 | is not found in path). *) 29 | 30 | val miss_dep_error : t 31 | (** [miss_dep_error] is used by the [deps] subcommand to report 32 | missing [#mod_use] or [#directory] paths. *) 33 | 34 | val miss_log_error : t 35 | (** [miss_log_error] is used by the [log] subcommand to report a 36 | missing lot. *) 37 | 38 | val ok : t 39 | (** [ok] is the zero exit code. *) 40 | 41 | val some_error : t 42 | (** [some_error] is used to indicate an indiscriminate error 43 | happened and was reported on stdout. *) 44 | end 45 | 46 | (** [b0caml] environment variables. *) 47 | module Env : sig 48 | val cache_dir : string 49 | (** [cache_dir] is the variable used to sepcify the cache directory. *) 50 | 51 | val color : string 52 | (** [color] is the variable used to specify tty styling. *) 53 | 54 | val comp_target : string 55 | (** [comp_target] is the variable used to specify the compilation target. *) 56 | 57 | val verbosity : string 58 | (** [verbosity] is the variable used to specify log verbosity. *) 59 | end 60 | 61 | (** [b0caml] configuration. *) 62 | module Conf : sig 63 | 64 | type comp_target = [ `Auto | `Byte | `Native ] 65 | (** The type for compilation targets. *) 66 | 67 | val comp_target_of_string : string -> (comp_target, string) result 68 | (** [comp_target_of_string s] parses a compilation target from [s]. *) 69 | 70 | (** {1:conf Configurations} *) 71 | 72 | type t 73 | (** The type for configurations. *) 74 | 75 | val v : 76 | cache_dir:Fpath.t -> comp_target:comp_target -> cwd:Fpath.t -> 77 | log_level:Log.level -> ocamlpath:B0caml_ocamlpath.t -> 78 | fmt_styler:Fmt.styler -> unit -> t 79 | (** [v] constructs a configuration with the given attributes. 80 | See the corresponding accessors for details. *) 81 | 82 | val cache_dir : t -> Fpath.t 83 | (** [cache_dir c] is the cache directory. *) 84 | 85 | val b0_cache_dir : t -> Fpath.t 86 | (** [b0_cache_dir c] is the b0 cache directory. *) 87 | 88 | val comp_target : t -> comp_target 89 | (** [comp_target c] is the target to which scripts are compiled. *) 90 | 91 | val cwd : t -> Fpath.t 92 | (** [cwd c] is the current working directory w.r.t. relative 93 | configuration file paths are expressed. *) 94 | 95 | val log_level : t -> Log.level 96 | (** [log_level c] is the desired log level. *) 97 | 98 | val ocamlpath : t -> B0caml_ocamlpath.t 99 | (** [ocamlpath] is the [OCAMLPATH] to consider. *) 100 | 101 | val memo : t -> Fpath.t -> (B0_memo.t, string) result 102 | (** [memo c script] is the memoizer for the configuration and script 103 | [script]. *) 104 | 105 | val fmt_styler : t -> Fmt.styler 106 | (** [fmt_styler c] is formatting styler assumed for output. *) 107 | 108 | (** {1:setup Setup} *) 109 | 110 | val setup_with_cli : 111 | cache_dir:Fpath.t option -> comp_target:comp_target option -> 112 | log_level:Log.level option -> color:Fmt.styler option option -> unit -> 113 | (t, string) result 114 | (** [setup_with_cli ~cache_dir ~comp_target ~color ~log_level ()] 115 | determines and setups a configuration with the given values. These are 116 | expected to have been determined by environment variables and command 117 | line arguments. *) 118 | 119 | val setup_without_cli : unit -> (t, string) result 120 | (** [setup_without_cli] determines and setups a configuration 121 | without without command line arguments. This looks up 122 | environment variables and determines defaults. *) 123 | end 124 | 125 | (** [b0caml] error messages. *) 126 | module Err : sig 127 | val directories : 128 | ocamlpath:B0caml_ocamlpath.t -> 129 | B0caml_script.directory_resolution_error list -> string 130 | (** [directories] is an error message for [#directory] resolution errors. *) 131 | 132 | val mod_uses : 133 | B0caml_script.mod_use_resolution_error list -> string 134 | (** [mod_uses] is an error message for [#mod_use] resolution errors. *) 135 | end 136 | 137 | 138 | val get_script_file : Conf.t -> string -> (Fpath.t, string) result 139 | (** [get_script_file c file] is the absolute paths to script [file]. *) 140 | 141 | val script_build_dir : Conf.t -> script_file:Fpath.t -> Fpath.t 142 | (** [script_build_dir c ~script_file] is a build directory in the cache 143 | directory of [c] for script [~script_file].*) 144 | 145 | val script_build_log : build_dir:Fpath.t -> Fpath.t 146 | (** [script_build_log ~build_dir] is a build log file in [build_dir]. *) 147 | 148 | val get_script : Conf.t -> string -> (B0caml_script.t, string) result 149 | (** [get_script c file] parses a script from file [file] in configuration 150 | [c]. *) 151 | 152 | val get_source : Conf.t -> B0caml_script.t -> (string, string) result 153 | (** [get_source c s] is the final source of script [s] in 154 | configuration [c], determined via {!B0caml_script.src}. *) 155 | 156 | val compile_script : 157 | Conf.t -> B0caml_script.t -> (Fpath.t, string) result 158 | (** [compile_script c s] compiles script [s] to an executable. *) 159 | -------------------------------------------------------------------------------- /src/b0caml.mllib: -------------------------------------------------------------------------------- 1 | B0caml_resolver 2 | B0caml_opam 3 | B0caml_ocamlpath 4 | B0caml 5 | B0caml_script 6 | -------------------------------------------------------------------------------- /src/b0caml_ocamlpath.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | 8 | (* Logical paths *) 9 | 10 | let classify_path d = 11 | let s = Fpath.to_string d in 12 | if s.[0] <> '+' then `Concrete d else 13 | let s = String.subrange ~first:1 s in 14 | if String.is_empty s then `Logical (Fpath.v ".") else `Logical (Fpath.v s) 15 | 16 | let logical_path_root_name dep = 17 | let s = Fpath.to_string dep in 18 | if s.[0] <> '+' then None else 19 | let last = match String.index s Fpath.dir_sep_char with 20 | | exception Not_found -> String.length s - 1 | i -> i - 1 21 | in 22 | match String.subrange ~first:1 ~last s with "" -> None | s -> Some s 23 | 24 | (* Lookup *) 25 | 26 | type t = 27 | { dirs : Fpath.t list; 28 | ocaml_logical_dir : Fpath.t; } 29 | 30 | let find dirs name = 31 | let exists name dir = 32 | Log.if_error ~use:false @@ Os.Dir.exists Fpath.(dir / name) 33 | in 34 | match List.find (exists name) dirs with 35 | | exception Not_found -> None 36 | | dir -> Some dir 37 | 38 | let of_paths ps = match find ps "ocaml" with 39 | | Some ocaml -> Ok { dirs = ps; ocaml_logical_dir = ocaml } 40 | | None -> 41 | let pp = Fmt.st [`Bold] in 42 | Fmt.error "Could not find %a in %a" pp "+ocaml" pp "OCAMLPATH" 43 | 44 | let get ?search = function 45 | | Some ps -> of_paths ps 46 | | None -> 47 | let var = "OCAMLPATH" and empty_is_none = false in 48 | let path = Os.Env.find' ~empty_is_none Fpath.list_of_search_path var in 49 | match Log.if_error ~use:None path with 50 | | Some ps -> of_paths ps 51 | | None -> 52 | let fpath_of_cmd cmd = match Os.Cmd.find ?search cmd with 53 | | None -> Ok None 54 | | Some cmd -> 55 | Result.bind (Os.Cmd.run_out ~trim:true cmd) @@ fun s -> 56 | Result.map Option.some (Fpath.of_string s) 57 | in 58 | let opam_lib = fpath_of_cmd Cmd.(arg "opam" % "var" % "lib") in 59 | let ocaml_where = fpath_of_cmd Cmd.(arg "ocamlc" % "-where") in 60 | Result.bind opam_lib @@ fun opam_lib -> 61 | Result.bind ocaml_where @@ fun ocaml_where -> 62 | match opam_lib, ocaml_where with 63 | | None, Some p -> Ok { dirs = [p]; ocaml_logical_dir = p } 64 | | Some p, None -> 65 | Ok { dirs = [p]; ocaml_logical_dir = Fpath.(p / "ocaml") } 66 | | None, None -> 67 | let pp = Fmt.st [`Bold] in 68 | Fmt.error "@[Could not detect an OCaml install.@,\ 69 | Try setting the %a variable.@]" pp "OCAMLPATH" 70 | | Some opam, Some ocaml when Fpath.is_prefix opam ocaml -> 71 | Ok { dirs = [opam]; ocaml_logical_dir = ocaml } 72 | | Some opam, Some ocaml -> 73 | Ok { dirs = [opam; ocaml]; ocaml_logical_dir = ocaml } 74 | 75 | let dirs p = p.dirs 76 | let ocaml_logical_dir p = p.ocaml_logical_dir 77 | 78 | let logical_dirs p = 79 | let add_dir acc dir = 80 | let add_path _ _ p ds = Fpath.Set.add Fpath.(v ("+" ^ to_string p)) ds in 81 | Result.error_to_failure @@ 82 | Os.Dir.fold_dirs ~rel:true ~recurse:true add_path dir acc 83 | in 84 | try Ok (List.fold_left add_dir Fpath.Set.empty p.dirs) with 85 | | Failure e -> Error e 86 | 87 | let logical_dir_suggestions ~logical_dirs:dirs dir = 88 | let dirs = Fpath.Set.fold (fun p acc -> Fpath.to_string p :: acc) dirs [] in 89 | let dir = Fpath.to_string dir in 90 | let dir_root = match String.cut_left ~sep:Fpath.dir_sep dir with 91 | | None -> dir | Some (root, _) -> root 92 | in 93 | let some ds = Some (List.map Fpath.v ds) in 94 | let ds = String.spellcheck (fun yield -> List.iter yield dirs) dir in 95 | if ds <> [] then some ds else 96 | let ds = match List.mem dir_root dirs with 97 | | true -> List.filter (fun f -> String.starts_with ~prefix:dir_root f) dirs 98 | | false -> String.spellcheck (fun yield -> List.iter yield dirs) dir 99 | in 100 | if ds <> [] then some ds else None 101 | 102 | let pp_did_you_mean_logical_dirs ppf dirs = 103 | Fmt.pf ppf "@,@[%a@]" (Fmt.did_you_mean (Fmt.code' Fpath.pp_unquoted)) dirs 104 | -------------------------------------------------------------------------------- /src/b0caml_ocamlpath.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [OCAMLPATH] support move to B0_care. *) 7 | 8 | open B0_std 9 | 10 | (** {1:logical Logical paths} *) 11 | 12 | val classify_path : Fpath.t -> [ `Concrete of Fpath.t | `Logical of Fpath.t ] 13 | (** [classify_path p] is: 14 | {ul 15 | {- [`Logical l] if [p] starts with a ['+']. [l] is [p] without 16 | the ['+'] or [Fpath.v "."] if that results in the empty string.} 17 | {- [`Concrete d] otherwise.}} 18 | Logical paths are those that need to be looked up in [OCAMLPATH]. *) 19 | 20 | val logical_path_root_name : Fpath.t -> string option 21 | (** [logical_path_root_name d] is: 22 | {ul 23 | {- [Some r] if [classify_path d] is [`Logical d'] and [r] 24 | the first non-dot segment of [d'].} 25 | {- [None] otherwise.}} *) 26 | 27 | (** {1:lookup OCAMLPATH lookup} *) 28 | 29 | type t 30 | (** The type for OCAMLPATH. Conceptually it's just a list of directories 31 | but for legacy reasons we need to carry a bit more information. *) 32 | 33 | val get : 34 | ?search:Cmd.tool_search -> Fpath.t list option -> (t, string) result 35 | (** [get ocamlpath] is [Ok ps] if [ocamlpath] is [Some ps] and otherwise: 36 | {ul 37 | {- If the [OCAMLPATH] environment variable is defined, its contents 38 | parsed according to {!Fpath.list_of_search_path}.} 39 | {- If the [opam] tool is available [[$(opam var lib); $(ocamlc -where)]] 40 | or [[$(opam var lib)]] if [$(ocamlc -where)] is included in it.} 41 | {- If the [opam] tool is not available [$(ocamlc -where)]}} 42 | [search] is given to {!Os.Cmd.find} to lookup [ocamlc] and [opam]. *) 43 | 44 | val dirs : t -> Fpath.t list 45 | (** [dirs] are the directories in the OCAMLPATH. *) 46 | 47 | val ocaml_logical_dir : t -> Fpath.t 48 | (** [ocaml_logical] is the path to the directory that should be called 49 | ["+ocaml"] in the OCAMLPATH. For systems installs where packages 50 | are installed in [ocamlc -where] (OCAMLPATH is undefined), [ocamlc 51 | -where] is in [dirs] but ["+ocaml"] cannot be resolved by looking 52 | up {!dirs}. This is the resolution that should be used for 53 | ["+ocaml"]. *) 54 | 55 | val logical_dirs : t -> (Fpath.Set.t, string) result 56 | (** [logical_dirs] is the domain of logical directories in [ocamlpath] on the 57 | current file system. That is the set of directories [DIR] that can 58 | be specified as [+DIR]. The set has them without the [+]. *) 59 | 60 | (** {1:suggest Logical suggestions} *) 61 | 62 | val logical_dir_suggestions : 63 | logical_dirs:Fpath.Set.t -> Fpath.t -> Fpath.t list option 64 | (** [dir_suggestions ~dirs dir] are suggestions to correct 65 | an unfound logical directory [dir] in [logical_dirs] for 66 | example obtained via {!logical_dirs}. *) 67 | 68 | val pp_did_you_mean_logical_dirs : Fpath.t list Fmt.t 69 | (** [pp_did_you_mean_logical_dirs] suggests a logical directory 70 | spell check. Formats a starting {!Fmt.cut} followed 71 | by a boxed sentence of the form ["Did you mean ... ?"]. *) 72 | -------------------------------------------------------------------------------- /src/b0caml_opam.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | 8 | (* Listing packages *) 9 | 10 | let pkg_set_of_lines s = 11 | let add_pkg _ set pkg = if pkg <> "" then String.Set.add pkg set else set in 12 | String.fold_ascii_lines ~strip_newlines:true add_pkg String.Set.empty s 13 | 14 | let uninstalled ?search ?switch () = 15 | let switch = match switch with 16 | | None -> Cmd.empty | Some s -> Cmd.(arg "--switch" % s) 17 | in 18 | let opam_list = Cmd.(tool "opam" % "list" %% switch % "--short") in 19 | match Os.Cmd.find ?search opam_list with 20 | | None -> Ok String.Set.empty 21 | | Some opam_list -> 22 | let list kind = Os.Cmd.run_out ~trim:true Cmd.(opam_list % kind) in 23 | Result.bind (list "--available") @@ fun available -> 24 | Result.bind (list "--installed") @@ fun installed -> 25 | let available = pkg_set_of_lines available in 26 | let installed = pkg_set_of_lines installed in 27 | Ok (String.Set.diff available installed) 28 | 29 | (* Suggesting packages *) 30 | 31 | let pkg_suggestions ~pkgs ~pkg = 32 | if String.Set.mem pkg pkgs then Some (`Exact pkg) else 33 | let pkgs yield = List.iter yield (String.Set.elements pkgs) in 34 | match String.spellcheck pkgs pkg with 35 | | [] -> None | ss -> Some (`Fuzzy ss) 36 | 37 | let pp_maybe_try_install ~alt ppf opam = 38 | let pp_cmd ppf l = Fmt.st [`Bold] ppf (String.concat " " l) in 39 | let maybe = if alt then "Or maybe try" else "Maybe try" in 40 | let pp_install ppf pkgs = pp_cmd ppf ("opam" :: "install" :: pkgs) in 41 | match opam with 42 | | `Exact pkg -> Fmt.pf ppf "@,@[%s %a@]" maybe pp_install [pkg] 43 | | `Fuzzy pkgs -> 44 | let alts = Fmt.or_enum (Fmt.st [`Bold]) in 45 | Fmt.pf ppf "@,@[%s %a with %a@]" maybe pp_install [] alts pkgs 46 | -------------------------------------------------------------------------------- /src/b0caml_opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [opam] support, move to [B00_kit]. *) 7 | 8 | open B0_std 9 | 10 | (** {1:pkg_list Listing packages} *) 11 | 12 | val uninstalled : 13 | ?search:Cmd.tool_search -> ?switch:string -> unit -> 14 | (String.Set.t, string) result 15 | (** [uninstalled ?search ~switch ()] is the set of uninstalled 16 | packages in the opam switch [switch]. [search] is given to 17 | {!Os.Cmd.find} to lookup [opam]. The empty set is returned 18 | if [opam] can't be looked up. *) 19 | 20 | (** {1:pkg_suggest Package suggestions} *) 21 | 22 | val pkg_suggestions : pkgs:String.Set.t -> pkg:string -> 23 | [ `Exact of string | `Fuzzy of string list ] option 24 | (** [pkg_suggestions ~pkgs ~pkg] is [Some (`Exact pkg)] if [pkg] is in 25 | [pkgs] or [Some (`Fuzzy pkgs)] if [pkgs] matches according to 26 | {!String.suggest} or [None] otherwise. *) 27 | 28 | val pp_maybe_try_install : 29 | alt:bool -> [`Exact of string | `Fuzzy of string list ] Fmt.t 30 | (** [pp_maybe_try_install ~alt] entices to install the given 31 | package. Formats a starting {!Fmt.cut} by a sentence 32 | of the form ["Maybe try opam install ..."]. If [alt] 33 | is [true] then the sentence starts with ["Or maybe try"]. *) 34 | -------------------------------------------------------------------------------- /src/b0caml_resolver.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0 programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | open B0_std.Fut.Syntax 8 | 9 | let ocamlpath_root_dirs ~ocamlpath = 10 | let add_dir acc dir = 11 | let add_root _ name p ds = String.Map.add_to_list name p ds in 12 | Log.if_error ~use:acc 13 | (Os.Dir.fold_dirs ~rel:false ~recurse:false add_root dir acc) 14 | in 15 | let ocamlpath = B0caml_ocamlpath.dirs ocamlpath in 16 | List.fold_left add_dir String.Map.empty (List.rev ocamlpath) 17 | 18 | type t = 19 | { m : B0_memo.t; 20 | memo_dir : Fpath.t; 21 | ocamlpath : B0caml_ocamlpath.t; 22 | ocamlpath_root_dirs : Fpath.t list String.Map.t; 23 | mutable dir_dirs : Fpath.Set.t Fpath.Map.t; 24 | mutable dir_cobjs : 25 | B0_ocaml.Cobj.t list Fut.t Fpath.Map.t; (* Mapped by dir. *) 26 | mutable mod_ref_cobj : B0_ocaml.Cobj.t list B0_ocaml.Modref.Map.t; } 27 | 28 | let create m ~memo_dir ~ocamlpath = 29 | { m; memo_dir; ocamlpath; 30 | ocamlpath_root_dirs = ocamlpath_root_dirs ~ocamlpath; 31 | dir_dirs = Fpath.Map.empty; 32 | dir_cobjs = Fpath.Map.empty; mod_ref_cobj = B0_ocaml.Modref.Map.empty } 33 | 34 | let ocamlpath r = r.ocamlpath 35 | 36 | let index_dir ~ext r dir = 37 | B0_memo.fail_if_error r.m @@ 38 | let add st _ f acc = match st.Unix.st_kind with 39 | | Unix.S_DIR -> 40 | r.dir_dirs <- Fpath.Map.add_to_set (module Fpath.Set) dir f r.dir_dirs; 41 | acc 42 | | _ -> if Fpath.has_ext ext f then (f :: acc) else acc 43 | in 44 | (Os.Dir.fold ~recurse:false add dir []) 45 | 46 | let get_cobjs_info r ~ext dir = match Fpath.Map.find dir r.dir_cobjs with 47 | | info -> info 48 | | exception Not_found -> 49 | let info, set_info = Fut.make () in 50 | r.dir_cobjs <- Fpath.Map.add dir info r.dir_cobjs; 51 | begin 52 | let cobjs = index_dir ~ext r dir in 53 | let o = 54 | let base = Fpath.basename dir in 55 | let uniq = 56 | Hash.to_hex (B0_memo.hash_string r.m (Fpath.to_string dir)) 57 | in 58 | Fpath.(r.memo_dir / Fmt.str "%s-%s%s.info" base uniq ext) 59 | in 60 | B0_memo.ready_files r.m cobjs; 61 | if ext = ".cmxa" then begin 62 | List.iter (fun o -> B0_memo.ready_file r.m (Fpath.set_ext ".a" o)) cobjs 63 | end; 64 | B0_ocaml.Cobj.write r.m ~cobjs ~o; 65 | ignore @@ 66 | let* cobjs = B0_ocaml.Cobj.read r.m o in 67 | let add_mod_ref cobj def = 68 | r.mod_ref_cobj <- 69 | B0_ocaml.Modref.Map.add_to_list def cobj r.mod_ref_cobj 70 | in 71 | let add_mod_refs cobj = 72 | B0_ocaml.Modref.Set.iter (add_mod_ref cobj) (B0_ocaml.Cobj.defs cobj) 73 | in 74 | List.iter add_mod_refs cobjs; 75 | set_info cobjs; 76 | Fut.return () 77 | end; 78 | info 79 | 80 | let try_find_mod_ref_root_dir r ref = 81 | let name = String.Ascii.lowercase (B0_ocaml.Modref.name ref) in 82 | match String.Map.find name r.ocamlpath_root_dirs with 83 | | p -> Some p 84 | | exception Not_found -> 85 | match String.cut_left ~sep:"_" name with 86 | | None -> None 87 | | Some (l, _) -> 88 | match String.Map.find name r.ocamlpath_root_dirs with 89 | | p -> Some p 90 | | exception Not_found -> None 91 | 92 | let amb r ~ext ref cobjs = 93 | let pext = ".p" ^ ext in (* TODO doc filter out profile objects *) 94 | let not_pext cobj = not (Fpath.has_ext pext (B0_ocaml.Cobj.file cobj)) in 95 | match List.filter not_pext cobjs with 96 | | [cobj] -> Fut.return (Some cobj) 97 | | cobjs -> 98 | (* FIXME constraints. *) 99 | B0_memo.notify r.m `Info "@[ambiguous resolution for %a:@,%a@]" 100 | B0_ocaml.Modref.pp ref (Fmt.list B0_ocaml.Cobj.pp) cobjs; 101 | Fut.return None 102 | 103 | let find_archive_for_mod_ref r ~ext ref = 104 | match B0_ocaml.Modref.Map.find ref r.mod_ref_cobj with 105 | | [cobj] -> Fut.return (Some cobj) 106 | | cobjs -> amb r ~ext ref cobjs 107 | | exception Not_found -> 108 | match try_find_mod_ref_root_dir r ref with 109 | | None -> Fut.return None 110 | | Some roots -> 111 | let root = List.hd roots (* FIXME *) in 112 | let* _ = get_cobjs_info r ~ext root in 113 | match B0_ocaml.Modref.Map.find ref r.mod_ref_cobj with 114 | | [cobj] -> Fut.return (Some cobj) 115 | | cobjs -> amb r ~ext ref cobjs 116 | | exception Not_found -> 117 | Fut.return None (* TODO subdirs and eventually whole scan *) 118 | 119 | let rec find_mod_refs r ~deps ~ext cobjs defined todo = 120 | match B0_ocaml.Modref.Set.choose todo with 121 | | exception Not_found -> 122 | let cobjs = 123 | let add cobj cobjs = 124 | match Fpath.basename ~strip_ext:true (B0_ocaml.Cobj.file cobj) with 125 | | "stdlib" -> cobjs 126 | | _libname -> cobj :: cobjs 127 | in 128 | B0_ocaml.Cobj.Set.fold add cobjs [] 129 | in 130 | let cobjs, _ = B0_ocaml.Cobj.sort ~deps cobjs in 131 | Fut.return cobjs 132 | | ref -> 133 | let todo = B0_ocaml.Modref.Set.remove ref todo in 134 | match B0_ocaml.Modref.Set.mem ref defined with 135 | | true -> find_mod_refs r ~deps ~ext cobjs defined todo 136 | | false -> 137 | Fut.bind (find_archive_for_mod_ref r ~ext ref) @@ function 138 | | None -> 139 | B0_memo.notify r.m `Info 140 | "No resolution for %a" B0_ocaml.Modref.pp ref; 141 | find_mod_refs r ~deps ~ext cobjs defined todo 142 | | Some cobj -> 143 | let cobjs = B0_ocaml.Cobj.Set.add cobj cobjs in 144 | let defined = 145 | B0_ocaml.Modref.Set.union (B0_ocaml.Cobj.defs cobj) defined 146 | in 147 | let new_refs = B0_ocaml.Modref.Set.diff (deps cobj) defined in 148 | let todo = B0_ocaml.Modref.Set.union todo new_refs in 149 | find_mod_refs r ~deps ~ext cobjs defined todo 150 | 151 | let find_archives_and_deps ?(deps = B0_ocaml.Cobj.link_deps) r ~code ~dirs = 152 | let ext = match code with `Byte -> ".cma" | `Native -> ".cmxa" in 153 | let* roots = Fut.of_list (List.map (get_cobjs_info r ~ext) dirs) in 154 | let roots = List.concat roots in 155 | let defined, to_find = 156 | let rec loop defs ldeps = function 157 | | [] -> defs, B0_ocaml.Modref.Set.diff ldeps defs 158 | | cobj :: cobjs -> 159 | let defs = B0_ocaml.Modref.Set.union (B0_ocaml.Cobj.defs cobj) defs in 160 | let ldeps = B0_ocaml.Modref.Set.union (deps cobj) ldeps in 161 | loop defs ldeps cobjs 162 | in 163 | loop B0_ocaml.Modref.Set.empty B0_ocaml.Modref.Set.empty roots 164 | in 165 | find_mod_refs r ~deps ~ext (B0_ocaml.Cobj.Set.of_list roots) defined to_find 166 | -------------------------------------------------------------------------------- /src/b0caml_resolver.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0 programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Library resolver *) 7 | 8 | open B0_std 9 | 10 | type t 11 | (** The type for library resolvers. *) 12 | 13 | val create : 14 | B0_memo.t -> memo_dir:Fpath.t -> ocamlpath:B0caml_ocamlpath.t -> t 15 | 16 | val ocamlpath : t -> B0caml_ocamlpath.t 17 | val find_archives_and_deps : 18 | ?deps:(B0_ocaml.Cobj.t -> B0_ocaml.Modref.Set.t) -> t -> 19 | code:B0_ocaml.Code.t -> dirs:B0_std.Fpath.t list -> 20 | B0_ocaml.Cobj.t list Fut.t 21 | -------------------------------------------------------------------------------- /src/b0caml_script.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | open B0_text 8 | 9 | let pp_bold pp = Fmt.st' [`Bold] pp 10 | 11 | (* Syntactic metadata *) 12 | 13 | let pp_loc = Tloc.pp_ocaml 14 | 15 | type smeta = Tloc.t 16 | let smeta ~loc = loc 17 | let loc m = m 18 | 19 | let loc_err_fmt ffmt m fmt = 20 | ffmt ("@[%a:@,@[%a: " ^^ fmt ^^ "@]@]") 21 | pp_loc (loc m) (Fmt.st [`Fg `Red; `Bold ]) "Error" 22 | 23 | let loc_errf m fmt = loc_err_fmt Fmt.str m fmt 24 | let loc_error m fmt = loc_err_fmt Fmt.error m fmt 25 | 26 | (* Scripts *) 27 | 28 | type t = 29 | { file : Fpath.t; 30 | shebang : (string * smeta) option; 31 | directories : (Fpath.t * smeta) list; 32 | mod_uses : (Fpath.t * smeta) list; 33 | ocaml_unit : string * smeta; } 34 | 35 | let file s = s.file 36 | let shebang s = s.shebang 37 | let directories s = s.directories 38 | let mod_uses s = s.mod_uses 39 | let ocaml_unit s = s.ocaml_unit 40 | 41 | let pp_dump ppf s = 42 | let pp_fst pp = Fmt.using fst pp in 43 | let pp_paths = Fmt.(list ~sep:sp (pp_fst Fpath.pp_quoted)) in 44 | Fmt.record 45 | [ Fmt.field "file" file Fpath.pp_quoted; 46 | Fmt.field "shebang" shebang (Fmt.option (pp_fst Fmt.string)); 47 | Fmt.field "directories" directories pp_paths; 48 | Fmt.field "mod-uses" mod_uses pp_paths; 49 | Fmt.field "ocaml_unit" ocaml_unit (Fmt.box @@ pp_fst Fmt.lines)] 50 | ppf s 51 | 52 | let pp_locs ppf s = 53 | let pp_loc ppf (_, smeta) = Fmt.pf ppf "%a:" pp_loc (loc smeta) in 54 | let pp_list ppf = function 55 | | [] -> () | l -> Fmt.list pp_loc ppf l; Fmt.cut ppf () 56 | in 57 | Fmt.pf ppf "@[%a%a%a%a@]" 58 | (Fmt.option Fmt.(pp_loc ++ cut)) (shebang s) 59 | pp_list (directories s) pp_list (mod_uses s) pp_loc (ocaml_unit s) 60 | 61 | (* Parsing *) 62 | 63 | let directives = ["#directory"; "#mod_use"] 64 | let pp_directive = pp_bold Fmt.string 65 | 66 | let is_dir_letter c = 67 | 0x61 <= c && c <= 0x7A || c = 0x5F || 0x41 <= c && c <= 0x5A 68 | 69 | let err_eoi msg d ~sbyte ~sline = 70 | Tdec.err_to_here d ~sbyte ~sline "Unexpected end of input: %s" msg 71 | 72 | let err_eoi_string = err_eoi "unclosed string" 73 | let err_eoi_esc = err_eoi "truncated escape" 74 | let err_exp_dir_arg d = Tdec.err_here d "Expected directive argument" 75 | let err_illegal_uchar d b = Tdec.err_here d "Illegal character U+%04X" b 76 | 77 | let curr_char d = (* TODO better escaping (this is for error reports) *) 78 | Tdec.tok_reset d; Tdec.tok_accept_uchar d; Tdec.tok_pop d 79 | 80 | let err_esc_illegal d ~sbyte ~sline pre = 81 | Tdec.err_to_here d ~sbyte ~sline "%s%s: illegal escape" pre (curr_char d) 82 | 83 | let err_unsupported_directive dir_loc dir = 84 | let hint = Fmt.must_be in 85 | let unknown = Fmt.(unknown' ~kind:(any "directives") pp_directive ~hint) in 86 | Tdec.err dir_loc (Fmt.str "@[%a@]" unknown ("#" ^ dir, directives)) 87 | 88 | let dec_byte d = match Tdec.byte d with 89 | | c when 0x00 <= c && c <= 0x08 || 0x0E <= c && c <= 0x1F || c = 0x7F -> 90 | err_illegal_uchar d c 91 | | c -> c 92 | [@@ ocaml.inline] 93 | 94 | let rec skip_ws d = match dec_byte d with 95 | | 0x20 | 0x09 | 0x0A | 0x0B | 0x0C | 0x0D -> Tdec.accept_byte d; skip_ws d 96 | | _ -> () 97 | 98 | let rec parse_directive_name d ~sbyte ~sline = match dec_byte d with 99 | | c when is_dir_letter c -> 100 | Tdec.tok_accept_byte d; parse_directive_name d ~sbyte ~sline 101 | | c -> 102 | let ebyte = Tdec.pos d - 1 and eline = Tdec.line d in 103 | let loc = Tdec.loc d ~sbyte ~ebyte ~sline ~eline in 104 | Tdec.tok_pop d, loc 105 | 106 | let parse_esc d = 107 | let sbyte = Tdec.pos d and sline = Tdec.line d in 108 | match (Tdec.accept_byte d; dec_byte d) with 109 | | 0x22 -> Tdec.accept_byte d; Tdec.tok_add_char d '"' 110 | | 0x5C -> Tdec.accept_byte d; Tdec.tok_add_char d '\\' 111 | | 0x0A | 0x0D -> (* continuation line *) skip_ws d 112 | | 0xFFFF -> err_eoi_esc d ~sbyte ~sline 113 | | _ -> err_esc_illegal d ~sbyte ~sline "\\" 114 | 115 | let parse_fpath_arg dir_loc d = match (skip_ws d; dec_byte d) with 116 | | 0x22 -> 117 | let rec loop d ~sbyte ~sline = match dec_byte d with 118 | | 0x22 -> 119 | let loc = Tdec.loc_to_here d ~sbyte ~sline in 120 | let fpath = match Fpath.of_string (Tdec.tok_pop d) with 121 | | Ok fpath -> fpath 122 | | Error e -> Tdec.err loc e 123 | in 124 | Tdec.accept_byte d; (fpath, smeta ~loc) 125 | | 0x5C -> parse_esc d; loop d ~sbyte ~sline 126 | | 0xFFFF -> err_eoi_string d ~sbyte ~sline 127 | | _ -> Tdec.tok_accept_byte d; loop d ~sbyte ~sline 128 | in 129 | let sbyte = Tdec.pos d and sline = Tdec.line d in 130 | Tdec.accept_byte d; loop ~sbyte ~sline d 131 | | c -> err_exp_dir_arg d 132 | 133 | let parse_directives d ~sbyte ~sline = 134 | let rec loop directories mod_uses d ~sbyte ~sline = 135 | let dep_dirs, dep_srcs = match parse_directive_name d ~sbyte ~sline with 136 | | "directory", dir_loc -> 137 | (parse_fpath_arg dir_loc d :: directories, mod_uses) 138 | | "mod_use", dir_loc -> 139 | (directories, parse_fpath_arg dir_loc d :: mod_uses) 140 | | dir, dir_loc -> 141 | err_unsupported_directive dir_loc dir 142 | in 143 | match (skip_ws d; dec_byte d) with 144 | | 0x23 (* # *) -> 145 | let sbyte = Tdec.pos d and sline = Tdec.line d in 146 | (Tdec.accept_byte d; loop dep_dirs dep_srcs d ~sbyte ~sline) 147 | | _ -> List.rev dep_dirs, List.rev dep_srcs 148 | in 149 | loop [] [] d ~sbyte ~sline 150 | 151 | let rec parse_shebang d ~sbyte ~sline = match dec_byte d with 152 | | 0x0A | 0x0D | 0xFFFF -> 153 | let ebyte = Tdec.pos d - 1 and eline = Tdec.line d in 154 | let smeta = smeta ~loc:(Tdec.loc d ~sbyte ~ebyte ~sline ~eline) in 155 | Some (Tdec.tok_pop d, smeta) 156 | | b -> Tdec.tok_accept_byte d; parse_shebang d ~sbyte ~sline 157 | 158 | let parse_preamble d = 159 | let ws_parse_directives d = match (skip_ws d; dec_byte d) with 160 | | 0x23 (* # *) -> 161 | let sbyte = Tdec.pos d and sline = Tdec.line d in 162 | (Tdec.accept_byte d; parse_directives d ~sbyte ~sline) 163 | | _ -> [], [] 164 | in 165 | match dec_byte d with 166 | | 0x23 (* # *) -> 167 | let sbyte = Tdec.pos d and sline = Tdec.line d in 168 | begin match Tdec.accept_byte d; dec_byte d with 169 | | 0x21 (* ! *) -> 170 | let () = Tdec.accept_byte d in 171 | let sbyte = Tdec.pos d and sline = Tdec.line d in 172 | let shebang = parse_shebang d ~sbyte ~sline in 173 | let dirs = ws_parse_directives d in 174 | shebang, dirs 175 | | c -> None, parse_directives d ~sbyte ~sline 176 | end 177 | | c -> None, ws_parse_directives d 178 | 179 | let of_string ~file src = 180 | try 181 | let d = Tdec.create ~file:(Fpath.to_string file) src in 182 | let shebang, (directories, mod_uses) = parse_preamble d in 183 | let rest = String.subrange ~first:(Tdec.pos d) src in 184 | let ocaml_unit = rest, smeta ~loc:(Tdec.loc_here d) in 185 | Ok { file; shebang; directories; mod_uses; ocaml_unit } 186 | with Tdec.Err (loc, e) -> loc_error loc "%a" (Fmt.vbox Fmt.lines) e 187 | 188 | (* #directory resolution *) 189 | 190 | type directory_resolution = Fpath.t * smeta 191 | type directory_resolution_error = Fpath.t * smeta * [`Error of string | `Miss ] 192 | 193 | let directory_resolution_dir (dir, _) = Fpath.add_dir_sep dir 194 | 195 | let resolve_directory ~ocamlpath script_root ~errs ~dirs (d, m) = 196 | match B0caml_ocamlpath.classify_path d with 197 | | `Concrete dir -> 198 | let dir = Fpath.(script_root // dir) in 199 | begin match Os.Dir.exists dir with 200 | | Error e -> Error ((dir, m, `Error e) :: errs) 201 | | Ok true -> Ok ((dir, m) :: dirs) 202 | | Ok false -> Error ((dir, m, `Miss) :: errs) 203 | end 204 | | `Logical dir -> 205 | let ocamlpath = B0caml_ocamlpath.dirs ocamlpath in 206 | let ds = List.map (fun r -> Fpath.append r dir) ocamlpath in 207 | let rec loop has_err errs has_dir dirs = function 208 | | [] -> 209 | if has_err then Error errs else 210 | if has_dir then Ok dirs else 211 | Error ((d, m, `Miss) :: errs) 212 | | dir :: ds -> 213 | begin match Os.Dir.exists dir with 214 | | Error e -> loop true ((dir, m, `Error e) :: errs) has_dir dirs ds 215 | | Ok true -> loop has_err errs true ((dir, m) :: dirs) ds 216 | | Ok false -> loop has_err errs has_dir dirs ds 217 | end 218 | in 219 | loop false errs false dirs ds 220 | 221 | let resolve_directories ~ocamlpath s = 222 | let rec loop ~ocamlpath script_root errs dirs = function 223 | | [] -> if errs = [] then Ok (List.rev dirs) else Error (List.rev errs) 224 | | d :: ds -> 225 | match resolve_directory ~ocamlpath script_root ~errs ~dirs d with 226 | | Ok dirs -> loop ~ocamlpath script_root errs dirs ds 227 | | Error errs -> loop ~ocamlpath script_root errs dirs ds 228 | in 229 | loop ~ocamlpath (Fpath.parent (file s)) [] [] (directories s) 230 | 231 | (* #mod_use support *) 232 | 233 | type mod_use_resolution = Fpath.t option * Fpath.t * smeta 234 | type mod_use_resolution_error = Fpath.t * smeta * [ `Error of string | `Miss ] 235 | 236 | let mod_use_resolution_files (intf, impl, _) = match intf with 237 | | None -> [impl] | Some intf -> [intf; impl] 238 | 239 | let resolve_mod_use script_root (mod_use, m) = 240 | let impl_file = Fpath.(script_root // mod_use) in 241 | match Os.File.exists impl_file with 242 | | Error e -> Error (impl_file, m, `Error e) 243 | | Ok false -> Error (impl_file, m, `Miss) 244 | | Ok true -> 245 | if not (Fpath.has_ext ".ml" impl_file) then Ok (None, impl_file, m) else 246 | let intf_file = Fpath.set_ext ".mli" impl_file in 247 | match Os.File.exists intf_file with 248 | | Error e -> Error (intf_file, m, `Error e) 249 | | Ok false -> Ok (None, impl_file, m) 250 | | Ok true -> Ok (Some intf_file, impl_file, m) 251 | 252 | let resolve_mod_uses s = 253 | let rec loop script_root errs fs = function 254 | | [] -> if errs = [] then Ok (List.rev fs) else Error (List.rev errs) 255 | | d :: ds -> 256 | match resolve_mod_use script_root d with 257 | | Ok f -> loop script_root errs (f :: fs) ds 258 | | Error e -> loop script_root (e :: errs) fs ds 259 | in 260 | loop (Fpath.parent (file s)) [] [] (mod_uses s) 261 | 262 | (* Script source *) 263 | 264 | let src ~mod_use_resolutions s = 265 | let read f m = match Os.File.read f with 266 | | Ok s -> s | Error e -> failwith (loc_errf m "%s" e) 267 | in 268 | let add_file f s l = s :: "\"\n" :: Fpath.to_string f :: "#1 \"" :: l in 269 | let add_mod_impl f s l = "\nend\n" :: add_file f s (" = struct\n" :: l) in 270 | let add_mod_intf f s l = "\nend\n" :: add_file f s (" : sig\n" :: l) in 271 | let add_mod_name n acc = n :: "module " :: acc in 272 | let add_dep_src acc (intf_file, impl_file, meta) = 273 | let name = Fpath.basename impl_file in 274 | let name = B0_ocaml.Modname.mangle_filename name in 275 | let impl = read impl_file meta in 276 | match intf_file with 277 | | None -> add_mod_impl impl_file impl @@ add_mod_name name acc 278 | | Some intf_file -> 279 | let intf = read intf_file meta in 280 | add_mod_impl impl_file impl @@ 281 | add_mod_intf intf_file intf @@ 282 | add_mod_name name acc 283 | in 284 | let add_ocaml_unit s l = 285 | let src, meta = ocaml_unit s in 286 | let line = string_of_int (fst (Tloc.sline (loc meta))) in 287 | src :: "\"\n" :: Fpath.to_string (file s) :: " \"" :: line :: "#" :: l 288 | in 289 | try 290 | let deps = List.fold_left add_dep_src [] mod_use_resolutions in 291 | let src = add_ocaml_unit s deps in 292 | Ok (String.concat "" (List.rev src)) 293 | with 294 | | Failure e -> Error e 295 | -------------------------------------------------------------------------------- /src/b0caml_script.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OCaml scripts *) 7 | 8 | open B0_std 9 | open B0_text 10 | 11 | (** {1:meta Syntactic metadata} *) 12 | 13 | type smeta 14 | (** Metadata attached to syntactic constructs. *) 15 | 16 | val loc : smeta -> Tloc.t 17 | (** [loc i] is the text source location of [i]. *) 18 | 19 | val loc_errf : smeta -> 20 | ('a, Format.formatter, unit, string) format4 -> 'a 21 | (** [loc_errf smeta fmt] formats an error for the location in smeta. *) 22 | 23 | (** {1:scripts Scripts} *) 24 | 25 | type t 26 | (** The type for scripts. *) 27 | 28 | val of_string : file:Fpath.t -> string -> (t, string) result 29 | (** [of_string ?file s] parses a b0caml script from [s]. [file] is 30 | the file used for locations, it must be an absolute file path. *) 31 | 32 | val file : t -> Fpath.t 33 | (** [file s] is the script's file. *) 34 | 35 | val shebang : t -> (string * smeta) option 36 | (** [shebang s] is the optional shebang line without the shebang 37 | and the new line. *) 38 | 39 | val directories : t -> (Fpath.t * smeta) list 40 | (** [directories s] are the script's [#directory] directives. The location 41 | spans the directive's argument. Relative file paths or [+] are not 42 | resolved. See {!directory_resolution}. *) 43 | 44 | val mod_uses : t -> (Fpath.t * smeta) list 45 | (** [mod_uses s] are the script's [#mod_use] directives. The location 46 | spans the directive's argument. Relative file paths are not 47 | resolved. See {!mod_use_resolution}. *) 48 | 49 | val ocaml_unit : t -> string * smeta 50 | (** [ocaml_unit s] is the script's OCaml implementation unit. *) 51 | 52 | val pp_dump : t Fmt.t 53 | (** [pp_dump] dumps the parsed script. *) 54 | 55 | val pp_locs : t Fmt.t 56 | (** [pp_locs] dumps the source text locations of [s]. *) 57 | 58 | (** {1:directory_resolution [#directory] resolution} *) 59 | 60 | type directory_resolution = Fpath.t * smeta 61 | (** The type for [#directory] resolution results. An absolute path to 62 | a existing directory and the directive where it originates 63 | from. *) 64 | 65 | type directory_resolution_error = Fpath.t * smeta * [`Error of string | `Miss ] 66 | (** The type for [#directory] resolution error. An absolute or logical 67 | path that failed to resolve, the directive where it originates 68 | from and either a file system error or a missing error. *) 69 | 70 | val directory_resolution_dir : directory_resolution -> Fpath.t 71 | (** [directory_resolution_dir res] is the directory mentioned in 72 | [res]. The file path is syntactically a 73 | {{!Fpath.is_dir_path}directory path}. *) 74 | 75 | val resolve_directories : 76 | ocamlpath:B0caml_ocamlpath.t -> t -> 77 | (directory_resolution list, directory_resolution_error list) result 78 | (** [resolve_directories ~ocamlpath s] resolves the [#directory] 79 | directives of [s] according to [ocamlpath]. See the types for a 80 | description of the result. *) 81 | 82 | (** {1:mod_use_resolution [#mod_use] resolution} *) 83 | 84 | type mod_use_resolution = Fpath.t option * Fpath.t * smeta 85 | (** The type for [#mod_use] resolution results. An absolute path to an 86 | optional existing interface file, an absolute path to an existing 87 | implementation file and the directive where it originates from. *) 88 | 89 | type mod_use_resolution_error = Fpath.t * smeta * [`Error of string | `Miss ] 90 | (** The type for [#mod_use] resolution errors. An absolute paths to an 91 | a resolved file and either a file system error or a missing file. *) 92 | 93 | val mod_use_resolution_files : mod_use_resolution -> Fpath.t list 94 | (** [mod_use_resolution_files res] are the files mentioned in [res]. *) 95 | 96 | val resolve_mod_uses : 97 | t -> (mod_use_resolution list, mod_use_resolution_error list) result 98 | (** [resolve_mod_uses s] resolves the [#mod_use] directives of [s]. See the 99 | types for a description of the result. *) 100 | 101 | (** {1:src Script source} *) 102 | 103 | val src : 104 | mod_use_resolutions:mod_use_resolution list -> t -> (string, string) result 105 | (** [src ~mod_use_resolutions s] uses [mod_use_resolutions] (see 106 | {!resolve_mod_uses}) to produce the final script source of [s]. *) 107 | -------------------------------------------------------------------------------- /src/tool/b0caml_cli.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | 8 | let delete_script_cache c script = 9 | Result.bind (B0caml.get_script_file c script) @@ fun script_file -> 10 | let build_dir = B0caml.script_build_dir c ~script_file in 11 | Result.bind (Os.Dir.exists build_dir) @@ function 12 | | false -> Ok () 13 | | true -> 14 | let log = B0caml.script_build_log ~build_dir in 15 | Result.bind (B0_memo_log.read log) @@ fun log -> 16 | Result.bind (Os.Path.delete ~recurse:true build_dir) @@ fun _ -> 17 | let add_key acc o = match B0_zero.Op.hash o with 18 | | k when Hash.is_nil k -> acc | k -> Hash.to_hex k :: acc 19 | in 20 | let keys = List.fold_left add_key [] (B0_memo_log.ops log) in 21 | let dir = B0caml.Conf.b0_cache_dir c in 22 | Result.bind (B0_cli.File_cache.delete ~dir (`Keys keys)) @@ 23 | fun _ -> Ok () 24 | 25 | let show_script_path c script = 26 | Result.bind (B0caml.get_script_file c script) @@ fun script_file -> 27 | let build_dir = B0caml.script_build_dir c ~script_file in 28 | Ok (Log.stdout (fun m -> m "%a" Fpath.pp_unquoted build_dir)) 29 | 30 | let cache_cmd c action scripts = 31 | (* The notion of cache for `b0caml` is a bit different from a build 32 | system one. So B00_ui.File_cache cannot simply be reused off the 33 | shelf. Some adjustements should be made here or generalization there. *) 34 | Log.if_error ~use:B0caml.Exit.conf_error @@ 35 | Result.bind c @@ fun c -> 36 | match action with 37 | | `Delete -> 38 | begin match scripts with 39 | | [] -> 40 | let cache_dir = B0caml.Conf.cache_dir c in 41 | let pp_path = Fmt.st' [`Bold] Fpath.pp_unquoted in 42 | Log.stdout begin fun m -> 43 | m "Deleting %a, this may take some time..." pp_path cache_dir 44 | end; 45 | Log.if_error' ~use:B0caml.Exit.some_error @@ 46 | Result.bind (Os.Path.delete ~recurse:true cache_dir) @@ fun _ -> 47 | Ok B0caml.Exit.ok 48 | | scripts -> 49 | let delete acc script = 50 | let ok () = acc in 51 | let error e = Log.if_error ~use:B0caml.Exit.some_error (Error e) in 52 | Result.fold ~ok ~error (delete_script_cache c script) 53 | in 54 | Ok (List.fold_left delete B0caml.Exit.ok scripts) 55 | end 56 | | `Gc -> 57 | Log.stdout (fun m -> m "the gc subcommand is TODO"); 58 | Ok B0caml.Exit.some_error 59 | | `Path -> 60 | begin match scripts with 61 | | [] -> 62 | Log.stdout 63 | (fun m -> m "%a" Fpath.pp_unquoted (B0caml.Conf.cache_dir c)); 64 | Ok B0caml.Exit.some_error 65 | | scripts -> 66 | let show_path acc script = 67 | let ok () = acc in 68 | let error e = Log.if_error ~use:B0caml.Exit.some_error (Error e) in 69 | Result.fold ~ok ~error (show_script_path c script) 70 | in 71 | Ok (List.fold_left show_path B0caml.Exit.ok scripts) 72 | end 73 | | `Stats -> 74 | let dir = B0caml.Conf.b0_cache_dir c in 75 | let used = String.Set.empty in (* TODO *) 76 | Result.bind (B0_cli.File_cache.stats ~dir ~used) @@ 77 | fun _ -> Ok B0caml.Exit.ok 78 | | `Trim -> 79 | Log.stdout (fun m -> m "the trim subcommand is TODO"); 80 | Ok B0caml.Exit.some_error 81 | 82 | let deps_cmd c script_file raw directory mod_use root = 83 | Log.if_error ~use:B0caml.Exit.conf_error @@ 84 | Result.bind c @@ fun c -> 85 | Log.if_error' ~header:"" ~use:B0caml.Exit.comp_error @@ 86 | Result.bind (B0caml.get_script c script_file) @@ fun s -> 87 | match root with 88 | | true -> 89 | let directories = B0caml_script.directories s in 90 | let root (d, _) = B0caml_ocamlpath.logical_path_root_name d in 91 | let roots = String.distinct (List.filter_map root directories) in 92 | let pp_roots = Fmt.(vbox @@ list string) in 93 | if roots <> [] then Log.stdout (fun m -> m "%a" pp_roots roots); 94 | Ok B0caml.Exit.ok 95 | | false -> 96 | let directories c s raw = 97 | if raw then Ok (List.map fst (B0caml_script.directories s)) else 98 | let ocamlpath = B0caml.Conf.ocamlpath c in 99 | Result.map_error (B0caml.Err.directories ~ocamlpath) @@ 100 | Result.bind (B0caml_script.resolve_directories ~ocamlpath s) @@ 101 | fun dirs -> Ok (List.map B0caml_script.directory_resolution_dir dirs) 102 | in 103 | let mod_uses s raw = 104 | if raw then Ok (List.map fst (B0caml_script.mod_uses s)) else 105 | Result.map_error B0caml.Err.mod_uses @@ 106 | Result.bind (B0caml_script.resolve_mod_uses s) @@ fun files -> 107 | Ok (List.concat_map B0caml_script.mod_use_resolution_files files) 108 | in 109 | Log.if_error' ~header:"" ~use:B0caml.Exit.miss_dep_error @@ 110 | let all = not directory && not mod_use in 111 | let ds = if (directory || all) then directories c s raw else Ok [] in 112 | let ms = if (mod_use || all) then mod_uses s raw else Ok [] in 113 | let deps = match ds, ms with 114 | | Error de, Error me -> Error (String.concat "\n\n" [de; me]) 115 | | Error e, _ | _, Error e -> Error e 116 | | Ok ds, Ok ms -> Ok (List.append ds ms) 117 | in 118 | let pp_deps = Fmt.(vbox @@ list Fpath.pp_unquoted) in 119 | Result.bind deps @@ fun deps -> 120 | if deps <> [] then Log.stdout (fun m -> m "%a" pp_deps deps); 121 | Ok B0caml.Exit.ok 122 | 123 | let exec_cmd c mode script_file script_args = 124 | Log.if_error ~use:B0caml.Exit.conf_error @@ 125 | Result.bind c @@ fun c -> 126 | Log.if_error' ~header:"" ~use:B0caml.Exit.comp_error @@ 127 | Result.bind (B0caml.get_script c script_file) @@ fun s -> 128 | match mode with 129 | | `Source -> 130 | Result.bind (B0caml.get_source c s) @@ fun src -> 131 | Log.stdout (fun m -> m "%s" src); Ok B0caml.Exit.ok 132 | | `Compile -> 133 | Result.bind (B0caml.compile_script c s) @@ fun exe -> 134 | Ok B0caml.Exit.ok 135 | | `Exec -> 136 | Result.bind (B0caml.compile_script c s) @@ fun exe -> 137 | let cmd = Cmd.list (script_file :: script_args) in 138 | Ok (B0caml.Exit.Exec (exe, cmd)) 139 | | `Utop -> failwith "TODO" 140 | | `Top -> failwith "TODO" 141 | 142 | let log_cmd c script_file no_pager format details op_selector = 143 | Log.if_error ~use:B0caml.Exit.conf_error @@ 144 | Result.bind c @@ fun c -> 145 | let don't = no_pager || format = `Trace_event in 146 | Result.bind (B0_pager.find ~don't ()) @@ fun pager -> 147 | Result.bind (B0_pager.page_stdout pager) @@ fun () -> 148 | Result.bind (B0caml.get_script_file c script_file) @@ fun script_file -> 149 | let build_dir = B0caml.script_build_dir c ~script_file in 150 | let log = B0caml.script_build_log ~build_dir in 151 | Log.if_error' ~use:B0caml.Exit.miss_log_error @@ 152 | Result.bind (B0_memo_log.read log) @@ fun l -> 153 | B0_cli.Memo.Log.out Fmt.stdout format details op_selector ~path:log l; 154 | Ok B0caml.Exit.ok 155 | 156 | (* Command line interface *) 157 | 158 | open Cmdliner 159 | 160 | let conf () = 161 | let docs = Manpage.s_common_options in 162 | let comp_target = 163 | let env = 164 | let doc = "Force default compilation target to $(b,byte), $(b,native) \ 165 | or $(b,auto). See $(b,--byte) and $(b,--native) options." 166 | in 167 | Cmd.Env.info ~doc B0caml.Env.comp_target 168 | in 169 | let targets = 170 | let t enum arg doc = Some enum, Arg.info [arg] ~doc ~docs ~env in 171 | [ t `Byte "byte" "Compile to bytecode (default if no native code)."; 172 | t `Native "native" "Compile to native code (default if available)." ] 173 | in 174 | let cli_arg = Arg.(value & vflag None targets) in 175 | (* cmdliner doesn't support env for vflag we do it manually here *) 176 | let target = function 177 | | Some _ as t -> t 178 | | None -> 179 | Log.if_error ~use:None @@ 180 | Os.Env.find' ~empty_is_none:true 181 | B0caml.Conf.comp_target_of_string B0caml.Env.comp_target 182 | in 183 | Term.(const target $ cli_arg) 184 | in 185 | let cache_dir = 186 | let env = Cmd.Env.info B0caml.Env.cache_dir in 187 | let doc = "Cache directory." and docv = "PATH" in 188 | let none = "$(b,XDG_CACHE_HOME)/b0caml" in 189 | Arg.(value & opt (Arg.some ~none B0_std_cli.fpath) None & 190 | info ["cache-dir"] ~doc ~docv ~docs ~env) 191 | in 192 | let color = 193 | let env = Cmd.Env.info B0caml.Env.color in 194 | B0_std_cli.color ~docs ~env () 195 | in 196 | let log_level = 197 | let env = Cmd.Env.info B0caml.Env.verbosity in 198 | B0_std_cli.log_level ~docs ~env () 199 | in 200 | let conf cache_dir color log_level comp_target = 201 | B0caml.Conf.setup_with_cli ~cache_dir ~comp_target ~color ~log_level () 202 | in 203 | Term.(const conf $ cache_dir $ color $ log_level $ comp_target) 204 | 205 | let cmd () = 206 | let exit_info c doc = match c with 207 | | B0caml.Exit.Code c -> Cmd.Exit.info c ~doc 208 | | _ -> assert false 209 | in 210 | let exits = 211 | exit_info B0caml.Exit.conf_error "on configuration error." :: 212 | Cmd.Exit.defaults 213 | in 214 | let some_error_exit = 215 | exit_info B0caml.Exit.some_error 216 | "on indiscriminate errors reported on stderr." 217 | in 218 | let exec_exits = 219 | Cmd.Exit.info 0 ~max:255 220 | ~doc:"on script execution, the script exit code." :: 221 | exit_info B0caml.Exit.comp_error "on script compilation error." :: 222 | exits 223 | in 224 | let conf = conf () in 225 | let sdocs = Manpage.s_common_options in 226 | let s_exec_modes = "EXECUTION MODES" in 227 | let man_see_manual = `Blocks 228 | [ `S Manpage.s_see_also; 229 | `P "Consult $(b,odig doc b0caml) for a tutorial and more details."] 230 | in 231 | let script_file = 232 | let doc = "The script." and docv = "SCRIPT" in 233 | Arg.(required & pos 0 (some string) None & info [] ~doc ~docv) 234 | in 235 | let cache_cmd = 236 | (* TODO redo *) 237 | let doc = "Manage the script cache" in 238 | let man_xrefs = [`Main; `Tool "b00-cache"] in 239 | let man = [ 240 | `S Manpage.s_synopsis; 241 | `P "$(mname) $(tname) $(i,ACTION) [$(i,OPTION)]..."; 242 | `S Manpage.s_description; 243 | `P "The $(tname) command operates on the script cache."; 244 | `S "ACTIONS"; 245 | `I ("$(b,delete) [$(i,SCRIPT)]...", 246 | "Delete the cache or the build of the given $(i,SCRIPT)."); 247 | `I ("$(b,gc)", "Delete unused keys (need a file systems with \ 248 | hardlinks)"); 249 | `I ("$(b,path) [$(i,SCRIPT)]...", "Display the path to the cache or \ 250 | the given script caches."); 251 | `I ("$(b,stats)", "Show cache statistics."); 252 | `I ("$(b,trim)", "Trim the cache to 50% of its size."); 253 | man_see_manual; ] 254 | in 255 | let exits = some_error_exit :: exits in 256 | let action = 257 | let action = 258 | [ "delete", `Delete; "gc", `Gc; "path", `Path; "stats", `Stats; 259 | "trim", `Trim ] 260 | in 261 | let doc = 262 | Fmt.str "The action to perform. $(docv) must be one of %s." 263 | (Arg.doc_alts_enum action) 264 | in 265 | let action = Arg.enum action in 266 | Arg.(required & pos 0 (some action) None & info [] ~doc ~docv:"ACTION") 267 | in 268 | let scripts = 269 | let doc = "The script(s)." and docv = "SCRIPT" in 270 | Arg.(value & pos_right 0 string [] & info [] ~doc ~docv) 271 | in 272 | Cmd.v (Cmd.info "cache" ~doc ~sdocs ~exits ~man ~man_xrefs) 273 | Term.(const cache_cmd $ conf $ action $ scripts) 274 | in 275 | let deps_cmd = 276 | let doc = "Show script dependencies" in 277 | let man_xrefs = [`Main ] in 278 | let man = [ 279 | `S Manpage.s_description; 280 | `P "The $(tname) command shows the $(b,#directory) and \ 281 | $(b,#mod_use) dependency resolutions of a script. If \ 282 | $(b,--raw) is specified directive arguments are shown without \ 283 | resolution."; 284 | `P "Without options shows the result of both $(b,--directory) and \ 285 | $(b,--mod-use)."; 286 | man_see_manual; ] 287 | in 288 | let exits = 289 | exit_info B0caml.Exit.miss_dep_error 290 | "on missing $(b,#mod_use) or $(b,#directory) path." :: exits 291 | in 292 | let flag f doc = Arg.(value & flag & info [f] ~doc) in 293 | let directory = 294 | flag "directory" 295 | "Show $(b,#directory) resolutions. These resolutions \ 296 | always have a trailing directory seperator; this can be used to 297 | distinguish them from $(b,--mod-use) resolutions." 298 | in 299 | let mod_use = flag "mod-use" "Show $(b,#mod_use) resolutions." in 300 | let root = 301 | flag "root" "Only list root names of $(b,+) $(b,#directory) directives. \ 302 | Takes over other options." 303 | in 304 | let raw = 305 | flag "raw" "Show raw directive arguments without resolving them." 306 | in 307 | Cmd.v (Cmd.info "deps" ~doc ~sdocs ~exits ~man ~man_xrefs) 308 | Term.(const deps_cmd $ conf $ script_file $ raw $ directory $ 309 | mod_use $ root) 310 | in 311 | let exec_cmd, exec_term = 312 | let doc = "Execute script (default command)" and man_xrefs = [`Main ] in 313 | let man = [ 314 | `S Manpage.s_description; 315 | `P "The $(tname) command executes a script with the given arguments."; 316 | `S s_exec_modes; 317 | man_see_manual; 318 | ] 319 | in 320 | let mode = 321 | let docs = s_exec_modes in 322 | let modes = 323 | let m arg doc = Arg.info [arg] ~doc ~docs in 324 | [ `Source, m "source" "Output final script source. No execution."; 325 | `Compile, m "compile" "Compile and cache the script. No execution."; 326 | `Top, m "top" "Load script in the $(b,ocaml) interactive toplevel."; 327 | `Utop, m "utop" "Load script in the $(b,utop) interactive toplevel."; 328 | `Exec, m "exec" "Compile and execute script (default)."; ] 329 | in 330 | Arg.(value & vflag `Exec modes) 331 | in 332 | let script_file = 333 | let doc = "The script. Needs to contain a path separator to be \ 334 | recognized as such." 335 | in 336 | let docv = "SCRIPT" in 337 | Arg.(required & pos 0 (some string) None & info [] ~doc ~docv) 338 | in 339 | let args = 340 | let doc = "Argument for the script." and docv = "ARG" in 341 | Arg.(value & pos_right 0 string [] & info [] ~doc ~docv) 342 | in 343 | let term = Term.(const exec_cmd $ conf $ mode $ script_file $ args) in 344 | Cmd.v (Cmd.info "exec" ~doc ~sdocs ~exits ~man ~man_xrefs) term, term 345 | in 346 | let log_cmd = 347 | let doc = "Show script build logs" in 348 | let man_xrefs = [`Main; `Tool "b00-log"] in 349 | let docs_format = "OUTPUT FORMAT" in 350 | let docs_details = "OUTPUT DETAILS" in 351 | let docs_select = "OPTIONS FOR SELECTING OPERATIONS" in 352 | let envs = B0_pager.Env.infos in 353 | let man = [ 354 | `S Manpage.s_description; 355 | `P "The $(tname) command shows build log of a script."; 356 | `Blocks B0_cli.Op.query_man; 357 | `S docs_format; 358 | `S docs_details; 359 | `S docs_select; ] 360 | in 361 | let exits = 362 | exit_info B0caml.Exit.miss_dep_error "on missing log." :: exits 363 | in 364 | Cmd.v (Cmd.info "log" ~doc ~sdocs ~exits ~envs ~man ~man_xrefs) 365 | Term.(const log_cmd $ conf $ script_file $ B0_pager.don't () $ 366 | B0_cli.Memo.Log.out_format_cli ~docs:docs_details () $ 367 | B0_std_cli.output_format ~docs:docs_format () $ 368 | B0_cli.Op.query_cli ~docs:docs_select ()) 369 | in 370 | let main_cmd = 371 | let doc = "Easy OCaml scripts" in 372 | let man = [ 373 | `S Manpage.s_synopsis; 374 | `Pre "$(mname) $(b,--) $(i,SCRIPT) [$(i,ARG)]..."; `Noblank; 375 | `Pre "$(mname) [$(i,OPTION)]... $(i,SCRIPT) -- [$(i,ARG)]..."; `Noblank; 376 | `Pre "$(mname) $(i,COMMAND) [$(i,OPTION)]..."; 377 | `S Manpage.s_description; 378 | `P "$(mname) executes OCaml scripts. More information is available \ 379 | in the manual, see $(b,odig doc b0caml)."; 380 | `P "If the first argument of $(mname) has a path separator then it \ 381 | assumes a path to script $(i,SCRIPT) and executes it with all 382 | remaining arguments. This is what happens on shebang execution."; 383 | `Pre "Use '$(mname) $(b,--help)' for help."; `Noblank; 384 | `Pre "Use '$(mname) $(i,COMMAND) $(b,--help)' for help on \ 385 | command $(i,COMMAND)."; 386 | `S Manpage.s_arguments; 387 | `S s_exec_modes; 388 | `S Manpage.s_common_options; 389 | man_see_manual; 390 | `S Manpage.s_bugs; 391 | `P "Report them, see $(i,%%PKG_HOMEPAGE%%) for contact information."; ] 392 | in 393 | let exits = exec_exits in 394 | Cmd.group 395 | Cmd.(info "b0caml" ~version:"%%VERSION%%" ~doc ~sdocs ~exits ~man) 396 | ~default:exec_term [cache_cmd; deps_cmd; exec_cmd; log_cmd;] 397 | in 398 | main_cmd 399 | -------------------------------------------------------------------------------- /src/tool/b0caml_cli.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [b0caml] cmdliner command. *) 7 | 8 | val cmd : unit -> B0caml.Exit.t Cmdliner.Cmd.t 9 | (** [cmdliner] command for [b0caml]. *) 10 | -------------------------------------------------------------------------------- /src/tool/b0caml_main.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2019 The b0caml programmers. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open B0_std 7 | 8 | let run_main f = Log.time (fun _ m -> m "total time b0caml %%VERSION%%") f 9 | let exit_main = function 10 | | B0caml.Exit.Code c -> exit c 11 | | B0caml.Exit.Exec (exe, cmd) -> 12 | exit @@ Log.if_error ~use:B0caml.Exit.(code some_error) @@ 13 | let argv0 = Fpath.to_string (Cmd.find_tool cmd |> Option.get) in 14 | let cmd = Cmd.set_tool exe cmd in 15 | Result.bind (Os.Cmd.execv ~argv0 cmd) @@ fun _ -> assert false 16 | 17 | let main_without_cli script_file script_args = 18 | let res = 19 | run_main @@ fun () -> 20 | Log.if_error ~header:"" ~use:B0caml.Exit.comp_error @@ 21 | Result.bind (B0caml.Conf.setup_without_cli ()) @@ fun c -> 22 | Result.bind (B0caml.get_script c script_file) @@ fun s -> 23 | Result.bind (B0caml.compile_script c s) @@ fun exe -> 24 | Ok (B0caml.Exit.Exec (exe, Cmd.list (script_file :: script_args))) 25 | in 26 | exit_main res 27 | 28 | let main_with_cli () = 29 | let res = run_main @@ fun () -> Cmdliner.Cmd.eval_value (B0caml_cli.cmd ()) in 30 | let exit = match res with 31 | | Ok (`Ok res) -> res 32 | | Ok `Version -> B0caml.Exit.ok 33 | | Ok `Help -> B0caml.Exit.ok 34 | | Error `Term -> B0caml.Exit.conf_error 35 | | Error `Parse -> B0caml.Exit.Code Cmdliner.Cmd.Exit.cli_error 36 | | Error `Exn -> B0caml.Exit.Code Cmdliner.Cmd.Exit.internal_error 37 | in 38 | exit_main exit 39 | 40 | let main () = 41 | try match List.tl (Array.to_list Sys.argv) with 42 | | file :: args when Fpath.has_dir_sep file -> main_without_cli file args 43 | | _ -> main_with_cli () 44 | with 45 | | e -> 46 | let bt = Printexc.get_raw_backtrace () in 47 | Fmt.epr "%s: @[internal error, uncaught exception:@\n%a@]@." 48 | (Filename.basename Sys.argv.(0)) Fmt.exn_backtrace (e, bt); 49 | exit (Cmdliner.Cmd.Exit.internal_error) 50 | 51 | let () = if !Sys.interactive then () else main () 52 | -------------------------------------------------------------------------------- /test/conf.ml: -------------------------------------------------------------------------------- 1 | (* SPDX-License-Identifier: CC0-1.0 *) 2 | 3 | let lang = "fr" 4 | -------------------------------------------------------------------------------- /test/echo: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | 3 | (* SPDX-License-Identifier: CC0-1.0 *) 4 | 5 | let echo oc ss = output_string oc (String.concat " " ss ^ "\n") 6 | let () = echo stdout (List.tl (Array.to_list Sys.argv)) 7 | -------------------------------------------------------------------------------- /test/errors/deps: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | 3 | #directory "+notnonot" 4 | #directory "thatdir" 5 | 6 | #mod_use "that_module.ml" 7 | 8 | #directory "/that/could/exist" 9 | 10 | #mod_use "/that/could/also/exist.ml" 11 | -------------------------------------------------------------------------------- /test/errors/opam: -------------------------------------------------------------------------------- 1 | 2 | #directory "+otr" 3 | 4 | #directory "+bes" 5 | 6 | #directory "+bpf" 7 | 8 | #directory "+zbar/bla" -------------------------------------------------------------------------------- /test/errors/ptime: -------------------------------------------------------------------------------- 1 | 2 | #directory "+patime/os" 3 | #directory "+patime/bla" 4 | #directory "+ptime/bla" 5 | -------------------------------------------------------------------------------- /test/grep: -------------------------------------------------------------------------------- 1 | ../test/perf/b0caml/grep -------------------------------------------------------------------------------- /test/local-time: -------------------------------------------------------------------------------- 1 | ../test/perf/b0caml/local-time -------------------------------------------------------------------------------- /test/miaow: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #mod_use "conf.ml" 3 | 4 | (* SPDX-License-Identifier: CC0-1.0 *) 5 | 6 | let scream = match Conf.lang with | "fr" -> "Miaou!" | _ -> "Miaow!" 7 | let main () = print_endline scream 8 | let () = if !Sys.interactive then () else main () 9 | -------------------------------------------------------------------------------- /test/mod-use/conf.ml: -------------------------------------------------------------------------------- 1 | let lang = "hr" 2 | -------------------------------------------------------------------------------- /test/mod-use/test: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #mod_use "conf.ml" 3 | #mod_use "with_mli.ml" 4 | 5 | let () = output_line stdout "Ho!" 6 | -------------------------------------------------------------------------------- /test/mod-use/with_mli.ml: -------------------------------------------------------------------------------- 1 | let x = 3 2 | -------------------------------------------------------------------------------- /test/mod-use/with_mli.mli: -------------------------------------------------------------------------------- 1 | val x : int 2 | -------------------------------------------------------------------------------- /test/perf/README.md: -------------------------------------------------------------------------------- 1 | Note all the scripts go through the /usr/bin/env shebang, even `sh`. 2 | -------------------------------------------------------------------------------- /test/perf/b0caml/base: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+base" 3 | 4 | open Base 5 | let main () = ignore (Base.Sys.runtime_variant ()) 6 | let () = if !Sys.interactive then () else main () 7 | -------------------------------------------------------------------------------- /test/perf/b0caml/bos: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+bos" 3 | 4 | open Bos_setup 5 | 6 | let main () = Logs.app (fun m -> m "Hello bos!") 7 | let () = if !Sys.interactive then () else main () 8 | -------------------------------------------------------------------------------- /test/perf/b0caml/containers: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+containers" 3 | 4 | 5 | let main () = CCIO.write_line stdout "Hello containers!" 6 | let () = if !Sys.interactive then () else main () 7 | -------------------------------------------------------------------------------- /test/perf/b0caml/grep: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+re" 3 | #directory "+b0/std" 4 | 5 | (* SPDX-License-Identifier: CC0-1.0 *) 6 | 7 | open B0_std (* for the Fmt, Os and Fpath modules *) 8 | 9 | let err fmt = Fmt.pf Fmt.stderr (fmt ^^ "@.") 10 | let err_none e = err "%s" e; None 11 | let log_if_error r = Result.fold ~ok:Option.some ~error:err_none r 12 | 13 | let filepath s = log_if_error (Fpath.of_string s) 14 | let content p = Option.map (fun s -> p, s) (log_if_error (Os.File.read p)) 15 | let match_content re (file, data) = 16 | let matches line = if Re.execp re line then Some (file, line) else None in 17 | List.filter_map matches (String.split_on_char '\n' data) 18 | 19 | let main () = 20 | let pat, files = match List.tl (Array.to_list Sys.argv) with 21 | | pat :: [] -> pat, [Fpath.dash] (* stdin *) 22 | | pat :: files -> pat, List.filter_map filepath files 23 | | [] -> err "usage: PATTERN FILE..."; exit 2 24 | in 25 | let re = match Re.Posix.(compile @@ re pat) with 26 | | exception Re.Posix.Parse_error -> err "%S: parse error" pat; exit 2 27 | | exception Re.Posix.Not_supported -> err "%S: parse error" pat; exit 2 28 | | re -> re 29 | in 30 | let data = List.filter_map content files in 31 | match List.concat_map (match_content re) data with 32 | | [] -> () 33 | | matches -> 34 | let pp_match ppf (p, m) = Fmt.pf ppf "@[%a: %s@]" Fpath.pp_unquoted p m in 35 | Fmt.pf Fmt.stdout "@[%a@]@." (Fmt.list pp_match) matches 36 | 37 | let () = if !Sys.interactive then () else main () 38 | -------------------------------------------------------------------------------- /test/perf/b0caml/hello: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | print_endline "Hello!" -------------------------------------------------------------------------------- /test/perf/b0caml/local-time: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+ptime" 3 | #directory "+ptime/clock" 4 | 5 | (* SPDX-License-Identifier: CC0-1.0 *) 6 | 7 | let to_string () = 8 | let now = Ptime_clock.now () in 9 | let tz_offset_s = Ptime_clock.current_tz_offset_s () in 10 | Format.asprintf "%a" (Ptime.pp_human ?tz_offset_s ()) now 11 | 12 | let main () = print_endline (to_string ()) 13 | let () = if !Sys.interactive then () else main () 14 | -------------------------------------------------------------------------------- /test/perf/b0caml/nop: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | -------------------------------------------------------------------------------- /test/perf/b0caml/zero: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | exit 0 -------------------------------------------------------------------------------- /test/perf/python/hello: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | print "Hello!" 3 | -------------------------------------------------------------------------------- /test/perf/python/nop: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | -------------------------------------------------------------------------------- /test/perf/python/zero: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | exit (0) -------------------------------------------------------------------------------- /test/perf/sh/hello: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | echo "Hello!" 3 | -------------------------------------------------------------------------------- /test/perf/sh/nop: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | -------------------------------------------------------------------------------- /test/perf/sh/zero: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | exit 0 3 | -------------------------------------------------------------------------------- /test/perf/topfind/base: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "base" 4 | 5 | open Base 6 | let main () = ignore (Base.Sys.runtime_variant ()) 7 | let () = if !Sys.interactive then () else main () 8 | -------------------------------------------------------------------------------- /test/perf/topfind/bos: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "bos.setup" 4 | 5 | open Bos_setup 6 | 7 | let main () = Logs.app (fun m -> m "Hello bos!") 8 | let () = if !Sys.interactive then () else main () 9 | -------------------------------------------------------------------------------- /test/perf/topfind/containers: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "containers" 4 | 5 | 6 | let main () = CCIO.write_line stdout "Hello containers!" 7 | let () = if !Sys.interactive then () else main () 8 | -------------------------------------------------------------------------------- /test/perf/topfind/grep: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env b0caml 2 | #directory "+re" 3 | #directory "+b0" 4 | 5 | open B0_std (* for the Fmt, Os and Fpath modules *) 6 | 7 | let err fmt = Fmt.pf Fmt.stderr (fmt ^^ "@.") 8 | let err_none e = err "%s" e; None 9 | let log_if_error r = Result.fold ~ok:Option.some ~error:err_none r 10 | 11 | let filepath s = log_if_error (Fpath.of_string s) 12 | let content p = Option.map (fun s -> p, s) (log_if_error (Os.File.read p)) 13 | let match_content re (file, data) = 14 | let matches line = if Re.execp re line then Some (file, line) else None in 15 | List.filter_map matches (String.split_on_char '\n' data) 16 | 17 | let main () = 18 | let pat, files = match List.tl (Array.to_list Sys.argv) with 19 | | pat :: [] -> pat, [Os.File.dash] (* stdin *) 20 | | pat :: files -> pat, List.filter_map filepath files 21 | | [] -> err "usage: PATTERN FILE..."; exit 2 22 | in 23 | let re = match Re.Posix.(compile @@ re pat) with 24 | | exception Re.Posix.Parse_error -> err "%S: parse error" pat; exit 2 25 | | exception Re.Posix.Not_supported -> err "%S: parse error" pat; exit 2 26 | | re -> re 27 | in 28 | let data = List.filter_map content files in 29 | match List.concat_map (match_content re) data with 30 | | [] -> () 31 | | matches -> 32 | let pp_match ppf (p, m) = Fmt.pf ppf "@[%a: %s@]" Fpath.pp_unquoted p m in 33 | Fmt.pf Fmt.stdout "@[%a@]@." (Fmt.list pp_match) matches 34 | 35 | let () = if !Sys.interactive then () else main () 36 | -------------------------------------------------------------------------------- /test/perf/topfind/hello: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | print_endline "Hello!" 3 | -------------------------------------------------------------------------------- /test/perf/topfind/local-time: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "ptime" 4 | #require "ptime.clock.os" 5 | 6 | let to_string () = 7 | let now = Ptime_clock.now () in 8 | let tz_offset_s = Ptime_clock.current_tz_offset_s () in 9 | Format.asprintf "%a" (Ptime.pp_human ?tz_offset_s ()) now 10 | 11 | let main () = print_endline (to_string ()) 12 | let () = if !Sys.interactive then () else main () 13 | -------------------------------------------------------------------------------- /test/perf/topfind/nop: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | -------------------------------------------------------------------------------- /test/perf/topfind/zero: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | exit 0 3 | --------------------------------------------------------------------------------