simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 11:15:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat(sexp): provide ability to annotate parsed S-exprs with their position

Browse source
This commit is contained in:
Simon Cruanes 2019-11-05 19:36:53 -06:00
parent d6f98032c8
commit 404e35f850
1 changed files with 32 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
src/sexp/CCSexp.ml
View file

@ -176,19 +176,45 @@ module Make(Sexp : SEXP) = struct
let col = start.Lexing.pos_cnum - start.Lexing.pos_bol in let col = start.Lexing.pos_cnum - start.Lexing.pos_bol in
raise (E_error (line,col,msg)) raise (E_error (line,col,msg))
let pair_of_pos_ p =
let open Lexing in
p.pos_lnum, p.pos_cnum - p.pos_bol
let next (t:t) = let next (t:t) =
let open Lexing in
let rec expr () = match cur t with let rec expr () = match cur t with
| L.EOI -> raise E_end | L.EOI -> raise E_end
| L.SEXP_COMMENT -> | L.SEXP_COMMENT ->
junk t; junk t;
let _u = expr() in (* discard next sexp *) let _u = expr() in (* discard next sexp *)
expr() expr()
| L.ATOM s -> junk t; Sexp.atom s | L.ATOM s ->
junk t;
begin match Sexp.make_loc with
| None -> Sexp.atom s
| Some f ->
(* build a position for this token *)
let loc =
f (pair_of_pos_ t.buf.lex_start_p) (pair_of_pos_ t.buf.lex_curr_p)
t.buf.lex_curr_p.pos_fname in
Sexp.atom_with_loc ~loc s
end
| L.LIST_OPEN -> | L.LIST_OPEN ->
let pos_start = t.buf.lex_curr_p in
junk t; junk t;
let l = lst [] in let l = lst [] in
begin match cur t with begin match cur t with
| L.LIST_CLOSE -> junk t; Sexp.list l | L.LIST_CLOSE ->
junk t;
begin match Sexp.make_loc with
| None -> Sexp.list l
| Some f ->
let loc =
f (pair_of_pos_ pos_start)
(pair_of_pos_ t.buf.lex_curr_p)
t.buf.lex_curr_p.pos_fname in
Sexp.list_with_loc ~loc l
end
| _ -> error_ t.buf "expected ')'" | _ -> error_ t.buf "expected ')'"
end end
| L.LIST_CLOSE -> error_ t.buf "expected expression" | L.LIST_CLOSE -> error_ t.buf "expected expression"
@ -277,8 +303,12 @@ and compare a b = match a, b with
include (Make(struct include (Make(struct
type t_ = t type t_ = t
type t = t_ type t = t_
type loc = unit
let make_loc = None
let atom x = `Atom x let atom x = `Atom x
let list x = `List x let list x = `List x
let atom_with_loc ~loc:_ s = atom s
let list_with_loc ~loc:_ l = list l
let match_ x ~atom ~list = match x with let match_ x ~atom ~list = match x with
| `Atom x -> atom x | `Atom x -> atom x