Stefan pushed to branch master at Stefan / Typer

Commits: 01e6295a by Simon Génier at 2021-09-29T11:09:53-04:00 Remove doc strings from Typer.

Doc strings are a good idea, but the implementation that was in Typer was not. They should not be hardcoded in the syntax of the langague, but rather a good implementation would use the metaprogramming capabilities of Typer to make them part of the standard library.

- - - - - 8cfa2243 by Simon Génier at 2021-09-30T11:39:27-04:00 Locations now track their end points.

- - - - - 8efdff37 by Stefan Monnier at 2021-10-06T10:01:02-04:00 Merge remote-tracking branch 'gitlab/purge-docstr' into trunk

- - - - - 89cc2432 by Stefan Monnier at 2021-10-06T10:01:55-04:00 Merge remote-tracking branch 'gitlab/source-spans-2' into trunk

- - - - -

10 changed files:

- btl/builtins.typer - src/debug.ml - src/elab.ml - src/eval.ml - src/lexer.ml - src/opslexp.ml - src/prelexer.ml - src/sexp.ml - src/source.ml - tests/lexer_test.ml

Changes:

===================================== btl/builtins.typer ===================================== @@ -398,11 +398,6 @@ Elab_nth-arg' = Built-in "Elab.nth-arg" : String -> Int -> Elab_Context -> Strin %% Elab_arg-pos' = Built-in "Elab.arg-pos" : String -> String -> Elab_Context -> Int;

-%% -%% Get the docstring associated with a symbol -%% -Elab_debug-doc = Built-in "Elab.debug-doc" : String -> Elab_Context -> String; - %%%% Unit test helper IO

%%

===================================== src/debug.ml ===================================== @@ -45,20 +45,22 @@ let print_info (message : string) (location : Source.Location.t) : unit =

(* Print aPretokens *) let debug_pretokens_print pretoken = - print_string " "; + print_string " ";

- match pretoken with - | Preblock(loc, pts,_) - -> print_info "Preblock: " loc; - print_string "{"; pretokens_print pts; print_string " }" + match pretoken with + | Preblock (loc, pts) + -> print_info "Preblock: " loc; + print_string "{"; + pretokens_print pts; + print_string " }"

- | Pretoken(loc, str) - -> print_info "Pretoken: " loc; - print_string ("'" ^ str ^ "'"); + | Pretoken (loc, str) + -> print_info "Pretoken: " loc; + print_string ("'" ^ str ^ "'");

- | Prestring(loc, str) - -> print_info "Prestring: " loc; - print_string (""" ^ str ^ """) + | Prestring (loc, str) + -> print_info "Prestring: " loc; + print_string (""" ^ str ^ """)

(* Print a List of Pretokens *) let debug_pretokens_print_all pretokens = @@ -70,7 +72,7 @@ let debug_sexp_print sexp = | Symbol(_, "") -> print_string "Epsilon " (* "ε" *)

- | Block(loc, pts, _) + | Block(loc, pts) -> print_info "Block: " loc; print_string "{"; pretokens_print pts; print_string " }"

===================================== src/elab.ml ===================================== @@ -1292,18 +1292,8 @@ and lexp_decls_1

| [Symbol (l, vname); sexp] -> if SMap.mem vname pending_decls then - let decl_loc = SMap.find vname pending_decls in - let v = - let open Source.Location in - ({file = l.file; - line = l.line; - column = l.column; - docstr = String.concat "\n" [decl_loc.docstr; - l.docstr]}, - vname) - in let pending_decls = SMap.remove vname pending_decls in - let pending_defs = ((v, sexp) :: pending_defs) in + let pending_defs = (((l, vname), sexp) :: pending_defs) in if SMap.is_empty pending_decls then let nctx = ectx_new_scope nctx in let decls, nctx = lexp_check_decls ectx nctx pending_defs in @@ -1526,11 +1516,11 @@ let sform_immediate ctx loc sargs ot = | [(String _) as se] -> mkImm (se), Inferred DB.type_string | [(Integer _) as se] -> mkImm (se), Inferred DB.type_int | [(Float _) as se] -> mkImm (se), Inferred DB.type_float - | [Block (_sl, pts, _el)] + | [Block (_location, pts)] -> let grm = ectx_get_grammar ctx in - let tokens = lex default_stt pts in - let (se, _) = sexp_parse_all grm tokens None in - elaborate ctx se ot + let tokens = lex default_stt pts in + let (se, _) = sexp_parse_all grm tokens None in + elaborate ctx se ot | [_se] -> (sexp_error loc ("Non-immediate passed to ##typer-immediate"); sform_dummy_ret ctx loc)

