src/Pure/General/position.ML
author wenzelm
Thu, 04 Jun 2009 17:31:37 +0200
changeset 31424 d30a867a86fb
parent 30669 6de7ef888aa3
child 31435 d24ef3ff34bc
permissions -rw-r--r--
export value;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6118
caa439435666 fixed titles;
wenzelm
parents: 5010
diff changeset
     1
(*  Title:      Pure/General/position.ML
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     2
    Author:     Markus Wenzel, TU Muenchen
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     3
29307
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
     4
Source positions: counting Isabelle symbols, starting from 1.
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     5
*)
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     6
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     7
signature POSITION =
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     8
sig
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
     9
  type T
31424
d30a867a86fb export value;
wenzelm
parents: 30669
diff changeset
    10
  val value: string -> int -> Properties.T
23673
67c748e5ae54 replaced name by file (unquoted);
wenzelm
parents: 23627
diff changeset
    11
  val line_of: T -> int option
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
    12
  val column_of: T -> int option
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    13
  val offset_of: T -> int option
23673
67c748e5ae54 replaced name by file (unquoted);
wenzelm
parents: 23627
diff changeset
    14
  val file_of: T -> string option
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    15
  val advance: Symbol.symbol -> T -> T
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    16
  val distance_of: T -> T -> int
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    17
  val none: T
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    18
  val start: T
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    19
  val file: string -> T
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    20
  val line: int -> T
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    21
  val line_file: int -> string -> T
29307
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
    22
  val id: string -> T
27426
c0ef698c0904 added get_id/put_id;
wenzelm
parents: 26890
diff changeset
    23
  val get_id: T -> string option
c0ef698c0904 added get_id/put_id;
wenzelm
parents: 26890
diff changeset
    24
  val put_id: string -> T -> T
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
    25
  val of_properties: Properties.T -> T
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
    26
  val properties_of: T -> Properties.T
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
    27
  val default_properties: T -> Properties.T -> Properties.T
30669
6de7ef888aa3 added report_text -- status messages with text body;
wenzelm
parents: 29307
diff changeset
    28
  val report_text: Markup.T -> T -> string -> unit
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
    29
  val report: Markup.T -> T -> unit
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
    30
  val str_of: T -> string
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
    31
  type range = T * T
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    32
  val no_range: range
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
    33
  val encode_range: range -> T
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    34
  val reset_range: T -> T
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
    35
  val range: T -> T -> range
25817
d8e0190917a5 type T: based on properties, added id field;
wenzelm
parents: 25792
diff changeset
    36
  val thread_data: unit -> T
d8e0190917a5 type T: based on properties, added id field;
wenzelm
parents: 25792
diff changeset
    37
  val setmp_thread_data: T -> ('a -> 'b) -> 'a -> 'b
25954
682e84b60e5c added setmp_thread_data_seq;
wenzelm
parents: 25817
diff changeset
    38
  val setmp_thread_data_seq: T -> ('a -> 'b Seq.seq) -> 'a -> 'b Seq.seq
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    39
end;
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    40
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    41
structure Position: POSITION =
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    42
struct
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    43
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    44
(* datatype position *)
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    45
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
    46
datatype T = Pos of (int * int * int) * Properties.T;
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    47
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    48
fun valid (i: int) = i > 0;
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    49
fun if_valid i i' = if valid i then i' else i;
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    50
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    51
fun value k i = if valid i then [(k, string_of_int i)] else [];
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    52
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    53
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    54
(* fields *)
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    55
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    56
fun line_of (Pos ((i, _, _), _)) = if valid i then SOME i else NONE;
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    57
fun column_of (Pos ((_, j, _), _)) = if valid j then SOME j else NONE;
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    58
fun offset_of (Pos ((_, _, k), _)) = if valid k then SOME k else NONE;
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    59
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
    60
