Commit c9d76f0f authored by Andrei Paskevich's avatar Andrei Paskevich

Env: allow to reassign extensions to newer formats

parent 2b086611
......@@ -22,8 +22,6 @@ exception KnownFormat of fformat
exception UnknownFormat of fformat
exception InvalidFormat of fformat
exception UnspecifiedFormat
exception KnownExtension of extension * fformat
exception UnknownExtension of extension
exception LibraryNotFound of pathname
......@@ -118,18 +116,20 @@ let register_language parent convert = {
let extension_table = ref Mstr.empty
let register_format ~desc lang ff extl fp =
let add_ext m e = Mstr.change (function
| Some ff -> raise (KnownExtension (e,ff))
| None -> Some ff) e m in
extension_table := List.fold_left add_ext !extension_table extl;
let fp env path fn ch = store lang path (fp env path fn ch) in
register_format lang (ff,extl,desc) fp
register_format lang (ff,extl,desc) fp;
let add_ext m e = Mstr.add e ff m in
extension_table := List.fold_left add_ext !extension_table extl
let add_builtin lang bp =
let bp path = store lang ("why3" :: path) (bp path) in
add_builtin lang bp
let list_formats lang = List.rev lang.info (* older to newer *)
let list_formats lang =
let filter_ext (ff,extl,desc) =
let filt e = Mstr.find e !extension_table = ff in
ff, List.filter filt extl, desc in
List.rev_map filter_ext lang.info
(** Input file parsing *)
......@@ -267,8 +267,6 @@ let () = Exn_printer.register
"Unknown input format: %s" s
| UnknownExtension s -> Format.fprintf fmt
"Unknown file extension: `%s'" s
| KnownExtension (s,f) -> Format.fprintf fmt
"File extension `%s' is already registered for input format %s" s f
| UnspecifiedFormat -> Format.fprintf fmt
"Format not specified"
| AmbiguousPath (f1,f2) -> Format.fprintf fmt
......
......@@ -79,18 +79,16 @@ type 'a format_parser = env -> pathname -> filename -> in_channel -> 'a
to be used in error messages. *)
exception KnownFormat of fformat
exception KnownExtension of extension * fformat
val register_format :
desc:Pp.formatted ->
'a language -> fformat -> extension list -> 'a format_parser -> unit
(** [register_format ~desc lang fname exts parser] registers a new format
[fname] for files with extensions from the string list [exts] (without
the separating dot).
the separating dot). Any previous associations of extensions from [exts]
to other formats are overridden.
@raise KnownFormat [name] if the format is already registered
@raise KnownExtension [ext,name] if a parser for [ext] is already
registered for format [name] *)
@raise KnownFormat [name] if the format is already registered *)
val list_formats :
'a language -> (fformat * extension list * Pp.formatted) list
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment