Add support for a meta language in jbuild files
This commit is contained in:
parent
4227e756bd
commit
8d52cba130
5
Makefile
5
Makefile
|
@ -17,7 +17,4 @@ reinstall: uninstall reinstall
|
|||
clean:
|
||||
rm -rf _build
|
||||
|
||||
cinaps:
|
||||
cinaps -i doc/jbuild
|
||||
|
||||
.PHONY: default install uninstall reinstall clean cinaps
|
||||
.PHONY: default install uninstall reinstall clean
|
||||
|
|
92
doc/jbuild
92
doc/jbuild
|
@ -1,93 +1,37 @@
|
|||
;; When adding a command to jbuilder, add it to the [cmds] variable in
|
||||
;; this file and run "make cinaps"
|
||||
(use_meta_lang)
|
||||
|
||||
(install
|
||||
((section doc)
|
||||
(files (manual.org))))
|
||||
|
||||
#|(*$
|
||||
open StdLabels
|
||||
open Printf
|
||||
(:let :commands
|
||||
(build
|
||||
build-package
|
||||
external-lib-deps
|
||||
install
|
||||
installed-libraries
|
||||
runtest
|
||||
uninstall))
|
||||
|
||||
let cmds =
|
||||
[ "build"
|
||||
; "build-package"
|
||||
; "external-lib-deps"
|
||||
; "install"
|
||||
; "installed-libraries"
|
||||
; "runtest"
|
||||
; "uninstall"
|
||||
]
|
||||
|
||||
let cmds = ("", "") :: List.map cmds ~f:(fun x -> ("-" ^ x, x))
|
||||
|
||||
let () =
|
||||
print_endline ("|"^"#");
|
||||
List.iter cmds ~f:(fun (suffix, cmd) ->
|
||||
printf {|
|
||||
(rule
|
||||
((targets (jbuilder%s.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} %s --help=groff)))))
|
||||
|}
|
||||
suffix cmd);
|
||||
print_string ";; "
|
||||
*)|#
|
||||
(:let-macro (:man-file :cmd)
|
||||
(:concat "" (jbuilder- (:cmd) .1)))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} --help=groff)))))
|
||||
(run ${bin:jbuilder} --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-build.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} build --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-build-package.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} build-package --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-external-lib-deps.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} external-lib-deps --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-install.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} install --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-installed-libraries.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} installed-libraries --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-runtest.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} runtest --help=groff)))))
|
||||
|
||||
(rule
|
||||
((targets (jbuilder-uninstall.1))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} uninstall --help=groff)))))
|
||||
;; (*$*)
|
||||
(:foreach :cmd (:commands)
|
||||
(rule
|
||||
((targets ((:man-file (:cmd))))
|
||||
(action (with-stdout-to ${@}
|
||||
(run ${bin:jbuilder} (:cmd) --help=groff))))))
|
||||
|
||||
(install
|
||||
((section man)
|
||||
(files (
|
||||
;; (*$List.iter cmds ~f:(fun (suf, _) -> printf "\n jbuilder%s.1" suf); printf "\n;; "*)
|
||||
jbuilder.1
|
||||
jbuilder-build.1
|
||||
jbuilder-build-package.1
|
||||
jbuilder-external-lib-deps.1
|
||||
jbuilder-install.1
|
||||
jbuilder-installed-libraries.1
|
||||
jbuilder-runtest.1
|
||||
jbuilder-uninstall.1
|
||||
;; (*$*)
|
||||
(:foreach :cmd (:commands) (:man-file (:cmd)))
|
||||
))))
|
||||
|
||||
(alias
|
||||
|
|
|
@ -1783,16 +1783,7 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf =
|
|||
let alias_store = Alias.Store.create () in
|
||||
let rules =
|
||||
List.concat_map contexts ~f:(fun context ->
|
||||
let stanzas =
|
||||
List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
} ->
|
||||
(path,
|
||||
List.filter_map sexps ~f:(Stanza.select version)
|
||||
|> Stanza.resolve_packages ~dir:path ~visible_packages))
|
||||
in
|
||||
let stanzas = List.map jbuilds ~f:(Jbuild_load.Jbuild.eval ~context) in
|
||||
let module M =
|
||||
Gen(struct
|
||||
let context = context
|
||||
|
|
|
@ -3,11 +3,24 @@ open Jbuild_types
|
|||
|
||||
module Jbuild = struct
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; version : Jbuild_types.Jbuilder_version.t
|
||||
; sexps : Sexp.Ast.t list
|
||||
; visible_packages : Package.t String_map.t
|
||||
}
|
||||
| Constant of Path.t * Stanza.t list
|
||||
| With_macros of
|
||||
{ path : Path.t
|
||||
; version : Jbuilder_version.t
|
||||
; sexps : Sexp.Ast.t list
|
||||
; visible_packages : Package.t String_map.t
|
||||
}
|
||||
|
||||
let eval jbuild ~context =
|
||||
match jbuild with
|
||||
| Constant (path, stanzas) -> (path, stanzas)
|
||||
| With_macros { path
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
} ->
|
||||
let sexps = Jbuild_meta_lang.expand ~context sexps in
|
||||
(path, Stanzas.parse sexps ~dir:path ~visible_packages ~version)
|
||||
end
|
||||
|
||||
type conf =
|
||||
|
@ -21,7 +34,7 @@ let load ~dir ~visible_packages ~version =
|
|||
let sexps = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) in
|
||||
let versions, sexps =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List (loc, [Atom (_, ("jbuilder_version" | "Jbuilder_version")); ver]) ->
|
||||
| List (loc, [Atom (_, "jbuilder_version"); ver]) ->
|
||||
Inl (Jbuilder_version.t ver, loc)
|
||||
| sexp -> Inr sexp)
|
||||
in
|
||||
|
@ -32,12 +45,24 @@ let load ~dir ~visible_packages ~version =
|
|||
| _ :: (_, loc) :: _ ->
|
||||
Loc.fail loc "jbuilder_version specified too many times"
|
||||
in
|
||||
{ Jbuild.
|
||||
path = dir
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
}
|
||||
let use_meta_lang, sexps =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List (_, [Atom (_, "use_meta_lang")]) -> Inl ()
|
||||
| sexp -> Inr sexp)
|
||||
in
|
||||
let jbuild =
|
||||
match use_meta_lang with
|
||||
| [] ->
|
||||
Jbuild.Constant (dir, Stanzas.parse sexps ~dir ~visible_packages ~version)
|
||||
| _ ->
|
||||
With_macros
|
||||
{ path = dir
|
||||
; version
|
||||
; sexps
|
||||
; visible_packages
|
||||
}
|
||||
in
|
||||
(version, jbuild)
|
||||
|
||||
let load () =
|
||||
let ftree = File_tree.load Path.root in
|
||||
|
@ -90,8 +115,8 @@ let load () =
|
|||
in
|
||||
let version, jbuilds =
|
||||
if String_set.mem "jbuild" files then
|
||||
let jbuild = load ~dir:path ~visible_packages ~version in
|
||||
(jbuild.version, jbuild :: jbuilds)
|
||||
let version, jbuild = load ~dir:path ~visible_packages ~version in
|
||||
(version, jbuild :: jbuilds)
|
||||
else
|
||||
(version, jbuilds)
|
||||
in
|
||||
|
|
|
@ -1,12 +1,9 @@
|
|||
open Import
|
||||
|
||||
module Jbuild : sig
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; version : Jbuild_types.Jbuilder_version.t
|
||||
; sexps : Sexp.Ast.t list
|
||||
; visible_packages : Package.t String_map.t
|
||||
}
|
||||
type t
|
||||
|
||||
val eval : t -> context:Context.t -> Path.t * Jbuild_types.Stanzas.t
|
||||
end
|
||||
|
||||
type conf =
|
||||
|
|
|
@ -0,0 +1,191 @@
|
|||
open Import
|
||||
open Sexp.Of_sexp
|
||||
|
||||
module To = Sexp.To_sexp
|
||||
|
||||
module Prim = struct
|
||||
module Spec = struct
|
||||
[@@@warning "-37"]
|
||||
|
||||
type ('a, 'b) t =
|
||||
| Ret : ('b -> Sexp.t) -> ('b, 'b) t
|
||||
| Rest : (Sexp.Ast.t -> 'a) * ('b -> Sexp.t) -> ('a list -> 'b, 'b) t
|
||||
| Abs : (Sexp.Ast.t -> 'a) * ('b, 'c) t -> ('a -> 'b, 'c) t
|
||||
|
||||
let ( @> ) a b = Abs (a, b)
|
||||
|
||||
let rec apply
|
||||
: type a b. (a, b) t -> loc:Loc.t -> Sexp.Ast.t list -> a -> Sexp.Ast.t
|
||||
= fun t ~loc l f ->
|
||||
match t, l with
|
||||
| Ret conv, [] -> Sexp.add_loc (conv f) ~loc
|
||||
| Ret _, _ :: _ -> Loc.fail loc "too many arguments"
|
||||
| Rest (conv, ret_conv), l ->
|
||||
Sexp.add_loc (ret_conv (f (List.map l ~f:conv))) ~loc
|
||||
| Abs _, [] -> Loc.fail loc "not enough arguments"
|
||||
| Abs (conv, t), x :: l ->
|
||||
apply t ~loc l (f (conv x))
|
||||
end
|
||||
|
||||
type ('a, 'b) unpacked =
|
||||
{ spec : ('a, 'b) Spec.t
|
||||
; exec : 'a
|
||||
}
|
||||
|
||||
type t = T : (_, _) unpacked -> t
|
||||
|
||||
let make spec exec = T { spec; exec }
|
||||
|
||||
let exec (T { spec; exec }) ~loc args =
|
||||
Spec.apply spec ~loc args exec
|
||||
end
|
||||
|
||||
type env =
|
||||
{ context : Context.t
|
||||
; macros : macro String_map.t
|
||||
}
|
||||
|
||||
and macro =
|
||||
| Value of Sexp.Ast.t list
|
||||
| Closure of
|
||||
{ env : env
|
||||
; pattern : Sexp.Ast.t
|
||||
; form : Sexp.Ast.t list
|
||||
}
|
||||
| Prim of Prim.t
|
||||
|
||||
let prims =
|
||||
let open Prim.Spec in
|
||||
let mk name spec exec = (name, Prim (Prim.make spec exec)) in
|
||||
let cmp name f = mk name (string @> string @> Ret To.bool) f in
|
||||
(* CR-someday jdimino: implement proper version comparison *)
|
||||
[ cmp ":ver<" (<)
|
||||
; cmp ":ver<=" (<=)
|
||||
; cmp ":ver=" (=)
|
||||
; cmp ":ver>=" (>=)
|
||||
; cmp ":ver>" (>)
|
||||
; mk ":concat" (string @> list string @> Ret To.string)
|
||||
(fun sep l -> String.concat ~sep l)
|
||||
] |> String_map.of_alist_exn
|
||||
|
||||
let make_env context =
|
||||
{ context; macros = prims }
|
||||
|
||||
let bind env var macro =
|
||||
{ env with macros = String_map.add env.macros ~key:var ~data:macro }
|
||||
|
||||
let rec match_pattern env ~pattern ~value =
|
||||
match pattern, value with
|
||||
| Atom (_, var), _ when String.is_prefix var ~prefix:":" ->
|
||||
bind env var (Value [value])
|
||||
| Atom (_, a), Atom (_, b) when a = b -> env
|
||||
| List (_, a), List (_, b) when List.length a = List.length b ->
|
||||
List.fold_left2 a b ~init:env ~f:(fun env pattern value ->
|
||||
match_pattern env ~pattern ~value)
|
||||
| _ ->
|
||||
Loc.fail (Sexp.Ast.loc pattern)
|
||||
"Failed to match value against pattern:\n\
|
||||
- pattern: %s\n\
|
||||
- value: %s"
|
||||
(Sexp.Ast.to_string pattern)
|
||||
(Sexp.Ast.to_string value)
|
||||
|
||||
let unexpected sexp values ~expected =
|
||||
Loc.fail (Sexp.Ast.loc sexp)
|
||||
"%s expected here, got:\n\
|
||||
\ %s"
|
||||
expected
|
||||
(String.concat ~sep:", "
|
||||
(List.map values ~f:Sexp.Ast.to_string))
|
||||
|
||||
let rec eval env t =
|
||||
match t with
|
||||
| Atom _ -> (env, [t])
|
||||
| List (_, Atom (_, ":quote") :: args) -> (env, args)
|
||||
| List (loc, Atom (_, ":if") :: args) -> begin
|
||||
let cond, then_, else_ =
|
||||
match args with
|
||||
| [cond; then_] ->
|
||||
let loc = Sexp.Ast.loc then_ in
|
||||
(cond, then_, List ({ loc with start = loc.stop }, []))
|
||||
| [cond; then_; else_] ->
|
||||
(cond, then_, else_)
|
||||
| _ ->
|
||||
Loc.fail loc "invalid (:if ...) form"
|
||||
in
|
||||
match eval_bool env cond with
|
||||
| true -> eval env else_
|
||||
| false -> eval env then_
|
||||
end
|
||||
| List (loc, Atom (_, ":foreach") :: args) -> begin
|
||||
match args with
|
||||
| pattern :: vals :: form -> begin
|
||||
let vals = eval_list env vals in
|
||||
(env,
|
||||
List.concat_map vals ~f:(fun value ->
|
||||
let env = match_pattern env ~pattern ~value in
|
||||
eval_seq env form))
|
||||
end
|
||||
| _ ->
|
||||
Loc.fail loc "invalid (:foreach ...) form"
|
||||
end
|
||||
| List (loc, Atom (_, ":let") :: args) -> begin
|
||||
match args with
|
||||
| [pattern; value] ->
|
||||
let value = eval_one env value in
|
||||
(match_pattern env ~pattern ~value, [])
|
||||
| _ ->
|
||||
Loc.fail loc "invalid (:let ...) form"
|
||||
end
|
||||
| List (loc, Atom (_, ":let-macro") :: args) -> begin
|
||||
match args with
|
||||
| List (_, Atom (_, s) :: _) as pattern :: form when s <> "" && s.[0] = ':' ->
|
||||
(bind env s (Closure { env; pattern; form }),
|
||||
[])
|
||||
| _ ->
|
||||
Loc.fail loc "invalid (:let-macro ...) form"
|
||||
end
|
||||
| List (loc, (Atom (loc_s, s) :: args)) when s <> "" && s.[0] = ':' -> begin
|
||||
match String_map.find s env.macros with
|
||||
| None -> Loc.fail loc_s "Unknown macro %S" s
|
||||
| Some (Value x) -> (env, x)
|
||||
| Some (Closure { env = closure_env; pattern; form }) ->
|
||||
let args = eval_seq env args in
|
||||
let t = List (loc, Atom (loc_s, s) :: args) in
|
||||
(env,
|
||||
let env = match_pattern closure_env ~pattern ~value:t in
|
||||
eval_seq env form)
|
||||
| Some (Prim prim) ->
|
||||
let args = eval_seq env args in
|
||||
(env,
|
||||
[Prim.exec prim args ~loc])
|
||||
end
|
||||
| List (loc, l) ->
|
||||
(env, [List (loc, eval_seq env l)])
|
||||
|
||||
and eval_seq env l =
|
||||
match l with
|
||||
| [] -> []
|
||||
| sexp :: rest ->
|
||||
let env, res = eval env sexp in
|
||||
res @ eval_seq env rest
|
||||
|
||||
and eval_one env sexp =
|
||||
match snd (eval env sexp) with
|
||||
| [sexp] -> sexp
|
||||
| l -> unexpected sexp l ~expected:"single value"
|
||||
|
||||
and eval_list env sexp =
|
||||
match eval_one env sexp with
|
||||
| List (_, l) -> l
|
||||
| l -> unexpected sexp [l] ~expected:"list"
|
||||
|
||||
and eval_bool env sexp : bool =
|
||||
match eval_one env sexp with
|
||||
| Atom (_, "true" ) -> true
|
||||
| Atom (_, "false") -> false
|
||||
| l -> unexpected sexp [l] ~expected:"true or false"
|
||||
|
||||
let expand sexps ~context =
|
||||
let env = make_env context in
|
||||
eval_seq env sexps
|
|
@ -0,0 +1,5 @@
|
|||
(** Meta Jbuild language *)
|
||||
|
||||
open! Import
|
||||
|
||||
val expand : Sexp.Ast.t list -> context:Context.t -> Sexp.Ast.t list
|
|
@ -789,6 +789,7 @@ module Stanza = struct
|
|||
; cstr' "alias" [Alias_conf.v1] (fun x -> Alias x)
|
||||
(* Just for validation and error messages *)
|
||||
; cstr "jbuilder_version" [Jbuilder_version.t] (fun _ -> None)
|
||||
; cstr "use_meta_lang" [] None
|
||||
]
|
||||
|
||||
let vjs =
|
||||
|
@ -823,6 +824,10 @@ module Stanza = struct
|
|||
| None -> acc
|
||||
| Some n -> String_set.add n acc)
|
||||
| _ -> acc))
|
||||
end
|
||||
|
||||
module Stanzas = struct
|
||||
type t = Stanza.t list
|
||||
|
||||
let resolve_packages ts ~dir ~(visible_packages : Package.t String_map.t) =
|
||||
let error fmt =
|
||||
|
@ -856,7 +861,7 @@ module Stanza = struct
|
|||
You need to add a (package ...) field in your (install ...) stanzas"
|
||||
(known_packages ())
|
||||
in
|
||||
List.map ts ~f:(fun stanza ->
|
||||
List.map ts ~f:(fun (stanza : Stanza.t) ->
|
||||
match stanza with
|
||||
| Library { public_name = Some name; _ }
|
||||
| Executables { object_public_name = Some name; _ } ->
|
||||
|
@ -868,4 +873,8 @@ module Stanza = struct
|
|||
| Install ({ package = None; _ } as install) ->
|
||||
Install { install with package = Some (default ()) }
|
||||
| _ -> stanza)
|
||||
|
||||
let parse sexps ~dir ~visible_packages ~version =
|
||||
List.filter_map sexps ~f:(Stanza.select version)
|
||||
|> resolve_packages ~dir ~visible_packages
|
||||
end
|
||||
|
|
22
src/main.ml
22
src/main.ml
|
@ -44,7 +44,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () =
|
|||
let external_lib_deps ?log ~packages () =
|
||||
Future.Scheduler.go ?log
|
||||
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
||||
>>| fun ({ build_system = bs; jbuilds; _ } as setup) ->
|
||||
>>| fun ({ build_system = bs; jbuilds; contexts; _ } as setup) ->
|
||||
let install_files =
|
||||
List.map packages ~f:(fun pkg ->
|
||||
match package_install_file setup pkg with
|
||||
|
@ -54,17 +54,15 @@ let external_lib_deps ?log ~packages () =
|
|||
Path.Map.map
|
||||
(Build_system.all_lib_deps bs install_files)
|
||||
~f:(fun deps ->
|
||||
let stanzas =
|
||||
List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path
|
||||
; version
|
||||
; sexps
|
||||
; _
|
||||
} ->
|
||||
(path,
|
||||
List.filter_map sexps ~f:(Jbuild_types.Stanza.select version)))
|
||||
in
|
||||
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
||||
String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
|
||||
let context =
|
||||
match List.find contexts ~f:(fun c -> c.name = "default") with
|
||||
| None -> die "You need to set a default context to use external-lib-deps"
|
||||
| Some context -> context
|
||||
in
|
||||
let stanzas = List.map jbuilds ~f:(Jbuild_load.Jbuild.eval ~context) in
|
||||
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
||||
String_map.filter deps ~f:(fun name _ ->
|
||||
not (String_set.mem name internals))))
|
||||
|
||||
let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
||||
match exn with
|
||||
|
|
76
src/sexp.ml
76
src/sexp.ml
|
@ -4,15 +4,7 @@ type t =
|
|||
| Atom of string
|
||||
| List of t list
|
||||
|
||||
module Ast = struct
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
let loc = function
|
||||
| Atom (loc, _) -> loc
|
||||
| List (loc, _) -> loc
|
||||
end
|
||||
type sexp = t
|
||||
|
||||
let must_escape str =
|
||||
let len = String.length str in
|
||||
|
@ -38,6 +30,28 @@ let code_error message vars =
|
|||
:: List.map vars ~f:(fun (name, value) ->
|
||||
List [Atom name; value]))))
|
||||
|
||||
|
||||
module Ast = struct
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
let loc = function
|
||||
| Atom (loc, _) -> loc
|
||||
| List (loc, _) -> loc
|
||||
|
||||
let rec remove_locs : t -> sexp = function
|
||||
| Atom (_, s) -> Atom s
|
||||
| List (_, l) -> List (List.map l ~f:remove_locs)
|
||||
|
||||
let to_string t = to_string (remove_locs t)
|
||||
end
|
||||
|
||||
let rec add_loc t ~loc : Ast.t =
|
||||
match t with
|
||||
| Atom s -> Atom (loc, s)
|
||||
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
|
||||
|
||||
module type Combinators = sig
|
||||
type 'a t
|
||||
val unit : unit t
|
||||
|
@ -122,17 +136,19 @@ module Of_sexp = struct
|
|||
; entry : Ast.t
|
||||
}
|
||||
|
||||
module Name_map = Map.Make(struct
|
||||
type t = string
|
||||
let compare a b =
|
||||
let alen = String.length a and blen = String.length b in
|
||||
if alen < blen then
|
||||
-1
|
||||
else if alen > blen then
|
||||
1
|
||||
else
|
||||
String.compare a b
|
||||
end)
|
||||
module Name = struct
|
||||
type t = string
|
||||
let compare a b =
|
||||
let alen = String.length a and blen = String.length b in
|
||||
if alen < blen then
|
||||
-1
|
||||
else if alen > blen then
|
||||
1
|
||||
else
|
||||
String.compare a b
|
||||
end
|
||||
|
||||
module Name_map = Map.Make(Name)
|
||||
|
||||
type record_parser_state =
|
||||
{ loc : Loc.t
|
||||
|
@ -272,25 +288,7 @@ module Of_sexp = struct
|
|||
let cstr name args make =
|
||||
Constructor_spec.T { name; args; make; rest = No_rest }
|
||||
|
||||
let equal_cstr_name a b =
|
||||
let alen = String.length a and blen = String.length b in
|
||||
if alen <> blen then
|
||||
false
|
||||
else if alen = 0 then
|
||||
true
|
||||
else
|
||||
let is_cap s =
|
||||
match s.[0] with
|
||||
| 'A'..'Z' -> true
|
||||
| _ -> false
|
||||
in
|
||||
match is_cap a, is_cap b with
|
||||
| true, true | false, false ->
|
||||
a = b
|
||||
| true, false ->
|
||||
a = String.capitalize_ascii b
|
||||
| false, true ->
|
||||
String.capitalize_ascii a = b
|
||||
let equal_cstr_name a b = Name.compare a b = 0
|
||||
|
||||
let find_cstr cstrs sexp name =
|
||||
match
|
||||
|
|
|
@ -5,12 +5,18 @@ type t =
|
|||
| List of t list
|
||||
|
||||
module Ast : sig
|
||||
type sexp = t
|
||||
type t =
|
||||
| Atom of Loc.t * string
|
||||
| List of Loc.t * t list
|
||||
|
||||
val loc : t -> Loc.t
|
||||
end
|
||||
|
||||
val remove_locs : t -> sexp
|
||||
val to_string : t -> string
|
||||
end with type sexp := t
|
||||
|
||||
val add_loc : t -> loc:Loc.t -> Ast.t
|
||||
|
||||
val code_error : string -> (string * t) list -> _
|
||||
|
||||
|
|
Loading…
Reference in New Issue