13 val inc: T -> T |
13 val inc: T -> T |
14 val none: T |
14 val none: T |
15 val line: int -> T |
15 val line: int -> T |
16 val file: string -> T |
16 val file: string -> T |
17 val path: Path.T -> T |
17 val path: Path.T -> T |
18 val of_properties: Markup.property list -> T * Markup.property list |
18 val of_properties: Markup.property list -> T |
19 val properties_of: T -> Markup.property list |
19 val properties_of: T -> Markup.property list |
|
20 val thread_data: unit -> T |
|
21 val setmp_thread_data: T -> ('a -> 'b) -> 'a -> 'b |
20 val str_of: T -> string |
22 val str_of: T -> string |
21 end; |
23 end; |
22 |
24 |
23 structure Position: POSITION = |
25 structure Position: POSITION = |
24 struct |
26 struct |
25 |
27 |
26 (* datatype position *) |
28 (* datatype position *) |
27 |
29 |
28 datatype T = |
30 datatype T = Pos of int option * Markup.property list; |
29 Pos of int option * string option; |
|
30 |
31 |
31 fun line_of (Pos (opt_n, _)) = opt_n; |
32 fun line_of (Pos (opt_n, _)) = opt_n; |
32 fun file_of (Pos (_, opt_s)) = opt_s; |
33 fun file_of (Pos (_, props)) = AList.lookup (op =) props Markup.fileN ; |
33 |
34 |
34 fun inc (pos as Pos (NONE, _)) = pos |
35 fun inc (pos as Pos (NONE, _)) = pos |
35 | inc (Pos (SOME n, opt_s)) = Pos (SOME (n + 1), opt_s); |
36 | inc (Pos (SOME n, props)) = Pos (SOME (n + 1), props); |
36 |
37 |
37 val none = Pos (NONE, NONE); |
38 val none = Pos (NONE, []); |
38 fun line n = Pos (SOME n, NONE); |
39 fun line n = Pos (SOME n, []); |
39 fun file s = Pos (SOME 1, SOME s); |
40 fun file s = Pos (SOME 1, [(Markup.fileN, s)]); |
40 |
41 |
41 val path = file o Path.implode o Path.expand; |
42 val path = file o Path.implode o Path.expand; |
42 |
43 |
43 |
44 |
44 (* markup properties *) |
45 (* markup properties *) |
45 |
46 |
46 fun of_properties ps = |
47 fun of_properties props = |
47 let |
48 let |
48 val lookup = AList.lookup (op =) ps; |
|
49 val opt_n = |
49 val opt_n = |
50 (case lookup Markup.lineN of |
50 (case AList.lookup (op =) props Markup.lineN of |
51 SOME s => Int.fromString s |
51 SOME s => Int.fromString s |
52 | NONE => NONE); |
52 | NONE => NONE); |
53 val opt_s = lookup Markup.fileN; |
53 fun get name = the_list (find_first (fn (x: string, _) => x = name) props); |
54 val ps' = filter_out (fn (x, _) => x = Markup.lineN orelse x = Markup.fileN) ps; |
54 in (Pos (opt_n, get Markup.fileN @ get Markup.idN)) end; |
55 in (Pos (opt_n, opt_s), ps') end; |
|
56 |
55 |
57 fun properties_of (Pos (opt_n, opt_s)) = |
56 fun properties_of (Pos (opt_n, props)) = |
58 (case opt_n of SOME n => [(Markup.lineN, string_of_int n)] | NONE => []) @ |
57 (case opt_n of SOME n => [(Markup.lineN, string_of_int n)] | NONE => []) @ props; |
59 (case opt_s of SOME s => [(Markup.fileN, s)] | NONE => []); |
58 |
|
59 |
|
60 (* thread data *) |
|
61 |
|
62 local val tag = Universal.tag () : T Universal.tag in |
|
63 |
|
64 fun thread_data () = the_default none (Multithreading.get_data tag); |
|
65 fun setmp_thread_data pos = Library.setmp_thread_data tag (thread_data ()) pos; |
|
66 |
|
67 end; |
60 |
68 |
61 |
69 |
62 (* str_of *) |
70 (* str_of *) |
63 |
71 |
64 fun print (Pos (SOME n, NONE)) = "(line " ^ string_of_int n ^ ")" |
72 fun print (SOME n, NONE) = "(line " ^ string_of_int n ^ ")" |
65 | print (Pos (NONE, SOME s)) = "(" ^ s ^ ")" |
73 | print (NONE, SOME s) = "(" ^ s ^ ")" |
66 | print (Pos (SOME n, SOME s)) = "(line " ^ string_of_int n ^ " of " ^ quote s ^ ")"; |
74 | print (SOME n, SOME s) = "(line " ^ string_of_int n ^ " of " ^ quote s ^ ")"; |
67 |
75 |
68 fun str_of (Pos (NONE, NONE)) = "" |
76 fun str_of pos = |
69 | str_of pos = |
77 (case (line_of pos, file_of pos) of |
70 " " ^ Markup.markup (Markup.properties (properties_of pos) Markup.position) (print pos); |
78 (NONE, NONE) => "" |
|
79 | res => " " ^ Markup.markup (Markup.properties (properties_of pos) Markup.position) (print res)); |
71 |
80 |
72 end; |
81 end; |