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

Commits: f289b62a by Simon Génier at 2021-05-29T12:12:42-04:00 Rewrite the Lexer module in terms of source objects.

This might not look useful, but it will simplify a great deal our next change of add and end point to location records since all the location related code will be in there source objects.

I ended up rewriting most of the Lexer. I tried to avoid doing that, but the offset handling code was so mixed up with the rest than that turned out to give worse code and a diff as unreadable. I'm pretty confident that that the changes are OK since we are still able to load pervasives.typer and I wrote a few tests for the trickier inner operators.

- - - - - 8d9a2367 by Simon Génier at 2021-06-09T12:28:31-04:00 Merge branch 'lexer-with-source'

- - - - -

3 changed files:

- src/lexer.ml - src/option.ml - src/source.ml

Changes:

===================================== src/lexer.ml ===================================== @@ -27,16 +27,6 @@ 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' - -type num_part = | NPint | NPfrac | NPexp - let unescape str = let rec split b = if b >= String.length str then [] @@ -45,108 +35,198 @@ let unescape str = string_sub str b e :: split (e + 1) in String.concat "" (split 0)

-let nexttoken (stt : token_env) (pts : pretoken list) bpos cpos - (* The returned Sexp may not be a Node. *) - : sexp * pretoken list * bytepos * charpos = - match pts with - | [] -> (Log.internal_error "No next token!") - | (Preblock (sl, bpts, el) :: pts) -> (Block (sl, bpts, el), pts, 0, 0) - | (Prestring (loc, str) :: pts) -> (String (loc, str), pts, 0, 0) - | (Pretoken ({file;line;column;docstr}, name) :: pts') - -> let char = name.[bpos] in - if digit_p char - || (char = '-' (* FIXME: Handle '+' as well! *) - && bpos + 1 < String.length name - && digit_p (name.[bpos + 1])) then - let rec lexnum bp cp (np : num_part) = - if bp >= String.length name then - ((if np == NPint then - Integer ({file;line;column=column+cpos;docstr=docstr}, - Z.of_string (string_sub name bpos bp)) - else - Float ({file;line;column=column+cpos;docstr=docstr}, - float_of_string (string_sub name bpos bp))), - pts', 0, 0) - else - match name.[bp] with - | ('0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9') - -> lexnum (bp+1) (cp+1) np - | '.' when np == NPint -> lexnum (bp+1) (cp+1) NPfrac - | ('e'|'E') when not (np == NPexp) -> lexnum (bp+1) (cp+1) NPexp - | ('+'|'-') - when np == NPexp && (name.[bp-1] == 'e' || name.[bp-1] == 'E') - -> lexnum (bp+1) (cp+1) NPexp - | _ - -> ((if np == NPint then - Integer ({file;line;column=column+cpos;docstr=docstr}, - Z.of_string (string_sub name bpos bp)) - else - Float ({file;line;column=column+cpos;docstr=docstr}, - float_of_string (string_sub name bpos bp))), - pts, bp, cp) - in lexnum (bpos+1) (cpos+1) NPint - else if bpos + 1 >= String.length name then - (hSymbol ({file;line;column=column+cpos;docstr=docstr}, - string_sub name bpos (String.length name)), - pts', 0, 0) - else if stt.(Char.code name.[bpos]) = CKseparate then - (hSymbol ({file;line;column=column+cpos;docstr=docstr}, - string_sub name bpos (bpos + 1)), - pts, bpos+1, cpos+1) - else - let rec lexsym bpos cpos = - let mksym epos escaped - = if epos = bpos then epsilon {file;line;column=column+cpos;docstr=docstr} else - let rawstr = string_sub name bpos epos in - let str = if escaped then unescape rawstr else rawstr in - hSymbol ({file;line;column=column+cpos;docstr=docstr}, str) in - let rec lexsym' prec lf bp cp escaped = - if bp >= String.length name then - (lf (mksym (String.length name) escaped), pts', 0, 0) - else - let char = name.[bp] in - let bp' = bp + 1 in - let is_last = bp' >= String.length name in - match stt.(Char.code char) with - | _ when char == '\' && not is_last - (* Skip next char, in case it's a special token. *) - (* For utf-8, this cp+2 is risky but actually works: \ counts - * as 1 and if the input is valid utf-8 the next byte has to - * be a leading byte, so it has to count as 1 as well ;-) *) - -> lexsym' prec lf (bp+2) (cp+2) true - | CKseparate -> (lf (mksym bp escaped), pts, bp, cp) - (* Turn `inner` infix operators, such as the "." of - * "Module.elem" into the equivalent of (__.__ Module elem). *) - | CKinner prec' - (* To be considered `inner`, an operator char needs to have - * something on its LHS or its RHS, otherwise, treat it as - * a normal char, `.` can be a normal operator as well. *) - when bpos != bp - || (not is_last - && CKseparate != (stt.(Char.code name.[bp']))) - || not (lf dummy_epsilon = dummy_epsilon) - -> let left = mksym bp escaped in - let op = hSymbol ({file;line;column=column+cp;docstr=docstr}, - "__" ^ String.sub name bp 1 ^ "__") in - let bpos = bp' in - let cpos = inc_cp cp char in - let lf' = if prec' > prec then - (fun s -> lf (Node (op, [left; s]))) - else - (fun s -> Node (op, [lf left; s])) in - lexsym bpos cpos prec' lf' - bpos cpos false - | _ -> lexsym' prec lf (bp+1) (inc_cp cp char) escaped - in lexsym' - in lexsym bpos cpos 0 (fun s -> s) bpos cpos false - -let lex tenv (pts : pretoken list) : sexp list = - let rec gettokens pts bpos cpos acc = - match pts with +let lex_number + (source : #Source.t) + (start_location : Source.Location.t) + (start_offset : int) + : sexp = + + let rec lex_exponent () = + match source#peek_char with + | Some ('0' .. '9') + -> source#advance; + lex_exponent () + + | _ + -> let source = source#slice_from_offset start_offset in + Float (start_location, float_of_string source) + in + + let lex_exponent_sign () = + match source#peek_char with + | Some ('0' .. '9' | '+' | '-') + -> source#advance; + lex_exponent () + + (* TODO: error if there are no signs or digits after the 'e'? *) + | _ + -> let source = source#slice_from_offset start_offset in + Float (start_location, float_of_string source) + in + + let rec lex_fractional () = + match source#peek_char with + | Some ('0' .. '9') + -> source#advance; + lex_fractional () + + | Some ('e' | 'E') + -> source#advance; + lex_exponent_sign () + + | _ + -> let source = source#slice_from_offset start_offset in + Float (start_location, float_of_string source) + in + + let rec lex_integer () = + match source#peek_char with + | Some ('0' .. '9') + -> source#advance; + lex_integer () + + | Some ('.') + -> source#advance; + lex_fractional () + + | Some ('e' | 'E') + -> source#advance; + lex_exponent_sign () + + | _ + -> let source = source#slice_from_offset start_offset in + Integer (start_location, Z.of_string source) + in + + lex_integer () + +(* Splits one symbol from the beginning of the source. *) +let lex_symbol + (token_env : token_env) + (source : #Source.t) + (doc : string) + (start_location : Source.Location.t) + (start_offset : int) + : sexp = + + let mksym start_location start_offset escaped = + if Int.equal start_offset source#current_offset + then epsilon start_location + else + let raw_name = source#slice_from_offset start_offset in + let name = if escaped then unescape raw_name else raw_name in + hSymbol (start_location, name) + in + + let rec loop start_location start_offset prec lf (escaped : bool) = + match source#peek_char with + | None + -> lf (mksym start_location start_offset escaped) + + | Some c + -> (match token_env.(Char.code c) with + | CKseparate + -> lf (mksym start_location start_offset escaped) + + | CKinner prec' + -> let left = mksym start_location start_offset escaped in + let op_location = source#current_location doc in + + (* To be considered `inner`, an operator char needs to have + something on its LHS or its RHS, otherwise, treat it as a + normal char. `.` can be the normal function composition + operator as well. *) + let lhs_p = start_offset != source#current_offset in + source#advance; + let rhs_p = + (match source#peek_char with + | None -> false + | Some c' -> CKseparate != token_env.(Char.code c')) + in + if lhs_p || rhs_p || lf dummy_epsilon <> dummy_epsilon + then + let op = hSymbol (op_location, Printf.sprintf "__%c__" c) in + let lf' = + if prec' > prec + then fun s -> lf (Node (op, [left; s])) + else fun s -> Node (op, [lf left; s]) + in + loop (source#current_location doc) source#current_offset prec' lf' false + else + loop start_location start_offset prec lf escaped + + | CKnormal + -> (source#advance; + let is_last = Option.is_none source#peek_char in + match c with + (* Skip next char, in case it's a special token. For utf-8, + simply advancing is risky but actually works: '' counts as 1 + and if the input is valid utf-8 the next byte has to be a + leading byte, so it has to count as 1 as well ;-) *) + | '\' when not is_last + -> source#advance; + loop start_location start_offset prec lf true + + | _ -> loop start_location start_offset prec lf escaped)) + in + loop start_location start_offset 0 (fun s -> s) false + +let split_presymbol + (token_env : token_env) + (source : #Source.t) + (doc : string) + : sexp list = + + let rec loop (acc : sexp list) : sexp list = + match source#peek_char with + | None -> List.rev acc + | Some (c) + -> let start_offset = source#current_offset in + let start_location = source#current_location doc in + let token = + match c with + (* A negative number literal, or a symbol starting with '-'. *) + | '-' + -> (source#advance; + match source#peek_char with + | Some ('0' .. '9') + -> lex_number source start_location start_offset + | _ + -> lex_symbol token_env source doc start_location start_offset) + + | '0' .. '9' + -> (source#advance; + lex_number source start_location start_offset) + + | _ when token_env.(Char.code c) = CKseparate + -> source#advance; + let name = source#slice_from_offset start_offset in + hSymbol (start_location, name) + + | _ + -> lex_symbol token_env source doc start_location start_offset + in + loop (token :: acc) + in + loop [] + +let lex (token_env : token_env) (pretokens : pretoken list) : sexp list = + let rec loop pretokens acc = + match pretokens with | [] -> List.rev acc - | _ -> let (tok, pts, bpos, cpos) = nexttoken tenv pts bpos cpos - in gettokens pts bpos cpos (tok :: acc) in - gettokens pts 0 0 [] + + | Preblock (start_location, block_pretokens, end_location) :: pretokens' + -> loop pretokens' (Block (start_location, block_pretokens, end_location) :: 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 + loop pretokens' (List.rev_append tokens acc) + in + loop pretokens []

let lex_source (source : #Source.t) tenv = let pretoks = prelex source in @@ -155,4 +235,3 @@ let lex_source (source : #Source.t) tenv = let sexp_parse_source (source : #Source.t) tenv grm limit = let toks = lex_source source tenv in sexp_parse_all_to_list grm toks limit -

===================================== src/option.ml ===================================== @@ -40,3 +40,8 @@ let is_some (o : 'a option) : bool = match o with | Some _ -> true | None -> false + +let is_none (o : 'a option) : bool = + match o with + | Some _ -> false + | None -> true

===================================== src/source.ml ===================================== @@ -131,13 +131,13 @@ class source_file file_name = object (self) end

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

val mutable offset = 0

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