Simon Génier pushed to branch master at Stefan / Typer

Commits: b8959e2f by Simon Génier at 2021-05-12T21:36:47-04:00 Have the source tell its own location.

Move the code that keeps track of the current line and column inside of the source object. Not only does this make sense conceptually since the source is a kind of cursor, but it will allow us to simplify the lexer code.

- - - - - e7d3ed86 by Simon Génier at 2021-05-28T19:51:54-04:00 Merge branch 'source-tells-its-own-location'

- - - - - c5ef2f59 by Simon Génier at 2021-05-28T20:30:37-04:00 Oops, fix tests on Windows.

The prelexer considered \r to be part of presymbols with catastrophic results.

- - - - -

3 changed files:

- src/lexer.ml - src/prelexer.ml - src/source.ml

Changes:

===================================== src/lexer.ml ===================================== @@ -27,6 +27,10 @@ open Grammar

(*************** The Lexer phase *********************)

+let inc_cp (cp : charpos) (c : char) = + (* Count char positions in utf-8: don't count the non-leading bytes. *) + if utf8_head_p c then cp+1 else cp + let digit_p char = let code = Char.code char in Char.code '0' <= code && code <= Char.code '9'

===================================== src/prelexer.ml ===================================== @@ -60,41 +60,36 @@ end (* FIXME: Add syntax for char constants (maybe 'c'). *) (* FIXME: Handle multiline strings. *)

-let inc_cp (cp:charpos) (c:char) = - (* Count char positions in utf-8: don't count the non-leading bytes. *) - if utf8_head_p c then cp+1 else cp - let rec consume_until_newline (source : #Source.t) : unit = match source#next_char with | None | Some ('\n') -> () | Some _ -> consume_until_newline source

-let rec prelex (source : #Source.t) ln ctx acc (doc : string) - : pretoken list = +(* Splits a Typer source into pretokens, stopping when it is completely + consumed. *) +let prelex (source : #Source.t) : pretoken list = + let rec loop + (ctx : (Source.Location.t * pretoken list) list) + (acc : pretoken list) + (doc : string) + : pretoken list =

- let nextline = prelex source (ln + 1) in - let rec prelex' ctx (cpos:charpos) acc doc = - let nexttok = prelex' ctx in match source#peek_char with | None -> (match ctx with | [] -> List.rev acc - | ((ln, cpos, _) :: _ctx) -> - (prelexer_error {file=source#file_name; line=ln; column=cpos; docstr=""} - "Unmatched opening brace"; List.rev acc)) - - | Some ('\n') - -> source#advance; - nextline ctx acc doc + | ((location, _) :: _ctx) + -> prelexer_error location "Unmatched opening brace"; + List.rev acc)

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

(* A comment. *) | Some ('%') -> consume_until_newline source; - nextline ctx acc doc + loop ctx acc doc

(* line's bounds seems ok: String.sub line 1 0 == "" *) | Some ('@') @@ -102,118 +97,91 @@ let rec prelex (source : #Source.t) ln ctx acc (doc : string) let start_offset = source#current_offset in consume_until_newline source; let new_doc = String.trim (source#slice_from_offset start_offset) in - nextline ctx acc (doc ^ "\n" ^ new_doc) + loop ctx acc (doc ^ "\n" ^ new_doc)

(* A string. *) | Some ('"') -> source#advance; - let rec prestring cp chars = + let rec prestring chars = match source#next_char with | None | Some ('\n') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cpos; docstr=doc} - in + -> let location = source#current_location doc in prelexer_error location "Unterminated string"; - nextline ctx (Prestring (location, "") :: acc) "" + loop ctx (Prestring (location, "") :: acc) ""

| Some ('"') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cpos; docstr=doc} - in + -> let location = source#current_location doc in let pretoken = Prestring (location, string_implode (List.rev chars)) in - nexttok (cp + 1) (pretoken :: acc) "" + loop ctx (pretoken :: acc) ""

| Some ('\') -> (match source#next_char with | None | Some ('\n') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cp; docstr=doc} - in + -> let location = source#current_location doc in prelexer_error location "Unterminated escape sequence"; - nextline ctx (Prestring (location, "") :: acc) "" - | Some ('t') -> prestring (cp + 2) ('\t' :: chars) - | Some ('n') -> prestring (cp + 2) ('\n' :: chars) - | Some ('r') -> prestring (cp + 2) ('\r' :: chars) + loop ctx (Prestring (location, "") :: acc) "" + | Some ('t') -> prestring ('\t' :: chars) + | Some ('n') -> prestring ('\n' :: chars) + | Some ('r') -> prestring ('\r' :: chars) | Some ('u') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cp; docstr=doc} - in + -> let location = source#current_location doc in prelexer_error location "Unimplemented unicode escape"; - prestring (cp + 2) chars - | Some (c) -> prestring (cp + 2) (c :: chars)) + prestring chars + | Some (c) -> prestring (c :: chars))

- | Some (char) -> prestring (inc_cp cp char) (char :: chars) - in prestring (cpos + 1) [] + | Some (char) -> prestring (char :: chars) + in prestring []

| Some ('{') -> source#advance; - prelex' ((ln, cpos, acc) :: ctx) (cpos + 1) [] doc + let ctx' = (source#current_location doc, acc) :: ctx in + loop ctx' [] doc

| Some ('}') -> source#advance; + let location = source#current_location doc in (match ctx with - | ((sln, scpos, sacc) :: ctx) -> - prelex' ctx (cpos+1) - (Preblock ({file=source#file_name; line=sln; column=scpos; docstr=doc}, - List.rev acc, - {file=source#file_name; line=ln; column=(cpos + 1); docstr=doc}) - :: sacc) "" - | _ -> (prelexer_error {file=source#file_name; line=ln; column=cpos; docstr=doc} - "Unmatched closing brace"; - prelex' ctx (cpos + 1) acc doc)) + | ((slocation, sacc) :: ctx) + -> let preblock = Preblock (slocation, List.rev acc, location) in + loop ctx (preblock :: sacc) "" + | _ + -> prelexer_error location "Unmatched closing brace"; + loop ctx acc doc)

(* A pretoken. *) - | Some (c) + | Some _ -> let start_offset = source#current_offset in source#advance; - let rec pretok cp = + let rec pretok () = match source#peek_char with - | None | Some (' ' | '\t' | '%' | '"' | '{' | '}') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cpos; docstr=doc} - in + | None | Some ('%' | '"' | '{' | '}') + -> let location = source#current_location doc in let text = source#slice_from_offset start_offset in - nexttok cp (Pretoken (location, text) :: acc) "" + loop ctx (Pretoken (location, text) :: acc) ""

- | Some ('\n') - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cpos; docstr=doc} - in + | Some (c) when c <= ' ' + -> let location = source#current_location doc in let text = source#slice_from_offset start_offset in source#advance; - nextline ctx (Pretoken (location, text) :: acc) "" + loop ctx (Pretoken (location, text) :: acc) ""

| Some ('\') -> source#advance; (match source#next_char with - | Some (char) -> pretok (1 + inc_cp cp char) + | Some _ -> pretok () | None - -> let location = - let open Source.Location in - {file=source#file_name; line=ln; column=cpos; docstr=doc} - in + -> let location = source#current_location doc in source#advance; let text = source#slice_from_offset start_offset in prelexer_error location ("Unterminated escape sequence in: " ^ text); - nexttok (cp + 1) (Pretoken (location, text) :: acc) "") + loop ctx (Pretoken (location, text) :: acc) "")

- | Some (c) + | Some _ -> source#advance; - pretok (inc_cp cp c) - in pretok (inc_cp cpos c) + pretok () + in pretok () in - (* Traditionally, column numbers start at 1 :-( *) - prelex' ctx 1 acc doc - -let prelex (source : #Source.t) : pretoken list = - (* Traditionally, line numbers start at 1 :-( *) - prelex source 1 [] [] "" + loop [] [] ""

let pretoken_name pretok = match pretok with

===================================== src/source.ml ===================================== @@ -35,17 +35,30 @@ module Location = struct && String.equal l_doc r_doc end

+(* Traditionally, line numbers start at 1… *) +let first_line_of_file = 1 +(* … and so do column numbers :-( *) +let first_column_of_line = 1 + (* A source object is text paired with a cursor. The text can be lazily loaded as it is accessed byte by byte, but it must be retained for future reference by error messages. *) -class virtual t = object (self) +class virtual t (base_line : int) (base_column : int) (file_name : string) = +object (self) + val mutable line = base_line + val mutable column = base_column + (* A path if the text comes from a file, otherwise a meaningful identifier. *) - method virtual file_name : string + method file_name : string = file_name

(* Return the byte at the cursor, or None if the cursor is at the end of the text. *) method virtual peek_char : char option

+ (* The current location of the cursor. *) + method current_location (docstr : string) : Location.t = + {file = file_name; line; column; docstr} + (* The current offset of the cursor in the file, in bytes. *) method virtual current_offset : int

@@ -58,8 +71,21 @@ class virtual t = object (self) method virtual slice_from_offset : int -> string

(* Moves the cursor forward one byte *) - method virtual advance : unit - + method advance : unit = + let is_utf8_head c = Char.code c < 128 || Char.code c >= 192 in + let c = self#peek_char in + self#advance_impl; + match c with + | Some '\n' + -> line <- line + 1; + column <- 0; + | Some c when is_utf8_head c + -> column <- column + 1 + | _ -> () + + method private virtual advance_impl : unit + + (* Returns the char at the cursor, then advances it forward. *) method next_char : char option = let c = self#peek_char in self#advance; @@ -69,45 +95,49 @@ end let read_buffer_length = 4096

class source_file file_name = object (self) - inherit t + inherit t first_line_of_file first_column_of_line file_name

val in_channel = open_in file_name val mutable end_of_line = false - val mutable line = "" + val mutable source_line = "" val mutable line_offset = 0 val mutable offset = 0

method private peek_char_unchecked = - if offset < String.length line - then line.[offset] + if offset < String.length source_line + then source_line.[offset] else '\n'

method peek_char = - if offset <= String.length line + if offset <= String.length source_line then Some self#peek_char_unchecked else try - line_offset <- line_offset + 1 + String.length line; - line <- input_line in_channel; + line_offset <- line_offset + 1 + String.length source_line; + source_line <- input_line in_channel; offset <- 0; Some self#peek_char_unchecked with | End_of_file -> None

- method advance = + method advance_impl = offset <- offset + 1

method current_offset = line_offset + offset

method slice_from_offset start_offset = let relative_start_offset = start_offset - line_offset in - String.sub line relative_start_offset (offset - relative_start_offset) - - method file_name = file_name + String.sub source_line relative_start_offset (offset - relative_start_offset) end

-class source_string source = object - inherit t +class source_string + ?(base_line : int = first_line_of_file) + ?(base_column : int = first_column_of_line) + ?(file_name : string = "<string>") + source + = +object + inherit t base_line base_column file_name

val mutable offset = 0

@@ -116,13 +146,11 @@ class source_string source = object then Some (source.[offset]) else None

- method advance = + method advance_impl = offset <- offset + 1

method current_offset = offset

method slice_from_offset start_offset = String.sub source start_offset (offset - start_offset) - - method file_name = "<string>" end

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