fun file_of (Pos (_, props)) = Properties.get props Markup.fileN;
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    61
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    62
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    63
(* advance *)
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
    64
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    65
fun advance_count "\n" (i: int, j: int, k: int) =
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    66
      (if_valid i (i + 1), if_valid j 1, if_valid k (k + 1))
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    67
  | advance_count s (i, j, k) =
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    68
      if Symbol.is_regular s andalso not (Symbol.is_utf8_trailer s)
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    69
      then (i, if_valid j (j + 1), if_valid k (k + 1)) else (i, j, k);
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    70
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    71
fun invalid_count (i, j, k) =
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    72
  not (valid i orelse valid j orelse valid k);
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    73
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    74
fun advance sym (pos as (Pos (count, props))) =
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    75
  if invalid_count count then pos else Pos (advance_count sym count, props);
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    76
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    77
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    78
(* distance of adjacent positions *)
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    79
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    80
fun distance_of (Pos ((_, j, k), _)) (Pos ((_, j', k'), _)) =
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    81
  if valid j andalso valid j' then j' - j
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    82
  else if valid k andalso valid k' then k' - k
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    83
  else 0;
26882
9e824d8f4512 renamed Position.path to Path.position;
wenzelm
parents: 26633
diff changeset
    84
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    85
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    86
(* make position *)
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
    87
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    88
val none = Pos ((0, 0, 0), []);
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    89
val start = Pos ((1, 1, 1), []);
27744
d4c5ddf98869 advance: operate on symbol list (less overhead);
wenzelm
parents: 27741
diff changeset
    90
29307
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
    91
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    92
fun file_name "" = []
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    93
  | file_name name = [(Markup.fileN, name)];
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
    94
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    95
fun file name = Pos ((1, 1, 1), file_name name);
27744
d4c5ddf98869 advance: operate on symbol list (less overhead);
wenzelm
parents: 27741
diff changeset
    96
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    97
fun line_file i name = Pos ((i, 0, 0), file_name name);
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
    98
fun line i = line_file i "";
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
    99
23627
f543538866a2 added property conversions;
wenzelm
parents: 22158
diff changeset
   100
29307
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
   101
fun id id = Pos ((0, 0, 1), [(Markup.idN, id)]);
22158
ff4fc4ee9eb0 Add line_of, name_of destructors.
aspinall
parents: 15531
diff changeset
   102
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
   103
fun get_id (Pos (_, props)) = Properties.get props Markup.idN;
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
   104
fun put_id id (Pos (count, props)) = Pos (count, Properties.put (Markup.idN, id) props);
27426
c0ef698c0904 added get_id/put_id;
wenzelm
parents: 26890
diff changeset
   105
29307
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
   106
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
   107
(* markup properties *)
3a0b38b7fbb4 added id;
wenzelm
parents: 28122
diff changeset
   108
25817
d8e0190917a5 type T: based on properties, added id field;
wenzelm
parents: 25792
diff changeset
   109
fun of_properties props =
23627
f543538866a2 added property conversions;
wenzelm
parents: 22158
diff changeset
   110
  let
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   111
    fun get name =
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
   112
      (case Properties.get props name of
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   113
        NONE => 0
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   114
      | SOME s => the_default 0 (Int.fromString s));
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   115
    val count = (get Markup.lineN, get Markup.columnN, get Markup.offsetN);
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   116
    fun property name = the_list (find_first (fn (x: string, _) => x = name) props);
