Stefan pushed to branch master at Stefan / Typer
Commits: a93d6441 by Stefan Monnier at 2016-11-18T14:21:13-05:00 * src/lexer.ml (nexttoken.lexsym): Implement the CKinner feature
* tests/sexp_test.ml: Add tests for the CKinner feature. Fix non-escape backslash in tests.
- - - - -
3 changed files:
- doc/manual.texi - src/lexer.ml - tests/sexp_test.ml
Changes:
===================================== doc/manual.texi ===================================== --- a/doc/manual.texi +++ b/doc/manual.texi @@ -77,8 +77,8 @@ non-special characters and hence need to be separated by spaces.
Special characters are: @code{%}, @code{"}, @code{@{}, @code{@}}, whitespace characters, plus a configurable list of extra special -characters, which by default is comprised of @code{,}, @code{;}, -@code{(}, and @code{)}. +characters called @emph{token characters}, which by default is +comprised of @code{,}, @code{;}, @code{(}, and @code{)}.
The character @code{} is also special: it makes the next character non-special, so it can be used to include characters like @code{"} @@ -108,6 +108,13 @@ After lexing, the Sexp parsing code turns the sequence of tokens into a kind of syntax tree according to an @emph{operator precedence grammar}.
+Tokens are themselves parsed according to a limited precedence +grammar. By default this grammar only has the infix operator +@code{.}. So, @code{a.b.c} and @code{__.__ (__.__ a b) c} are +parsed into identical Sexps. + +Tokens + Macros receive their arguments in this Sexp form.
@node Parsing code
===================================== src/lexer.ml ===================================== --- a/src/lexer.ml +++ b/src/lexer.ml @@ -86,25 +86,51 @@ let nexttoken (stt : token_env) (pts : pretoken list) bpos cpos string_sub name bpos (bpos + 1)), pts, bpos+1, cpos+1) else - let mksym epos escaped - = let rawstr = string_sub name bpos epos in - let str = if escaped then unescape rawstr else rawstr in - hSymbol ({file;line;column=column+cpos}, str) in - let rec lexsym bp cp escaped = - if bp >= String.length name then - (mksym (String.length name) escaped, pts', 0, 0) - else - let char = name.[bp] in - if char == '\' && bp + 1 < String.length name then - (* 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 (bp+2) (cp+2) true - else if stt.(Char.code name.[bp]) = CKseparate then - (mksym bp escaped, pts, bp, cp) - else lexsym (bp+1) (inc_cp cp char) escaped - in lexsym bpos cpos false + let rec lexsym bpos cpos = + let mksym epos escaped + = if epos = bpos then Epsilon 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}, 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']))) + || lf Epsilon != Epsilon + -> let left = mksym bp escaped in + let op = hSymbol ({file;line;column=column+cp}, + "__" ^ 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 =
===================================== tests/sexp_test.ml ===================================== --- a/tests/sexp_test.ml +++ b/tests/sexp_test.ml @@ -39,11 +39,12 @@ let _ = test_sexp_eqv "(x + y)" "_+_ x y" let _ = test_sexp_eqv "(x := y)" "_:=_ x y" let _ = test_sexp_eqv "if A then B else C -> D" "if A then B else (C -> D)" let _ = test_sexp_eqv "A : B -> C" "A : (B -> C)" -let _ = test_sexp_eqv "f __; y" "(f (__;) y)" +let _ = test_sexp_eqv "f __\; y" "(f (__\;) y)" let _ = test_sexp_eqv "case e | p1 => e1 | p2 => e2" "case_ (_|_ e (_=>_ p1 e1) (_=>_ p2 e2))" let _ = test_sexp_eqv "a\b\c" "abc" -let _ = test_sexp_eqv "(a;b)" "(_;_ a b)" +let _ = test_sexp_eqv "(a;b)" "(_\;_ a b)" +let _ = test_sexp_eqv "a.b.c . (.)" "(__\.__ (__\.__ a b) c) \. \."
(* run all tests *) let _ = run_all ()
View it on GitLab: https://gitlab.com/monnier/typer/commit/a93d64418f53a059884013ffdba8a80e1928...
Afficher les réponses par date