author | paulson |
Thu, 05 Sep 2002 14:03:03 +0200 | |
changeset 13559 | 51c3ac47d127 |
parent 12904 | c208d71702d1 |
child 13730 | 09aeb7346d3f |
permissions | -rw-r--r-- |
6118 | 1 |
(* Title: Pure/General/symbol.ML |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
2 |
ID: $Id$ |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
3 |
Author: Markus Wenzel, TU Muenchen |
8806 | 4 |
License: GPL (GNU GENERAL PUBLIC LICENSE) |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
5 |
|
12116 | 6 |
Generalized characters with infinitely many named symbols. |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
7 |
*) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
8 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
9 |
signature SYMBOL = |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
10 |
sig |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
11 |
type symbol |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
12 |
val space: symbol |
10953 | 13 |
val spaces: int -> symbol |
6857 | 14 |
val sync: symbol |
15 |
val is_sync: symbol -> bool |
|
16 |
val not_sync: symbol -> bool |
|
10747 | 17 |
val malformed: symbol |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
18 |
val eof: symbol |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
19 |
val is_eof: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
20 |
val not_eof: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
21 |
val stopper: symbol * (symbol -> bool) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
22 |
val is_ascii: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
23 |
val is_letter: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
24 |
val is_digit: symbol -> bool |
12904 | 25 |
val is_quasi: symbol -> bool |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
26 |
val is_quasi_letter: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
27 |
val is_letdig: symbol -> bool |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
28 |
val is_blank: symbol -> bool |
13559
51c3ac47d127
added checking so that (rename_tac "x y") is rejected, since
paulson
parents:
12904
diff
changeset
|
29 |
val is_identifier: symbol -> bool |
8230 | 30 |
val is_symbolic: symbol -> bool |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
31 |
val is_printable: symbol -> bool |
6272 | 32 |
val length: symbol list -> int |
11010 | 33 |
val strip_blanks: string -> string |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
34 |
val beginning: symbol list -> string |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
35 |
val scan: string list -> symbol * string list |
6640 | 36 |
val scanner: string -> (symbol list -> 'a * symbol list) -> symbol list -> 'a |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
37 |
val source: bool -> (string, 'a) Source.source -> |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
38 |
(symbol, (string, 'a) Source.source) Source.source |
6272 | 39 |
val explode: string -> symbol list |
12904 | 40 |
val bump_string: string -> string |
10953 | 41 |
val default_indent: string * int -> string |
42 |
val add_mode: string -> (string -> string * real) * (string * int -> string) -> unit |
|
6692 | 43 |
val symbolsN: string |
44 |
val xsymbolsN: string |
|
10923 | 45 |
val plain_output: string -> string |
6272 | 46 |
val output: string -> string |
47 |
val output_width: string -> string * real |
|
10953 | 48 |
val indent: string * int -> string |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
49 |
end; |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
50 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
51 |
structure Symbol: SYMBOL = |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
52 |
struct |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
53 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
54 |
|
6272 | 55 |
(** generalized characters **) |
56 |
||
57 |
(*symbols, which are considered the smallest entities of any Isabelle |
|
58 |
string, may be of the following form: |
|
59 |
(a) ASCII symbols: a |
|
60 |
(b) printable symbols: \<ident> |
|
61 |
(c) control symbols: \<^ident> |
|
62 |
||
12116 | 63 |
output is subject to the print_mode variable (default: verbatim), |
64 |
actual interpretation in display is up to front-end tools; |
|
6272 | 65 |
*) |
66 |
||
67 |
type symbol = string; |
|
68 |
||
69 |
val space = " "; |
|
10953 | 70 |
fun spaces k = Library.replicate_string k space; |
6857 | 71 |
val sync = "\\<^sync>"; |
10747 | 72 |
val malformed = "\\<^malformed>"; |
6272 | 73 |
val eof = ""; |
74 |
||
75 |
||
76 |
(* kinds *) |
|
77 |
||
6857 | 78 |
fun is_sync s = s = sync; |
79 |
fun not_sync s = s <> sync; |
|
80 |
||
6272 | 81 |
fun is_eof s = s = eof; |
82 |
fun not_eof s = s <> eof; |
|
83 |
val stopper = (eof, is_eof); |
|
84 |
||
85 |
fun is_ascii s = size s = 1 andalso ord s < 128; |
|
86 |
||
87 |
fun is_letter s = |
|
88 |
size s = 1 andalso |
|
89 |
(ord "A" <= ord s andalso ord s <= ord "Z" orelse |
|
90 |
ord "a" <= ord s andalso ord s <= ord "z"); |
|
91 |
||
92 |
fun is_digit s = |
|
93 |
size s = 1 andalso ord "0" <= ord s andalso ord s <= ord "9"; |
|
94 |
||
12904 | 95 |
fun is_quasi "_" = true |
96 |
| is_quasi "'" = true |
|
97 |
| is_quasi _ = false; |
|
98 |
||
99 |
fun is_quasi_letter s = is_quasi s orelse is_letter s; |
|
6272 | 100 |
|
101 |
val is_blank = |
|
102 |
fn " " => true | "\t" => true | "\n" => true | "\^L" => true |
|
103 |
| "\160" => true | "\\<spacespace>" => true |
|
104 |
| _ => false; |
|
105 |
||
12904 | 106 |
fun is_letdig s = is_quasi_letter s orelse is_digit s; |
6272 | 107 |
|
8230 | 108 |
fun is_symbolic s = |
109 |
size s > 2 andalso nth_elem_string (2, s) <> "^"; |
|
110 |
||
6272 | 111 |
fun is_printable s = |
112 |
size s = 1 andalso ord space <= ord s andalso ord s <= ord "~" orelse |
|
8230 | 113 |
is_symbolic s; |
114 |
||
13559
51c3ac47d127
added checking so that (rename_tac "x y") is rejected, since
paulson
parents:
12904
diff
changeset
|
115 |
fun is_identifier s = |
51c3ac47d127
added checking so that (rename_tac "x y") is rejected, since
paulson
parents:
12904
diff
changeset
|
116 |
case (explode s) of |
51c3ac47d127
added checking so that (rename_tac "x y") is rejected, since
paulson
parents:
12904
diff
changeset
|
117 |
[] => false |
51c3ac47d127
added checking so that (rename_tac "x y") is rejected, since
paulson
parents:
12904
diff
changeset
|
118 |
| c::cs => is_letter c andalso forall is_letdig cs; |
6272 | 119 |
|
10738 | 120 |
fun sym_length ss = foldl (fn (n, s) => |
121 |
(if not (is_printable s) then 0 else |
|
122 |
(case Library.try String.substring (s, 2, 4) of |
|
123 |
Some s' => if s' = "long" orelse s' = "Long" then 2 else 1 |
|
124 |
| None => 1)) + n) (0, ss); |
|
6272 | 125 |
|
11010 | 126 |
fun strip_blanks s = |
127 |
implode (#1 (Library.take_suffix is_blank (#2 (Library.take_prefix is_blank (explode s))))); |
|
128 |
||
6272 | 129 |
|
130 |
(* beginning *) |
|
131 |
||
132 |
val smash_blanks = map (fn s => if is_blank s then space else s); |
|
133 |
||
134 |
fun beginning raw_ss = |
|
135 |
let |
|
136 |
val (all_ss, _) = take_suffix is_blank raw_ss; |
|
137 |
val dots = if length all_ss > 10 then " ..." else ""; |
|
138 |
val (ss, _) = take_suffix is_blank (take (10, all_ss)); |
|
139 |
in implode (smash_blanks ss) ^ dots end; |
|
140 |
||
141 |
||
142 |
||
8998 | 143 |
(** scanning through symbols **) |
6640 | 144 |
|
145 |
fun scanner msg scan chs = |
|
146 |
let |
|
147 |
fun err_msg cs = msg ^ ": " ^ beginning cs; |
|
148 |
val fin_scan = Scan.error (Scan.finite stopper (!! (fn (cs, _) => err_msg cs) scan)); |
|
149 |
in |
|
150 |
(case fin_scan chs of |
|
151 |
(result, []) => result |
|
152 |
| (_, rest) => error (err_msg rest)) |
|
153 |
end; |
|
154 |
||
155 |
||
156 |
||
6272 | 157 |
(** symbol input **) |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
158 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
159 |
(* scan *) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
160 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
161 |
val scan_id = Scan.one is_letter ^^ (Scan.any is_letdig >> implode); |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
162 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
163 |
val scan = |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
164 |
($$ "\\" --| Scan.optional ($$ "\\") "") ^^ $$ "<" ^^ |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
165 |
!! (fn (cs, _) => "Malformed symbolic character specification: \\" ^ "<" ^ beginning cs) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
166 |
(Scan.optional ($$ "^") "" ^^ scan_id ^^ $$ ">") || |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
167 |
Scan.one not_eof; |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
168 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
169 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
170 |
(* source *) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
171 |
|
10747 | 172 |
val recover = Scan.any ((not o is_blank) andf not_eof) >> K [malformed]; |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
173 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
174 |
fun source do_recover src = |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
175 |
Source.source stopper (Scan.bulk scan) (if do_recover then Some recover else None) src; |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
176 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
177 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
178 |
(* explode *) |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
179 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
180 |
fun no_syms [] = true |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
181 |
| no_syms ("\\" :: "<" :: _) = false |
12116 | 182 |
| no_syms (_ :: cs) = no_syms cs; |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
183 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
184 |
fun sym_explode str = |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
185 |
let val chs = explode str in |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
186 |
if no_syms chs then chs (*tune trivial case*) |
12116 | 187 |
else the (Scan.read stopper (Scan.repeat scan) chs) |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
188 |
end; |
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
189 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
190 |
|
12904 | 191 |
(* bump_string -- increment suffix of lowercase letters like a base 26 number *) |
192 |
||
193 |
fun bump_string str = |
|
194 |
let |
|
195 |
fun bump [] = ["a"] |
|
196 |
| bump ("z" :: ss) = "a" :: bump ss |
|
197 |
| bump (s :: ss) = |
|
198 |
if size s = 1 andalso ord "a" <= ord s andalso ord s < ord "z" |
|
199 |
then chr (ord s + 1) :: ss |
|
200 |
else "a" :: s :: ss; |
|
201 |
val (cs, qs) = Library.take_suffix is_quasi (sym_explode str); |
|
202 |
in implode (rev (bump (rev cs)) @ qs) end; |
|
203 |
||
6272 | 204 |
|
205 |
(** symbol output **) |
|
206 |
||
10953 | 207 |
(* default *) |
6272 | 208 |
|
209 |
fun string_size s = (s, real (size s)); |
|
210 |
||
211 |
fun default_output s = |
|
6320 | 212 |
if not (exists_string (equal "\\") s) then string_size s |
10738 | 213 |
else string_size (implode (map (fn "\\" => "\\\\" | c => c) (explode s))); (*sic!*) |
6272 | 214 |
|
10953 | 215 |
fun default_indent (_: string, k) = spaces k; |
6272 | 216 |
|
10953 | 217 |
|
6272 | 218 |
(* maintain modes *) |
219 |
||
6692 | 220 |
val symbolsN = "symbols"; |
221 |
val xsymbolsN = "xsymbols"; |
|
222 |
||
12116 | 223 |
val modes = |
224 |
ref (Symtab.empty: ((string -> string * real) * (string * int -> string)) Symtab.table); |
|
6272 | 225 |
|
226 |
fun lookup_mode name = Symtab.lookup (! modes, name); |
|
227 |
||
10953 | 228 |
fun add_mode name m = |
6272 | 229 |
(if is_none (lookup_mode name) then () |
6320 | 230 |
else warning ("Redeclaration of symbol print mode " ^ quote name); |
10953 | 231 |
modes := Symtab.update ((name, m), ! modes)); |
232 |
||
233 |
fun get_mode () = |
|
234 |
if_none (get_first lookup_mode (! print_mode)) (default_output, default_indent); |
|
6272 | 235 |
|
236 |
||
237 |
(* mode output *) |
|
238 |
||
10953 | 239 |
fun output_width x = #1 (get_mode ()) x; |
6272 | 240 |
val output = #1 o output_width; |
10923 | 241 |
val plain_output = #1 o default_output; |
6272 | 242 |
|
10953 | 243 |
fun indent x = #2 (get_mode ()) x; |
244 |
||
6272 | 245 |
|
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
246 |
(*final declarations of this structure!*) |
6272 | 247 |
val length = sym_length; |
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
248 |
val explode = sym_explode; |
6272 | 249 |
|
6116
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
250 |
|
8ba2f25610f7
files scan.ML, source.ML, symbol.ML, pretty.ML moved to Pure/General;
wenzelm
parents:
diff
changeset
|
251 |
end; |