annotate lib/source.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 (* lib/source.ml *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 (* Copyright (c) 2017 J. M. Spivey *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 let filename = ref ""
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 let chan = ref stdin
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 let linetab = Hashtbl.create 100
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 let note_line n lexbuf =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 Hashtbl.add linetab n (Lexing.lexeme_end lexbuf)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 let get_line n =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 let pos0 = pos_in !chan in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 let line =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 try seek_in !chan (Hashtbl.find linetab n); input_line !chan with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 Not_found -> ""
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 | End_of_file -> "" in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 seek_in !chan pos0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 line
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 let init fn ch =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 filename := fn; chan := ch;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 Hashtbl.add linetab 1 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 let err_message fmt args ln =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 fprintf stderr "\"$\", line $: $\n"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 [fStr !filename; fNum ln; fMeta fmt args];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 flush stderr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30