src/Pure/General/position.ML
changeset 25817 d8e0190917a5
parent 25792 c7125b591885
child 25954 682e84b60e5c
equal deleted inserted replaced
25816:d2a94e6a7d1e 25817:d8e0190917a5
    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;