diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-05-04 13:30:00 +0200 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-05-04 13:33:08 +0200 |
commit | a6de02fcfde76f49b10d8481a2423692fa105756 (patch) | |
tree | 344a2e7114b8cb9cc0e54d8d801b4f7cdf5d6d7b /checker/votour.ml | |
parent | c81228e693dea839f648ddc95f7cedec22d6a47a (diff) | |
parent | 174fd1f853f47d24b350a53e7f186ab37829dc2a (diff) |
Merge branch 'v8.5'
Diffstat (limited to 'checker/votour.ml')
-rw-r--r-- | checker/votour.ml | 48 |
1 files changed, 33 insertions, 15 deletions
diff --git a/checker/votour.ml b/checker/votour.ml index 79755da4a..48f9f45e7 100644 --- a/checker/votour.ml +++ b/checker/votour.ml @@ -10,6 +10,26 @@ open Values (** {6 Interactive visit of a vo} *) +let rec read_num max = + let quit () = + Printf.printf "\nGoodbye!\n%!"; + exit 0 in + Printf.printf "# %!"; + let l = try read_line () with End_of_file -> quit () in + if l = "u" then None + else if l = "x" then quit () + else + try + let v = int_of_string l in + if v < 0 || v >= max then + let () = + Printf.printf "Out-of-range input! (only %d children)\n%!" max in + read_num max + else Some v + with Failure "int_of_string" -> + Printf.printf "Unrecognized input! <n> enters the <n>-th child, u goes up 1 level, x exits\n%!"; + read_num max + type 'a repr = | INT of int | STRING of string @@ -255,15 +275,13 @@ let rec visit v o pos = (fun i vop -> Printf.printf " %d: %s\n" i (node_info vop)) children; Printf.printf "-------------\n"; - Printf.printf ("# %!"); - let l = read_line () in try - if l = "u" then let info = pop () in visit info.typ info.obj info.pos - else if l = "x" then (Printf.printf "\nGoodbye!\n\n";exit 0) - else - let v',o',pos' = children.(int_of_string l) in - push (get_name v) v o pos; - visit v' o' pos' + match read_num (Array.length children) with + | None -> let info = pop () in visit info.typ info.obj info.pos + | Some child -> + let v',o',pos' = children.(child) in + push (get_name v) v o pos; + visit v' o' pos' with | Failure "empty stack" -> () | Failure "forbidden" -> let info = pop () in visit info.typ info.obj info.pos @@ -350,13 +368,13 @@ let visit_vo f = let size = if Sys.word_size = 64 then header.size64 else header.size32 in Printf.printf " %d: %s, starting at byte %d (size %iw)\n" i name pos size) segments; - Printf.printf "# %!"; - let l = read_line () in - let seg = int_of_string l in - seek_in ch segments.(seg).pos; - let o = Repr.input ch in - let () = Visit.init () in - Visit.visit segments.(seg).typ o [] + match read_num (Array.length segments) with + | Some seg -> + seek_in ch segments.(seg).pos; + let o = Repr.input ch in + let () = Visit.init () in + Visit.visit segments.(seg).typ o [] + | None -> () done let main = |