Fix Atom definition of Usexp
Fix the is_valid function to only validate atoms that don't contain spaces, parens, comment characters.
This commit is contained in:
parent
154b405e51
commit
f39b302a8d
|
@ -15,17 +15,18 @@ module A = Parser_automaton_internal
|
|||
module Atom = struct
|
||||
type t = Sexp_ast.atom = A of string [@@unboxed]
|
||||
|
||||
let is_valid s =
|
||||
if s = "" then false
|
||||
else
|
||||
try
|
||||
for i = 0 to String.length s - 1 do
|
||||
match String.unsafe_get s i with
|
||||
| ' ' .. '~' -> ()
|
||||
| _ -> raise Exit
|
||||
done;
|
||||
true
|
||||
with Exit -> false
|
||||
let is_valid str =
|
||||
let len = String.length str in
|
||||
len = 0 ||
|
||||
let rec loop ix =
|
||||
match str.[ix] with
|
||||
| '"' | '(' | ')' | ';' | '\\' -> true
|
||||
| '|' -> ix > 0 && let next = ix - 1 in Char.equal str.[next] '#' || loop next
|
||||
| '#' -> ix > 0 && let next = ix - 1 in Char.equal str.[next] '|' || loop next
|
||||
| '\000' .. '\032' | '\127' .. '\255' -> true
|
||||
| _ -> ix > 0 && loop (ix - 1)
|
||||
in
|
||||
not (loop (len - 1))
|
||||
|
||||
(* XXX eventually we want to report a nice error message to the user
|
||||
at the point the conversion is made. *)
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
|
||||
module Atom : sig
|
||||
type t = private A of string [@@unboxed]
|
||||
(** Acceptable atoms are composed of chars in the range [' ' .. '~']
|
||||
and must be nonempty. *)
|
||||
(** Acceptable atoms are composed of chars in the range ['!' .. '~'] excluding
|
||||
[' ' '"' '(' ')' ';' '\\'], and must be nonempty. *)
|
||||
|
||||
val is_valid : string -> bool
|
||||
(** [is_valid s] checks that [s] respects the constraints to be an atom. *)
|
||||
|
|
|
@ -35,11 +35,11 @@
|
|||
-))
|
||||
(generate_runner
|
||||
((progn
|
||||
(echo let () = print_int 41)
|
||||
(echo "let () = print_int 41")
|
||||
(echo "\n")
|
||||
(echo let () = print_int 42)
|
||||
(echo "let () = print_int 42")
|
||||
(echo "\n")
|
||||
(echo let () = print_int 43;;))))
|
||||
(echo "let () = print_int 43;;"))))
|
||||
(extends ())))))
|
||||
run alias dune-file/runtest
|
||||
414243
|
||||
|
|
Loading…
Reference in New Issue