===================================== src/eval.ml ===================================== @@ -355,13 +355,14 @@ let make_block loc _depth args_val = match args_val with (* From what would we like to make a block? *) | [Vstring str] -> let source = new Source.source_string str in - Vsexp (Block (loc, (Prelexer.prelex source), loc)) + Vsexp (Block (loc, (Prelexer.prelex source))) | _ -> error loc "Sexp.block expects one string as argument"

-let reader_parse loc _depth args_val = match args_val with - | [Velabctx ectx; Vsexp (Block (_,toks,_))] -> - let grm = ectx_get_grammar ectx in - o2v_list (sexp_parse_all_to_list grm (Lexer.lex default_stt toks) (Some ";")) +let reader_parse loc _depth = function + | [Velabctx ectx; Vsexp (Block (_, toks))] + -> let grm = ectx_get_grammar ectx in + let tokens = Lexer.lex default_stt toks in + o2v_list (sexp_parse_all_to_list grm tokens (Some ";")) | [Velabctx _; s] -> (warning loc "Reader.parse do nothing without a Block"; s) | _ -> error loc "Reader.parse expects an ElabContext and a Block as argument"

@@ -627,17 +628,17 @@ and sexp_dispatch loc depth args = | _ -> value_fatal loc sxp "sexp_dispatch expects a Sexp as 1st arg" in

match sxp with - | Node (op, s) -> eval_call nd [Vsexp op; o2v_list s] - | Symbol (_ , s) -> eval_call sym [Vstring s] - | String (_ , s) -> eval_call str [Vstring s] - | Integer (_ , i) -> eval_call it [Vinteger i] - | Float (_ , f) -> eval_call flt [Vfloat f] - | Block (_ , _, _) as b -> - (* I think this code breaks what Blocks are. *) - (* We delay parsing but parse with default_stt and default_grammar... *) - (*let toks = Lexer.lex default_stt s in - let s = sexp_parse_all_to_list default_grammar toks (Some ";") in*) - eval_call blk [Vsexp b] + | Node (op, s) -> eval_call nd [Vsexp op; o2v_list s] + | Symbol (_ , s) -> eval_call sym [Vstring s] + | String (_ , s) -> eval_call str [Vstring s] + | Integer (_ , i) -> eval_call it [Vinteger i] + | Float (_ , f) -> eval_call flt [Vfloat f] + | Block (_ , _) as b -> + (* I think this code breaks what Blocks are. We delay parsing but parse + with default_stt and default_grammar... *) + (* let toks = Lexer.lex default_stt s in + let s = sexp_parse_all_to_list default_grammar toks (Some ";") in*) + eval_call blk [Vsexp b]

(* -------------------------------------------------------------------------- *) and print_eval_result i lxp = @@ -780,16 +781,6 @@ let getenv loc _depth args_val = match args_val with | [_v] -> Vcommand (fun () -> Velabctx !macro_monad_elab_context) | _ -> error loc "getenv takes a single Unit as argument"