27749
24f2b57a34ea of_properties: observe Markup.position_properties';
wenzelm
parents: 27744
diff changeset
   117
  in Pos (count, maps property Markup.position_properties') end;
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   118
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   119
fun properties_of (Pos ((i, j, k), props)) =
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   120
  value Markup.lineN i @ value Markup.columnN j @ value Markup.offsetN k @ props;
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   121
26052
7d5b3e34a735 added default_properties;
wenzelm
parents: 26003
diff changeset
   122
fun default_properties default props =
7d5b3e34a735 added default_properties;
wenzelm
parents: 26003
diff changeset
   123
  if exists (member (op =) Markup.position_properties o #1) props then props
7d5b3e34a735 added default_properties;
wenzelm
parents: 26003
diff changeset
   124
  else properties_of default @ props;
7d5b3e34a735 added default_properties;
wenzelm
parents: 26003
diff changeset
   125
30669
6de7ef888aa3 added report_text -- status messages with text body;
wenzelm
parents: 29307
diff changeset
   126
fun report_text markup (pos as Pos (count, _)) txt =
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   127
  if invalid_count count then ()
30669
6de7ef888aa3 added report_text -- status messages with text body;
wenzelm
parents: 29307
diff changeset
   128
  else Output.status (Markup.markup (Markup.properties (properties_of pos) markup) txt);
6de7ef888aa3 added report_text -- status messages with text body;
wenzelm
parents: 29307
diff changeset
   129
6de7ef888aa3 added report_text -- status messages with text body;
wenzelm
parents: 29307
diff changeset
   130
fun report markup pos = report_text markup pos "";
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   131
25817
d8e0190917a5 type T: based on properties, added id field;
wenzelm
parents: 25792
diff changeset
   132
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   133
(* str_of *)
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   134
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   135
fun str_of pos =
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   136
  let
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   137
    val props = properties_of pos;
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   138
    val s =
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   139
      (case (line_of pos, file_of pos) of
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   140
        (SOME i, NONE) => "(line " ^ string_of_int i ^ ")"
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   141
      | (SOME i, SOME name) => "(line " ^ string_of_int i ^ " of " ^ quote name ^ ")"
26003
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   142
      | _ => "");
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   143
  in
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   144
    if null props then ""
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   145
    else (if s = "" then "" else " ") ^ Markup.markup (Markup.properties props Markup.position) s
7a8aee8353cf added column field;
wenzelm
parents: 25954
diff changeset
   146
  end;
25817
d8e0190917a5 type T: based on properties, added id field;
wenzelm
parents: 25792
diff changeset
   147
23627
f543538866a2 added property conversions;
wenzelm
parents: 22158
diff changeset
   148
27736
3703dbd0cdea added encode_range;
wenzelm
parents: 27661
diff changeset
   149
(* range *)
3703dbd0cdea added encode_range;
wenzelm
parents: 27661
diff changeset
   150
3703dbd0cdea added encode_range;
wenzelm
parents: 27661
diff changeset
   151
type range = T * T;
3703dbd0cdea added encode_range;
wenzelm
parents: 27661
diff changeset
   152
27796
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
   153
val no_range = (none, none);
a6da5f68e776 added distance_of (permissive version);
wenzelm
parents: 27795
diff changeset
   154
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   155
fun encode_range (Pos (count, props), Pos ((i, j, k), _)) =
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
   156
  let val props' = props |> fold_rev Properties.put
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   157
    (value Markup.end_lineN i @ value Markup.end_columnN j @ value Markup.end_offsetN k)
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   158
  in Pos (count, props') end;
27777
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
   159
7a63d1b50b88 only increment column if valid;
wenzelm
parents: 27764
diff changeset
   160
fun reset_range (Pos (count, props)) =
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27796
diff changeset
   161
  let val props' = props |> fold Properties.remove
27795
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   162
    [Markup.end_lineN, Markup.end_columnN, Markup.end_offsetN]
f67f4c677d81 count offset as well;
wenzelm
parents: 27791
diff changeset
   163
  in Pos (count, props') end;
27736
3703dbd0cdea added encode_range;
wenzelm
parents: 27661
diff changeset
   164
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   165
fun range pos pos' = (encode_range (pos, pos'), pos');
27741
d2523b72ed44 added report;
wenzelm
parents: 27736
diff changeset
   166
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   167
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   168
(* thread data *)
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   169
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   170
local val tag = Universal.tag () : T Universal.tag in
27741
d2523b72ed44 added report;
wenzelm
parents: 27736
diff changeset
   171
28122
3d099ce624e7 Thread.getLocal/setLocal;
wenzelm
parents: 28017
diff changeset
   172
fun thread_data () = the_default none (Thread.getLocal tag);
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   173
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   174
fun setmp_thread_data pos f x =
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   175
  if ! Output.debugging then f x
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   176
  else Library.setmp_thread_data tag (thread_data ()) pos f x;
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   177
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   178
fun setmp_thread_data_seq pos f x =
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   179
  setmp_thread_data pos f x |> Seq.wrap (fn pull => setmp_thread_data pos pull ());
27741
d2523b72ed44 added report;
wenzelm
parents: 27736
diff changeset
   180
5010
9101b70b696d moved Thy/position.ML to General/position.ML;
wenzelm
parents:
diff changeset
   181
end;
27764
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   182
e0ee3cc240fe advance: single argument (again);
wenzelm
parents: 27759
diff changeset
   183
end;