Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
172 lines (140 sloc) 5.28 KB
\section{Main Module}
Everything starts at the main module: it parses the command line and
calls functions that do the actual work. Catching and reporting errors
to the user is also the main modules' responsibility. The Main module
has an interface but since [[main]] is called automatically it is not of
much use.
<<main.mli>>=
val main: unit -> unit (* executed automatically *)
@
\subsection{Implementation}
<<main.ml>>=
exception Usage of string
let error fmt = Printf.kprintf (fun msg -> raise (Usage msg)) fmt
let printf = Printf.printf
let sprintf = Printf.sprintf
let version = "0.9.1"
let (@@) f x = f x
let this = Sys.argv.(0)
let synopsis =
[ "usage: "^this^" [options] [file.annot]"
; ""
; "-type line column lookup type annotation for position"
; "-dump dump annotations to stdout"
; "-n suppress newline after last line"
; "-r include range for annotation"
; "-version identify version of "^this^" on stdout"
; "-h, -help offer minimal help on stdout"
; ""
; "Maintainer: Anil Madhavapedddy http://anil.recoil.org/"
; "Author: Christian Lindig http://www.st.cs.uni-sb.de/~lindig/"
]
let usage msg = List.iter prerr_endline (msg :: synopsis)
let help () = List.iter print_endline synopsis
let version () =
List.iter print_endline
[ this^" version " ^ version ]
@
<<main.ml>>=
module A = Annot.ByPosition
@
Operation [[with_file]] opens a file for reading and passes the file
handle to an action. It takes care of closing the file, even in the case
of errors.
<<main.ml>>=
let log = open_out "log"
let find_file file =
let (/) = Filename.concat in
let file = Filename.basename file in
let prefix = ref (Filename.dirname file) in
let suffix = ref "" in
let result = ref None in
let backends = [ ""; "unix-socket"; "unix-direct"; "node"; "xen" ] in
while !result = None do
List.iter (fun backend ->
if !prefix = "/" then
raise Not_found;
let f = !prefix / "_build" / backend / !suffix / file in
output_string log f;
output_string log "\n";
flush log;
if Sys.file_exists f then
result := Some f;
prefix := Filename.dirname !prefix;
suffix := (Filename.basename !prefix) / !suffix;
) backends
done;
match !result with
| Some r -> r
| None -> raise Not_found
let with_file file action =
let file =
try find_file file
with Not_found -> print_string ("Cannot find " ^ file); exit 1 in
let ic = open_in file in
try
let result = action ic in
close_in ic; result
with
x -> close_in ic; raise x
let annotations_from channel =
let lexbuf = Lexing.from_channel channel in
try
Parser.annotations Scanner.token lexbuf
with
Parsing.Parse_error ->
error "parse error at offset %d" (Lexing.lexeme_start lexbuf)
let int x = try int_of_string x with Failure _ -> error "not an int: %s" x
@
Options that control the format when emitting annotations.
<<main.ml>>=
type options =
{ mutable newline: bool (* emit newline after annotation *)
; mutable range: bool (* include range in type annotation *)
}
let options =
{ newline = true
; range = false
}
@
Read type annotation from channel [[ic]] and report the annotation for a
given [[line]] and [[column]] to stdout. We first build an interval map
and then search it for the given position.
<<main.ml>>=
let typeannot options line column ic =
let line, column = int line, int column in
let nl = if options.newline then "\n" else "" in
let range ((l,c),(l',c')) = match options.range with
| false -> ""
| true -> Printf.sprintf "%d:%d-%d:%d " l c l' c' in
let annots = annotations_from ic in
match A.find annots (line, column) with
| Some (r,s) -> print_string (range r ^ s ^ nl)
| None -> print_string ("no type found" ^ nl)
@
Read annotations from channel [[ic]], build an interval map from it and
dump it to stdout (for debugging).
<<main.ml>>=
let dump ic = A.dump (fun x -> x) @@ annotations_from ic
let main () =
let argv = Array.to_list Sys.argv in
let args = List.tl argv in
let rec parse = function
| "-h" :: [] -> help ()
| "-help" :: [] -> help ()
| "-version" :: [] -> version ()
| "-n" :: args -> options.newline <- false; parse args
| "-r" :: args -> options.range <- true; parse args
| ["-type"; line;col;file] -> with_file file
@@ typeannot options line col
| ["-type"; line;col] -> typeannot options line col stdin
| ["-dump"; file] -> with_file file @@ dump
| ["-dump"] -> dump stdin
| x :: _ -> usage @@ sprintf "error: illegal command line argument %s" x
| [] -> usage "error: expected an option"
in
try parse args with
| Usage msg -> (usage msg; exit 1)
| Sys_error msg -> (print_endline msg; exit 1)
let () = if !Sys.interactive then () else main ()
@
Something went wrong with that request. Please try again.