26 val names: context -> string -> 'a list -> (string * 'a) list |
26 val names: context -> string -> 'a list -> (string * 'a) list |
27 val invent_list: string list -> string -> int -> string list |
27 val invent_list: string list -> string -> int -> string list |
28 val variants: string list -> context -> string list * context |
28 val variants: string list -> context -> string list * context |
29 val variant_list: string list -> string list -> string list |
29 val variant_list: string list -> string list -> string list |
30 val variant: string list -> string -> string |
30 val variant: string list -> string -> string |
31 type binding |
31 |
32 val binding_pos: string * Position.T -> binding |
32 include NAME_BINDING |
33 val binding: string -> binding |
|
34 val no_binding: binding |
|
35 val prefix_of: binding -> (string * bool) list |
|
36 val name_of: binding -> string |
|
37 val name_with_prefix: binding -> string (*FIXME*) |
|
38 val is_nothing: binding -> bool |
|
39 val pos_of: binding -> Position.T |
|
40 val add_prefix: bool -> string -> binding -> binding |
33 val add_prefix: bool -> string -> binding -> binding |
41 val map_prefix: ((string * bool) list -> binding -> binding) -> binding -> binding |
34 val map_prefix: ((string * bool) list -> binding -> binding) -> binding -> binding |
42 val map_name: (string -> string) -> binding -> binding |
35 val name_of: binding -> string (*FIMXE legacy*) |
43 val qualified: string -> binding -> binding |
36 val map_name: (string -> string) -> binding -> binding (*FIMXE legacy*) |
44 val namify: NameSpace.naming -> binding -> NameSpace.naming * string |
37 val qualified: string -> binding -> binding (*FIMXE legacy*) |
45 val output: binding -> string |
38 val display: binding -> string |
|
39 val namify: NameSpace.naming -> binding -> NameSpace.naming * string (*FIMXE legacy*) |
46 end; |
40 end; |
47 |
41 |
48 structure Name: NAME = |
42 structure Name: NAME = |
49 struct |
43 struct |
|
44 |
|
45 open NameSpace; |
50 |
46 |
51 (** common defaults **) |
47 (** common defaults **) |
52 |
48 |
53 val uu = "uu"; |
49 val uu = "uu"; |
54 val aT = "'a"; |
50 val aT = "'a"; |
153 |
149 |
154 fun variant_list used names = #1 (make_context used |> variants names); |
150 fun variant_list used names = #1 (make_context used |> variants names); |
155 fun variant used = singleton (variant_list used); |
151 fun variant used = singleton (variant_list used); |
156 |
152 |
157 |
153 |
158 |
|
159 (** generic name bindings **) |
154 (** generic name bindings **) |
160 |
155 |
161 datatype binding = Binding of ((string * bool) list * string) * Position.T; |
156 fun add_prefix sticky prfx b = if prfx = "" then error "empty name prefix" |
|
157 else (map_binding o apfst) (cons (prfx, sticky)) b; |
162 |
158 |
163 fun prefix_of (Binding ((prefix, _), _)) = prefix; |
159 val prefix_of = fst o dest_binding; |
164 fun name_of (Binding ((_, name), _)) = name; |
160 val name_of = snd o dest_binding; |
165 fun pos_of (Binding (_, pos)) = pos; |
161 val map_name = map_binding o apsnd; |
166 |
|
167 fun binding_pos (name, pos) = Binding (([], name), pos); |
|
168 fun binding name = binding_pos (name, Position.none); |
|
169 val no_binding = binding ""; |
|
170 |
|
171 fun map_binding f (Binding bnd) = Binding (f bnd); |
|
172 |
|
173 fun add_prefix sticky prfx binding = if prfx = "" then error "empty name prefix" |
|
174 else (map_binding o apfst o apfst) (cons (prfx, sticky)) binding; |
|
175 |
|
176 fun map_prefix f (Binding ((prefix, name), pos)) = |
|
177 f prefix (binding_pos (name, pos)); |
|
178 |
|
179 val map_name = map_binding o apfst o apsnd; |
|
180 val qualified = map_name o NameSpace.qualified; |
162 val qualified = map_name o NameSpace.qualified; |
181 |
163 |
182 fun is_nothing (Binding ((_, name), _)) = name = ""; |
164 fun map_prefix f b = |
|
165 let |
|
166 val (prefix, name) = dest_binding b; |
|
167 val pos = pos_of b; |
|
168 in f prefix (binding_pos (name, pos)) end; |
183 |
169 |
184 fun name_with_prefix (Binding ((prefix, name), _)) = |
170 fun namify naming b = |
185 NameSpace.implode (map_filter |
171 let |
186 (fn (prfx, sticky) => if sticky then SOME prfx else NONE) prefix @ [name]); |
172 val (prefix, name) = dest_binding b |
|
173 fun mk_prefix (prfx, true) = sticky_prefix prfx |
|
174 | mk_prefix (prfx, false) = add_path prfx; |
|
175 val naming' = fold mk_prefix prefix naming; |
|
176 in (naming', full naming' name) end; |
187 |
177 |
188 fun namify naming (Binding ((prefix, name), _)) = |
178 fun display b = |
189 let |
179 let |
190 fun mk_prefix (prfx, true) = NameSpace.sticky_prefix prfx |
180 val (prefix, name) = dest_binding b |
191 | mk_prefix (prfx, false) = NameSpace.add_path prfx; |
181 fun mk_prefix (prfx, true) = prfx |
192 val naming' = fold mk_prefix prefix naming; |
182 | mk_prefix (prfx, false) = enclose "(" ")" prfx |
193 in (naming', NameSpace.full naming' name) end; |
183 in if not (! NameSpace.long_names) orelse null prefix orelse name = "" then name |
194 |
184 else NameSpace.implode (map mk_prefix prefix) ^ ":" ^ name |
195 fun output (Binding ((prefix, name), _)) = |
185 end; |
196 if null prefix orelse name = "" then name |
|
197 else NameSpace.implode (map fst prefix) ^ " / " ^ name; |
|
198 |
186 |
199 end; |
187 end; |