197 lines
4.1 KiB
Plaintext
197 lines
4.1 KiB
Plaintext
(* -*- tuareg -*- *)
|
|
open Stdune;;
|
|
open Sexp.Of_sexp;;
|
|
|
|
let pp_sexp_ast =
|
|
let rec subst_atoms ~f (s : Sexp.t) =
|
|
match s with
|
|
| Atom a -> f a
|
|
| Quoted_string _ -> s
|
|
| List xs -> List (List.map ~f:(subst_atoms ~f) xs)
|
|
in
|
|
fun ppf sexp ->
|
|
sexp
|
|
|> Sexp.Ast.remove_locs
|
|
|> subst_atoms ~f:(fun (A s) ->
|
|
List [(Sexp.atom "atom"); Sexp.atom_or_quoted_string s])
|
|
|> Sexp.pp ppf
|
|
;;
|
|
|
|
#install_printer pp_sexp_ast;;
|
|
[%%expect{|
|
|
val pp_sexp_ast : Format.formatter -> Stdune.Sexp.Ast.t -> unit = <fun>
|
|
|}]
|
|
|
|
Printexc.record_backtrace false;;
|
|
[%%expect{|
|
|
- : unit = ()
|
|
|}]
|
|
|
|
let sexp = Sexp.parse_string ~fname:"" ~mode:Single {|
|
|
((foo 1)
|
|
(foo 2))
|
|
|}
|
|
[%%expect{|
|
|
val sexp : Usexp.Ast.t = (((atom foo) (atom 1)) ((atom foo) (atom 2)))
|
|
|}]
|
|
|
|
let of_sexp = record (field "foo" int)
|
|
let x = parse of_sexp Univ_map.empty sexp
|
|
[%%expect{|
|
|
val of_sexp : int Stdune.Sexp.Of_sexp.t = <abstr>
|
|
Exception:
|
|
Stdune__Sexp.Of_sexp.Of_sexp (<abstr>,
|
|
"Field \"foo\" is present too many times", None).
|
|
|}]
|
|
|
|
let of_sexp = record (multi_field "foo" int)
|
|
let x = parse of_sexp Univ_map.empty sexp
|
|
[%%expect{|
|
|
val of_sexp : int list Stdune.Sexp.Of_sexp.t = <abstr>
|
|
val x : int list = [1; 2]
|
|
|}]
|
|
|
|
type parse_result_diff =
|
|
{ jbuild : (Sexp.Ast.t list, string) result
|
|
; dune : (Sexp.Ast.t list, string) result
|
|
}
|
|
|
|
type parse_result =
|
|
| Same of (Sexp.Ast.t list, string) result
|
|
| Different of parse_result_diff
|
|
|
|
let parse s =
|
|
let f ~lexer =
|
|
try
|
|
Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
|
|
with
|
|
| Sexp.Parse_error e -> Error (Sexp.Parse_error.message e)
|
|
| Invalid_argument e -> Error e
|
|
in
|
|
let jbuild = f ~lexer:Sexp.Lexer.jbuild_token in
|
|
let dune = f ~lexer:Sexp.Lexer.token in
|
|
if jbuild <> dune then
|
|
Different { jbuild; dune }
|
|
else
|
|
Same jbuild
|
|
[%%expect{|
|
|
type parse_result_diff = {
|
|
jbuild : (Stdune.Sexp.Ast.t list, string) Stdune.result;
|
|
dune : (Stdune.Sexp.Ast.t list, string) Stdune.result;
|
|
}
|
|
type parse_result =
|
|
Same of (Stdune.Sexp.Ast.t list, string) Stdune.result
|
|
| Different of parse_result_diff
|
|
val parse : string -> parse_result = <fun>
|
|
|}]
|
|
|
|
parse {| # ## x##y x||y a#b|c#d copy# |}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Same
|
|
(Ok
|
|
[(atom #); (atom ##); (atom x##y); (atom x||y); (atom a#b|c#d);
|
|
(atom copy#)])
|
|
|}]
|
|
|
|
|
|
parse {|x #| comment |# y|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Ok [(atom x); (atom y)];
|
|
dune = Ok [(atom x); (atom #|); (atom comment); (atom |#); (atom y)]}
|
|
|}]
|
|
|
|
parse {|x#|y|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Error "jbuild atoms cannot contain #|"; dune = Ok [(atom x#|y)]}
|
|
|}]
|
|
|
|
parse {|x|#y|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Error "jbuild atoms cannot contain |#"; dune = Ok [(atom x|#y)]}
|
|
|}]
|
|
|
|
parse {|"\a"|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different {jbuild = Ok ["\\a"]; dune = Error "unknown escape sequence"}
|
|
|}]
|
|
|
|
parse {|"\%{x}"|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different {jbuild = Ok ["\\%{x}"]; dune = Error "unknown escape sequence"}
|
|
|}]
|
|
|
|
parse {|"$foo"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["$foo"])
|
|
|}]
|
|
|
|
parse {|"%foo"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["%foo"])
|
|
|}]
|
|
|
|
parse {|"bar%foo"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["bar%foo"])
|
|
|}]
|
|
|
|
parse {|"bar$foo"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["bar$foo"])
|
|
|}]
|
|
|
|
parse {|"%bar$foo%"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["%bar$foo%"])
|
|
|}]
|
|
|
|
parse {|"$bar%foo%"|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok ["$bar%foo%"])
|
|
|}]
|
|
|
|
parse {|\${foo}|}
|
|
[%%expect{|
|
|
- : parse_result = Same (Ok [(atom \${foo})])
|
|
|}]
|
|
|
|
parse {|\%{foo}|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Ok [(atom "\\%{foo}")]; dune = Error "Invalid atom character '%'"}
|
|
|}]
|
|
|
|
parse {|\$bar%foo%|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Ok [(atom "\\$bar%foo%")];
|
|
dune = Error "Invalid atom character '%'"}
|
|
|}]
|
|
|
|
parse {|\$bar\%foo%|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Ok [(atom "\\$bar\\%foo%")];
|
|
dune = Error "Invalid atom character '%'"}
|
|
|}]
|
|
|
|
parse {|\$bar\%foo%{bar}|}
|
|
[%%expect{|
|
|
- : parse_result =
|
|
Different
|
|
{jbuild = Ok [(atom "\\$bar\\%foo%{bar}")];
|
|
dune = Error "Invalid atom character '%'"}
|
|
|}]
|