-let debug_doc loc _depth args_val = match args_val with - | [Vstring name; Velabctx ectx] - -> (try let idx = senv_lookup name ectx in - let elem = lctx_lookup (ectx_to_lctx ectx) - (((dummy_location, Some name), idx)) in - match elem with - | ((l,_),_,_) -> Vstring (l.docstr) - with _ -> Vstring "element not found") - | _ -> error loc "Elab.debug_doc takes a String and an Elab_Context as arguments" - let is_bound loc _depth args_val = match args_val with | [Vstring name; Velabctx ectx] -> o2v_bool (try (ignore (senv_lookup name ectx); true) @@ -1055,7 +1046,6 @@ let register_builtin_functions () = ("Ref.write" , ref_write, 2); ("gensym" , gensym, 1); ("Elab.getenv" , getenv, 1); - ("Elab.debug-doc", debug_doc, 2); ("Elab.isbound" , is_bound, 2); ("Elab.isconstructor", is_constructor, 2); ("Elab.is-nth-erasable", is_nth_erasable, 3);

===================================== src/lexer.ml ===================================== @@ -38,7 +38,6 @@ let unescape str = let lex_number (source : #Source.t) (start_point : Source.Point.t) - (doc : string) : sexp =

let rec lex_exponent () = @@ -48,7 +47,7 @@ let lex_number lex_exponent ()

| _ - -> let source, location = source#slice start_point doc in + -> let source, location = source#slice start_point in Float (location, float_of_string source) in

@@ -60,7 +59,7 @@ let lex_number

(* TODO: error if there are no signs or digits after the 'e'? *) | _ - -> let source, location = source#slice start_point doc in + -> let source, location = source#slice start_point in Float (location, float_of_string source) in

@@ -75,7 +74,7 @@ let lex_number lex_exponent_sign ()

| _ - -> let source, location = source#slice start_point doc in + -> let source, location = source#slice start_point in Float (location, float_of_string source) in

@@ -94,7 +93,7 @@ let lex_number lex_exponent_sign ()

| _ - -> let source, location = source#slice start_point doc in + -> let source, location = source#slice start_point in Integer (location, Z.of_string source) in

@@ -104,15 +103,14 @@ let lex_number let lex_symbol (token_env : token_env) (source : #Source.t) - (doc : string) (start_point : Source.Point.t) : sexp =

let mksym start_point escaped = if Source.Point.equal start_point source#point - then epsilon (Source.Location.of_point source#file start_point doc) + then epsilon (Source.Location.of_point source#file start_point) else - let raw_name, location = source#slice start_point doc in + let raw_name, location = source#slice start_point in let name = if escaped then unescape raw_name else raw_name in hSymbol (location, name) in @@ -129,7 +127,7 @@ let lex_symbol

| CKinner prec' -> let left = mksym start_point escaped in - let op_location = source#location doc in + let op_point = source#point in

(* To be considered `inner`, an operator char needs to have something on its LHS or its RHS, otherwise, treat it as a @@ -144,7 +142,8 @@ let lex_symbol in if lhs_p || rhs_p || lf dummy_epsilon <> dummy_epsilon then - let op = hSymbol (op_location, Printf.sprintf "__%c__" c) in + let op_text, op_location = source#slice op_point in + let op = hSymbol (op_location, Printf.sprintf "__%s__" op_text) in let lf' = if prec' > prec then fun s -> lf (Node (op, [left; s])) @@ -173,7 +172,6 @@ let lex_symbol let split_presymbol (token_env : token_env) (source : #Source.t) - (doc : string) : sexp list =

let rec loop (acc : sexp list) : sexp list = @@ -188,21 +186,21 @@ let split_presymbol -> (source#advance; match source#peek with | Some ('0' .. '9') - -> lex_number source start_point doc + -> lex_number source start_point | _ - -> lex_symbol token_env source doc start_point) + -> lex_symbol token_env source start_point)

| '0' .. '9' - -> (source#advance; - lex_number source start_point doc) + -> source#advance; + lex_number source start_point

| _ when token_env.(Char.code c) = CKseparate -> source#advance; - let name, location = source#slice start_point doc in + let name, location = source#slice start_point in hSymbol (location, name)

| _ - -> lex_symbol token_env source doc start_point + -> lex_symbol token_env source start_point in loop (token :: acc) in @@ -213,15 +211,15 @@ let lex (token_env : token_env) (pretokens : pretoken list) : sexp list = match pretokens with | [] -> List.rev acc

- | Preblock (start_location, block_pretokens, end_location) :: pretokens' - -> loop pretokens' (Block (start_location, block_pretokens, end_location) :: acc) + | Preblock (location, block_pretokens) :: pretokens' + -> loop pretokens' (Block (location, block_pretokens) :: acc)

| Prestring (location, text) :: pretokens' -> loop pretokens' (String (location, text) :: acc)

- | Pretoken ({file; line; column; docstr}, name) :: pretokens' - -> let source = new Source.source_string ~file ~line ~column name in - let tokens = split_presymbol token_env source docstr in + | Pretoken ({file; start_line = l; start_column = c; _}, name) :: pretokens' + -> let source = new Source.source_string ~file ~line:l ~column:c name in + let tokens = split_presymbol token_env source in loop pretokens' (List.rev_append tokens acc) in loop pretokens []

===================================== src/opslexp.ml ===================================== @@ -601,7 +601,7 @@ and check'' erased ctx e = | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int | Imm (String (_, _)) -> DB.type_string - | Imm (Block (_, _, _) | Symbol _ | Node (_, _)) + | Imm (Block (_, _) | Symbol _ | Node (_, _)) -> (error_tc ~loc:(lexp_location e) "Unsupported immediate value!"; DB.type_int) | SortLevel SLz -> DB.type_level @@ -1005,7 +1005,7 @@ and get_type ctx e = | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int | Imm (String (_, _)) -> DB.type_string - | Imm (Block (_, _, _) | Symbol _ | Node (_, _)) -> DB.type_int + | Imm (Block (_, _) | Symbol _ | Node (_, _)) -> DB.type_int | Builtin (_, t) -> t | SortLevel _ -> DB.type_level | Sort (l, Stype e) -> mkSort (l, Stype (mkSortLevel (mkSLsucc e)))

===================================== src/prelexer.ml ===================================== @@ -27,7 +27,7 @@ let prelexer_error loc = Log.log_error ~section:"PRELEXER" ~loc type pretoken = | Pretoken of location * string | Prestring of location * string - | Preblock of location * pretoken list * location + | Preblock of location * pretoken list

module Pretoken = struct type t = pretoken @@ -39,7 +39,7 @@ module Pretoken = struct -> String.equal l_name r_name | Prestring (_, l_text), Prestring (_, r_text) -> String.equal l_text r_text - | Preblock (_, l_inner, _), Preblock (_, r_inner, _) + | Preblock (_, l_inner), Preblock (_, r_inner) -> Listx.equal equal l_inner r_inner | _ -> false end @@ -69,84 +69,85 @@ let rec consume_until_newline (source : #Source.t) : unit = consumed. *) let prelex (source : #Source.t) : pretoken list = let rec loop - (ctx : (Source.Location.t * pretoken list) list) + (ctx : (Source.Point.t * pretoken list) list) (acc : pretoken list) - (doc : string) : pretoken list =

match source#peek with | None -> (match ctx with | [] -> List.rev acc - | ((location, _) :: _ctx) - -> prelexer_error location "Unmatched opening brace"; + | ((brace_point, _) :: _) + -> let location = source#make_location brace_point in + prelexer_error location "Unmatched opening brace"; List.rev acc)

| Some (c) when c <= ' ' -> source#advance; - loop ctx acc doc + loop ctx acc

(* A comment. *) | Some ('%') -> consume_until_newline source; - loop ctx acc doc - - (* line's bounds seems ok: String.sub line 1 0 == "" *) - | Some ('@') - -> source#advance; - let start_point = source#point in - consume_until_newline source; - let new_doc, _ = source#slice start_point "" in - loop ctx acc (doc ^ "\n" ^ String.trim new_doc) + loop ctx acc

(* A string. *) | Some ('"') - -> source#advance; + -> let quote_point = source#point in + source#advance; let rec prestring chars = - match source#next with + match source#peek with | None | Some ('\n') - -> let location = source#location doc in + -> source#advance; + let location = source#make_location quote_point in prelexer_error location "Unterminated string"; - loop ctx (Prestring (location, "") :: acc) "" + loop ctx (Prestring (location, "") :: acc)

| Some ('"') - -> let location = source#location doc in + -> source#advance; + let location = source#make_location quote_point in let pretoken = Prestring (location, string_implode (List.rev chars)) in - loop ctx (pretoken :: acc) "" + loop ctx (pretoken :: acc)

| Some ('\') - -> (match source#next with + -> let escape_point = source#point in + source#advance; + (match source#next with | None | Some ('\n') - -> let location = source#location doc in + -> let location = source#make_location escape_point in prelexer_error location "Unterminated escape sequence"; - loop ctx (Prestring (location, "") :: acc) "" + loop ctx (Prestring (location, "") :: acc) | Some ('t') -> prestring ('\t' :: chars) | Some ('n') -> prestring ('\n' :: chars) | Some ('r') -> prestring ('\r' :: chars) | Some ('u') - -> let location = source#location doc in + -> let location = source#make_location escape_point in prelexer_error location "Unimplemented unicode escape"; prestring chars | Some (c) -> prestring (c :: chars))

- | Some (char) -> prestring (char :: chars) + | Some (char) + -> source#advance; + prestring (char :: chars) in prestring []

| Some ('{') - -> source#advance; - let ctx' = (source#location doc, acc) :: ctx in - loop ctx' [] doc + -> let point = source#point in + source#advance; + loop ((point, acc) :: ctx) []

| Some ('}') - -> source#advance; - let location = source#location doc in + -> let closing_brace_point = source#point in + source#advance; (match ctx with - | ((slocation, sacc) :: ctx) - -> let preblock = Preblock (slocation, List.rev acc, location) in - loop ctx (preblock :: sacc) "" + | ((opening_brace_point, sacc) :: ctx) + -> let location = source#make_location opening_brace_point in + let preblock = Preblock (location, List.rev acc) in + loop ctx (preblock :: sacc) | _ - -> prelexer_error location "Unmatched closing brace"; - loop ctx acc doc) + -> let location = source#make_location closing_brace_point in + prelexer_error location "Unmatched closing brace"; + loop ctx acc)

(* A pretoken. *) | Some _ @@ -155,60 +156,73 @@ let prelex (source : #Source.t) : pretoken list = let rec pretok () = match source#peek with | None | Some ('%' | '"' | '{' | '}') - -> let text, location = source#slice start_point doc in - loop ctx (Pretoken (location, text) :: acc) "" + -> let text, location = source#slice start_point in + loop ctx (Pretoken (location, text) :: acc)

| Some (c) when c <= ' ' - -> let text, location = source#slice start_point doc in + -> let text, location = source#slice start_point in source#advance; - loop ctx (Pretoken (location, text) :: acc) "" + loop ctx (Pretoken (location, text) :: acc)

| Some ('\') - -> source#advance; + -> let escape_point = source#point in + source#advance; (match source#next with | Some _ -> pretok () | None - -> let error_location = source#location doc in + -> let error_location = source#make_location escape_point in source#advance; - let text, location = source#slice start_point doc in + let text, location = source#slice start_point in prelexer_error error_location ("Unterminated escape sequence in: " ^ text); - loop ctx (Pretoken (location, text) :: acc) "") + loop ctx (Pretoken (location, text) :: acc))

| Some _ -> source#advance; pretok () in pretok () in - loop [] [] "" - -let pretoken_name pretok = - match pretok with - | Pretoken _ -> "Pretoken" - | Prestring _ -> "Prestring" - | Preblock _ -> "Preblock" - -let rec pretoken_string pretok = - match pretok with - | Preblock(_,pts,_) -> "{" ^ ( - List.fold_left (fun str pts -> str ^ " " ^ (pretoken_string pts)) - "" pts) ^ " }" - | Pretoken(_, str) -> str - | Prestring(_, str) -> """ ^ str ^ """ - -let pretokens_string pretokens = - List.fold_left (fun str pt -> str ^ (pretoken_string pt)) "" pretokens - - -let pretokens_print p = print_string (pretokens_string p) - + loop [] [] + +let pretoken_name : pretoken -> string = function + | Pretoken _ -> "Pretoken" + | Prestring _ -> "Prestring" + | Preblock _ -> "Preblock" + +let rec pretoken_string' (output : string -> unit) : pretoken -> unit = function + | Preblock (_, []) -> + output "{}" + | Preblock (_, head :: tail) -> + output "{"; + pretoken_string' output head; + List.iter (fun pt -> output " "; pretoken_string' output pt) tail; + output "}" + | Pretoken (_, text) -> + output text + | Prestring (_, text) -> + output {|"|}; + output text; + output {|"|} + +let pretoken_string (pretoken : pretoken) : string = + let buffer = Buffer.create 32 in + pretoken_string' (Buffer.add_string buffer) pretoken; + Buffer.contents buffer + +let pretokens_string (pretokens : pretoken list) : string = + let buffer = Buffer.create 32 in + List.iter (pretoken_string' (Buffer.add_string buffer)) pretokens; + Buffer.contents buffer + +let pretokens_print : pretoken list -> unit = + List.iter (pretoken_string' print_string)

(* Prelexer comparison, ignoring source-line-number info, used for tests. *) let rec pretokens_equal p1 p2 = match p1, p2 with | Pretoken (_, s1), Pretoken (_, s2) -> s1 = s2 | Prestring (_, s1), Prestring (_, s2) -> s1 = s2 - | Preblock (_, ps1, _), Preblock (_, ps2, _) -> + | Preblock (_, ps1), Preblock (_, ps2) -> pretokens_eq_list ps1 ps2 | _ -> false and pretokens_eq_list ps1 ps2 = match ps1, ps2 with

===================================== src/sexp.ml ===================================== @@ -31,7 +31,7 @@ type integer = Z.t type symbol = location * string

type sexp = (* Syntactic expression, kind of like Lisp. *) - | Block of location * pretoken list * location + | Block of location * pretoken list | Symbol of symbol | String of location * string | Integer of location * integer @@ -69,7 +69,7 @@ let emptyString = hString ""

let rec sexp_location (s : sexp) : location = match s with - | Block (l, _, _) -> l + | Block (l, _) -> l | Symbol (l, _) -> l | String (l, _) -> l | Integer (l, _) -> l @@ -82,11 +82,14 @@ let rec sexp_string ?(print_locations = false) sexp = (if print_locations then let open Source.Location in - let {file; line; column; _} = sexp_location sexp in - Printf.sprintf "#;("%s" %d %d) " file line column + let {file; start_line; start_column; end_line; end_column} = + sexp_location sexp + in + Printf.sprintf + "#;("%s" %d %d %d %d) " file start_line start_column end_line end_column else "") ^ match sexp with - | Block(_,pts,_) -> "{" ^ (pretokens_string pts) ^ " }" + | Block(_, pts) -> "{" ^ (pretokens_string pts) ^ " }" | Symbol(_, "") -> "()" (* Epsilon *) | Symbol(_, name) -> name | String(_, str) -> """ ^ str ^ """ @@ -263,7 +266,7 @@ let sexp_parse_all_to_list grm tokens limit : sexp list =

(* Sexp comparison, ignoring source-line-number info, used for tests. *) let rec sexp_equal s1 s2 = match s1, s2 with - | Block (_, ps1, _), Block (_, ps2, _) -> pretokens_eq_list ps1 ps2 + | Block (_, ps1), Block (_, ps2) -> pretokens_eq_list ps1 ps2 | Symbol (_, s1), Symbol (_, s2) -> s1 = s2 | String (_, s1), String (_, s2) -> s1 = s2 | Integer (_, n1), Integer (_, n2) -> n1 = n2

===================================== src/source.ml ===================================== @@ -29,28 +29,69 @@ module Point = struct end

module Location = struct - type t = {file : string; line : int; column : int; docstr : string} - - let dummy = {file = ""; line = 0; column = 0; docstr = ""} - - let of_point - (file : string) - (_, line, column : Point.t) - (docstr : string) - : t = - - {file; line; column; docstr} - - let to_string ({file; line; column; _} : t) : string = - Printf.sprintf "%s:%d:%d" file line column + type t = + { + file : string; + start_line : int; + start_column : int; + end_line : int; + end_column : int; + } + + let dummy = + { + file = ""; + start_line = 0; + start_column = 0; + end_line = 0; + end_column = 0; + } + + (* Creates a zero-width location around the given point. *) + let of_point (file : string) (_, line, column : Point.t) : t = + { + file; + start_line = line; + start_column = column; + end_line = line; + end_column = column; + } + + let to_string + ({file; start_line; start_column; end_line; end_column} : t) + : string = + + if Int.equal start_line end_line && Int.equal start_column end_column + then Printf.sprintf "%s:%d:%d" file start_line start_column + else + Printf.sprintf + "%s:%d:%d-%d:%d" file start_line start_column end_line end_column

let equal (l : t) (r : t) = - let {file = l_file; line = l_line; column = l_column; docstr = l_doc} = l in - let {file = r_file; line = r_line; column = r_column; docstr = r_doc} = r in + let + { + file = l_file; + start_line = l_start_line; + start_column = l_start_column; + end_line = l_end_line; + end_column = l_end_column; + } = l + in + let + { + file = r_file; + start_line = r_start_line; + start_column = r_start_column; + end_line = r_end_line; + end_column = r_end_column; + } = r + in + String.equal l_file r_file - && Int.equal l_line r_line - && Int.equal l_column r_column - && String.equal l_doc r_doc + && Int.equal l_start_line r_start_line + && Int.equal l_start_column r_start_column + && Int.equal l_end_line r_end_line + && Int.equal l_end_column r_end_column end

(* Traditionally, line numbers start at 1… *) @@ -73,24 +114,26 @@ object (self) the text. *) method virtual peek : char option

- (* The current location of the cursor. *) - method location (docstr : string) : Location.t = - {file; line; column; docstr} - + (* The current point of the cursor. *) method point : Point.t = (self#offset, line, column)

(* The current offset of the cursor in the file, in bytes. *) method virtual private offset : int

+ (* Makes a location starting at the given point and ending at the current + cursor position. *) + method make_location (_, start_line, start_column : Point.t) : Location.t = + {file; start_line; start_column; end_line = line; end_column = column} + (* Slices the text, from (and including) a starting point and to (and excluding) the curent cursor offset.

Note that the source is required only to buffer the last line read and may raise an Invalid_argument if the slice extends before the start of the line. *) - method slice (offset, line, column : Point.t) (docstr : string) : string * Location.t = - (self#slice_impl offset, {file; line; column; docstr}) + method slice (offset, _, _ as point : Point.t) : string * Location.t = + (self#slice_impl offset, self#make_location point)

method virtual private slice_impl : int -> string

===================================== tests/lexer_test.ml ===================================== @@ -30,11 +30,10 @@ let test_lex name pretokens expected = locations. *) let rec sexp_equal actual expected = match actual, expected with - | Sexp.Block (actual_start, actual_pretokens, actual_end), - Sexp.Block (expected_start, expected_pretokens, expected_end) - -> Location.equal actual_start expected_start + | Sexp.Block (actual_location, actual_pretokens), + Sexp.Block (expected_location, expected_pretokens) + -> Location.equal actual_location expected_location && Listx.equal Pretoken.equal actual_pretokens expected_pretokens - && Location.equal actual_end expected_end | Sexp.Symbol (actual_location, actual_name), Sexp.Symbol (expected_location, expected_name) -> Location.equal actual_location expected_location @@ -67,36 +66,42 @@ let test_lex name pretokens expected = add_test "LEXER" name lex

let l : Source.Location.t = - {file = "test.typer"; line = 1; column = 1; docstr = ""} + { + file = "test.typer"; + start_line = 1; + start_column = 1; + end_line = 1; + end_column = 1; + }

let () = test_lex "Inner operator inside a presymbol" [Pretoken (l, "a.b")] - [Node (Symbol ({l with column = 2}, "__.__"), - [Symbol ({l with column = 1}, "a"); - Symbol ({l with column = 3}, "b")])] + [Node (Symbol ({l with start_column = 2; end_column = 3}, "__.__"), + [Symbol ({l with start_column = 1; end_column = 2}, "a"); + Symbol ({l with start_column = 3; end_column = 4}, "b")])]

let () = test_lex "Inner operators at the beginning of a presymbol" [Pretoken (l, ".b")] - [Node (Symbol ({l with column = 1}, "__.__"), - [epsilon {l with column = 1}; - Symbol ({l with column = 2}, "b")])] + [Node (Symbol ({l with start_column = 1; end_column = 2}, "__.__"), + [epsilon {l with start_column = 1; end_column = 1}; + Symbol ({l with start_column = 2; end_column = 3}, "b")])]

let () = test_lex "Inner operators at the end of a presymbol" [Pretoken (l, "a.")] - [Node (Symbol ({l with column = 2}, "__.__"), - [Symbol ({l with column = 1}, "a"); - epsilon {l with column = 3}])] + [Node (Symbol ({l with start_column = 2; end_column = 3}, "__.__"), + [Symbol ({l with start_column = 1; end_column = 2}, "a"); + epsilon {l with start_column = 3; end_column = 3}])]

let () = test_lex "An inner operator by itself is a simple symbol" [Pretoken (l, ".")] - [Symbol ({l with column = 1}, ".")] + [Symbol ({l with start_column = 1; end_column = 2}, ".")]

let () = run_all ()

View it on GitLab: https://gitlab.com/monnier/typer/-/compare/db1cf4dabd05d2edebc2aca524ded1dbc...