Commit 188f89ad authored by Bruno Guillaume's avatar Bruno Guillaume

remove old lexicon implementation

parent ca3d349c
......@@ -98,7 +98,6 @@ module Ast = struct
| Disequality of feature_value list
| Equal_lex of string * string
| Disequal_lex of string * string
| Equal_param of string (* $ident *)
| Absent
| Else of (feature_value * feature_name * feature_value)
......@@ -108,7 +107,6 @@ module Ast = struct
| Disequality fv_list -> sprintf " <> %s" (String.concat "|" fv_list)
| Equal_lex (lex,fn) -> sprintf " = %s.%s" lex fn
| Disequal_lex (lex,fn) -> sprintf " <> %s.%s" lex fn
| Equal_param param -> sprintf " = $%s" param
| Absent -> " <> *"
| Else (fv1, fn2, fv2) -> sprintf " = %s/%s = %s" fv1 fn2 fv2
......@@ -246,12 +244,10 @@ module Ast = struct
type concat_item =
| Qfn_or_lex_item of pointed
| String_item of string
| Param_item of string
let string_of_concat_item = function
| Qfn_or_lex_item pointed -> sprintf "%s.%s" (fst pointed) (snd pointed)
| String_item s -> sprintf "\"%s\"" s
| Param_item var -> var
type u_command =
| Del_edge_expl of (Id.name * Id.name * edge_label)
......@@ -326,16 +322,10 @@ module Ast = struct
type lexicon_info = (string * lexicon) list
(* the [rule] type is used for 3 kinds of module items:
- rule { param=None; ... }
- lex_rule
*)
type rule = {
rule_id: Id.name;
pattern: pattern;
commands: command list;
param: (string list * string list) option; (* (files, vars) *)
lex_par: string list option; (* lexical parameters in the file *)
lexicon_info: lexicon_info;
rule_doc: string list;
rule_loc: Loc.t;
......
......@@ -62,7 +62,6 @@ module Ast : sig
| Disequality of feature_value list
| Equal_lex of string * string
| Disequal_lex of string * string
| Equal_param of string (* $ident *)
| Absent
| Else of (feature_value * feature_name * feature_value)
......@@ -146,7 +145,6 @@ module Ast : sig
type concat_item =
| Qfn_or_lex_item of (string * string)
| String_item of string
| Param_item of string
type u_command =
| Del_edge_expl of (Id.name * Id.name * edge_label)
......@@ -180,8 +178,6 @@ module Ast : sig
rule_id:Id.name;
pattern: pattern;
commands: command list;
param: (string list * string list) option; (* (files, vars) *)
lex_par: string list option; (* lexical parameters in the file *)
lexicon_info: lexicon_info;
rule_doc:string list;
rule_loc: Loc.t;
......
......@@ -33,7 +33,6 @@ module Command = struct
| Feat of (command_node * string)
| String of string
| Lexical_field of (string * string)
| Param of int
let item_to_json = function
| Feat (cn, feature_name) -> `Assoc [("copy_feat",
......@@ -44,7 +43,6 @@ module Command = struct
)]
| String s -> `Assoc [("string", `String s)]
| Lexical_field (lex,field) -> `Assoc [("lexical_filed", `String (lex ^ "." ^ field))]
| Param i -> `Assoc [("param", `Int i)]
(* the command in pattern *)
type p =
......@@ -153,7 +151,7 @@ module Command = struct
]
)]
let build ?domain ?param lexicons (kni, kei) table ast_command =
let build ?domain lexicons (kni, kei) table ast_command =
(* kni stands for "known node idents", kei for "known edge idents" *)
let cn_of_node_id node_id =
......@@ -256,18 +254,10 @@ module Command = struct
Feat (cn_of_node_id node_id_or_lex, feature_name_or_lex_field)
end
| Ast.String_item s -> String s
| Ast.Param_item var ->
match param with
| None -> Error.build ~loc "Unknown command variable '%s'" var
| Some par ->
match List_.index var par with
| Some index -> Param index
| _ -> Error.build ~loc "Unknown command variable '%s'" var
) ast_items in
(* check for consistency *)
(match items with
| _ when Domain.is_open_feature ?domain feat_name -> ()
| [Param _] -> () (* TODO: check that lexical parameters are compatible with the feature domain *)
| [String s] -> Domain.check_feature ~loc ?domain feat_name s
| [Feat (_,fn)] -> ()
| _ -> Error.build ~loc "[Update_feat] Only open features can be modified with the concat operator '+' but \"%s\" is not declared as an open feature" feat_name);
......
......@@ -24,7 +24,6 @@ module Command : sig
| Feat of (command_node * string)
| String of string
| Lexical_field of (string * string)
| Param of int
type p =
| DEL_NODE of command_node
......@@ -49,7 +48,6 @@ module Command : sig
val build:
?domain: Domain.t ->
?param: string list ->
Lexicons.t ->
(Id.name list * string list) ->
Id.table ->
......
This diff is collapsed.
......@@ -76,11 +76,11 @@ module P_fs: sig
val empty: t
val build: ?domain:Domain.t -> ?pat_vars: string list -> Lexicons.t -> Ast.feature list -> t
val build: ?domain:Domain.t -> Lexicons.t -> Ast.feature list -> t
val to_string: t -> string
val to_dep: ?filter: (string -> bool) -> string list -> t -> string
val to_dep: ?filter: (string -> bool) -> t -> string
val to_dot: t -> string
......@@ -93,7 +93,7 @@ module P_fs: sig
(** [check_position ?parma position pfs] checks wheter [pfs] is compatible with a node at [position].
It returns [true] iff [pfs] has no requirement about position ok if the requirement is satisfied. *)
val check_position: ?param:Lex_par.t -> float option -> t -> bool
val check_position: float option -> t -> bool
exception Fail_unif
......
......@@ -62,15 +62,15 @@ module P_graph = struct
| Some new_node -> Some (Pid_map.add id_src new_node map)
(* -------------------------------------------------------------------------------- *)
let build ?domain ?pat_vars lexicons (full_node_list : Ast.node list) full_edge_list =
let build ?domain lexicons (full_node_list : Ast.node list) full_edge_list =
(* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
(* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
let rec insert (ast_node, loc) = function
| [] -> [P_node.build ?domain ?pat_vars lexicons (ast_node, loc)]
| [] -> [P_node.build ?domain lexicons (ast_node, loc)]
| (node_id,fs)::tail when ast_node.Ast.node_id = node_id ->
begin
try (node_id, P_node.unif_fs (P_fs.build ?domain ?pat_vars lexicons ast_node.Ast.fs) fs) :: tail
try (node_id, P_node.unif_fs (P_fs.build ?domain lexicons ast_node.Ast.fs) fs) :: tail
with Error.Build (msg,_) -> raise (Error.Build (msg,Some loc))
end
| head :: tail -> head :: (insert (ast_node, loc) tail) in
......@@ -117,9 +117,9 @@ module P_graph = struct
(* -------------------------------------------------------------------------------- *)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
let build_extension ?domain ?pat_vars lexicons pos_table full_node_list full_edge_list =
let build_extension ?domain lexicons pos_table full_node_list full_edge_list =
let built_nodes = List.map (P_node.build ?domain ?pat_vars lexicons) full_node_list in
let built_nodes = List.map (P_node.build ?domain lexicons) full_node_list in
let (old_nodes, new_nodes) =
List.partition
......
......@@ -65,7 +65,6 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build:
?domain:Domain.t ->
?pat_vars: string list ->
Lexicons.t ->
Ast.node list ->
Ast.edge list ->
......@@ -74,7 +73,6 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build_extension:
?domain:Domain.t ->
?pat_vars: string list ->
Lexicons.t ->
Id.table ->
Ast.node list ->
......
......@@ -98,7 +98,7 @@ and string_lex re target = parse
string_lex re target lexbuf
}
(* a dedicated lexer for lexical parameter: read everything until "#END" *)
(* a dedicated lexer for local lexicons: read everything until "#END" *)
and lp_lex name target = parse
| '\n' { (match Global.get_line () with
| None -> raise (Error "no loc in lexer")
......
......@@ -159,11 +159,11 @@ module P_node = struct
let empty = { fs = P_fs.empty; next = Massoc_pid.empty; name = ""; loc=None }
let build ?domain ?pat_vars lexicons (ast_node, loc) =
let build ?domain lexicons (ast_node, loc) =
(ast_node.Ast.node_id,
{
name = ast_node.Ast.node_id;
fs = P_fs.build ?domain ?pat_vars lexicons ast_node.Ast.fs;
fs = P_fs.build ?domain lexicons ast_node.Ast.fs;
next = Massoc_pid.empty;
loc = Some loc;
} )
......@@ -175,7 +175,6 @@ module P_node = struct
let match_ ?lexicons p_node g_node =
(* (match param with None -> printf "<None>" | Some p -> printf "<Some>"; Lex_par.dump p); *)
match G_node.get_position g_node with
| G_node.Unordered _ -> raise P_fs.Fail (* TOOO: check this return !! *)
| G_node.Ordered p ->
......
......@@ -102,7 +102,7 @@ module P_node: sig
It raises [P_fs.Fail_unif] exception in case of Failure. *)
val unif_fs: P_fs.t -> t -> t
val build: ?domain:Domain.t -> ?pat_vars: string list -> Lexicons.t -> Ast.node -> (Id.name * t)
val build: ?domain:Domain.t -> Lexicons.t -> Ast.node -> (Id.name * t)
val add_edge: P_edge.t -> Pid.t -> t -> t option
......
......@@ -288,8 +288,6 @@ rule:
{ Ast.rule_id = fst id_loc;
pattern = Ast.complete_pattern { Ast.pat_pos = p; Ast.pat_negs = n };
commands = cmds;
param = None;
lex_par = None;
lexicon_info = lexicons;
rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = snd id_loc;
......
This diff is collapsed.
......@@ -64,7 +64,7 @@ module Rule : sig
val node_matching: pattern -> G_graph.t -> matching -> (string * float) list
(** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
val match_in_graph: ?domain:Domain.t -> ?lexicons: Lexicons.t -> ?param:Lex_par.t -> pattern -> G_graph.t -> matching list
val match_in_graph: ?domain:Domain.t -> ?lexicons: Lexicons.t -> pattern -> G_graph.t -> matching list
(** [match_deco rule matching] builds the decoration of the [graph] illustrating the given [matching] of the [rule] *)
(* NB: it can be computed independly from the graph itself! *)
......
......@@ -93,68 +93,6 @@ module Massoc_pid = Massoc_make (Pid)
module Massoc_string = Massoc_make (String)
(* ================================================================================ *)
(* This module defines a type for lexical parameter (i.e. one line in a lexical file) *)
module Lex_par = struct
type item = string list
let item_to_string l = String.concat "#" l
type t = item list
let to_json t =
`List (List.map (fun item -> `String (item_to_string item)) t)
let size = List.length
let append = List.append
let signature = function
| [] -> Error.bug "[Lex_par.signature] empty data"
| v -> List.length v
let dump t =
printf "[Lex_par.dump] --> size = %d\n" (List.length t);
List.iter (fun il -> printf "%s\n" (String.concat "#" il)) t
let parse_line ?loc nb_var line =
let line = String_.rm_peripheral_white line in
if line = "" || line.[0] = '%'
then None
else
let line = Str.global_replace (Str.regexp "\\\\%") "%" line in
match Str.split (Str.regexp "##\\|#") line with
| args when List.length args = nb_var -> Some args
| args -> Error.build ?loc "Wrong param number: '%d instead of %d'" (List.length args) nb_var
let from_lines ?loc nb_var lines =
match List_.opt_map (parse_line ?loc nb_var) lines with
| [] -> Error.build ?loc "Empty lexical parameter list"
| l -> l
let load ?loc dir nb_var file =
try
let full_file =
if Filename.is_relative file
then Filename.concat dir file
else file in
let lines = File.read full_file in
match List_.opt_mapi (fun i line -> parse_line ~loc:(Loc.file_line full_file i) nb_var line) lines with
| [] -> Error.build ?loc "Empty lexical parameter file '%s'" file
| l -> l
with Sys_error _ -> Error.build ?loc "External lexical file '%s' not found" file
let select index atom t = List.filter (fun par -> List.nth par index = atom) t
let get_param_value index = function
| [] -> Error.bug "[Lex_par.get_param_value] empty parameter"
| params::_ -> List.nth params index
let get_command_value index = function
| [] -> Error.bug "[Lex_par.get_command_value] empty parameter"
| [one] -> List.nth one index
| _ -> Error.run "Lexical parameter are not functional"
end (* module Lex_par *)
(* ================================================================================ *)
module Lexicon = struct
......
......@@ -66,44 +66,6 @@ module Massoc_pid : S with type key = Pid.t
(* ================================================================================ *)
module Massoc_string : S with type key = string
(* ================================================================================ *)
(** module for rules that are lexically parametrized *)
module Lex_par: sig
type item = string list
type t = item list
val to_json: t -> Yojson.Basic.json
val append: t -> t -> t
val dump: t -> unit
val size: t -> int
(** [signature t] returns number of parameters *)
val signature: t -> int
(** [from_lines filename nb_var strings] *)
val from_lines: ?loc: Loc.t -> int -> string list -> t
(** [load ?loc local_dir_name nb_var file] *)
val load: ?loc: Loc.t -> string -> int -> string -> t
(** [select index atom t] returns the subset of [t] which contains only entries
which refers to [atom] at the [index]^th pattern_var.
[None] is returned if no such entry s founded.
*)
val select: int -> string -> t -> t
(** [get_param_value index t] returns the [index]^th param_var. *)
val get_param_value: int -> t -> string
(** [get_command_value index t] supposes that [t] contains iny one element.
It returns the [index]^th command_var. *)
val get_command_value: int -> t -> string
end (* module Lex_par *)
(* ================================================================================ *)
module Lexicon : sig
type t
......
......@@ -143,10 +143,10 @@ module Rewrite: sig
val set_debug_loop: unit -> unit
(** [display gr grs seq] builds the [display] (datatype used by the GUI) given by
the rewriting of graph [gr] with the sequence [seq] of [grs].
@param gr the grapth to rewrite
the rewriting of graph [gr] with the strategy [strat] of [grs].
@param gr the graph to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply *)
@param strat the name of the strategy to apply *)
val display: gr:Graph.t -> grs:Grs.t -> strat:string -> display
val at_least_one: grs:Grs.t -> strat:string -> bool
......
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