Commit a9d46186 authored by Bruno Guillaume's avatar Bruno Guillaume

add syntax : f=v/g=u

parent 252ba4aa
......@@ -94,6 +94,7 @@ module Ast = struct
| Disequality of feature_value list
| Equal_param of string (* $ident *)
| Absent
| Else of (feature_value * feature_name * feature_value)
let feature_kind_to_string = function
| Equality fv_list -> sprintf " = %s" (String.concat "|" fv_list)
......@@ -101,6 +102,7 @@ module Ast = struct
| Disequality fv_list -> sprintf " <> %s" (String.concat "|" fv_list)
| Equal_param param -> sprintf " = $%s" param
| Absent -> " <> *"
| Else (fv1, fn2, fv2) -> sprintf " = %s/%s = %s" fv1 fn2 fv2
type u_feature = {
name: feature_name;
......
......@@ -58,6 +58,7 @@ module Ast : sig
| Disequality of feature_value list
| Equal_param of string (* $ident *)
| Absent
| Else of (feature_value * feature_name * feature_value)
type u_feature = {
name: feature_name;
......
......@@ -78,6 +78,7 @@ module P_feature = struct
| Absent
| Equal of value list (* with Equal constr, the list MUST never be empty *)
| Different of value list
| Else of (value * feature_name * value)
(* NB: in the current version, |in_param| ≤ 1 *)
type v = {
......@@ -94,7 +95,9 @@ module P_feature = struct
| Different [] -> "=*"
| Different l -> "≠" ^ (String.concat "|" (List.map string_of_value l))
| Equal l -> "=" ^ (String.concat "|" (List.map string_of_value l))
| Absent -> " must be Absent!");
| Absent -> " must be Absent!"
| Else (fv1,fn2,fv2) -> sprintf " = %s/%s = %s" (string_of_value fv1) fn2 (string_of_value fv2));
printf "in_param=[%s]\n" (String.concat "," (List.map string_of_int in_param));
printf "%!"
......@@ -105,6 +108,8 @@ module P_feature = struct
| Absent -> ("absent", `Null)
| Equal val_list -> ("equal", `List (List.map (fun x -> `String (string_of_value x)) val_list))
| Different val_list -> ("different", `List (List.map (fun x -> `String (string_of_value x)) val_list))
| Else (fv1,fn2,fv2) -> ("else", `List [`String (string_of_value fv1); `String fn2; `String (string_of_value fv2)]);
)
]
......@@ -164,6 +169,10 @@ module P_feature = struct
let values = Feature_value.build_disj ~loc ?domain name unsorted_values in (name, {cst=Equal values;in_param=[];})
| ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) ->
let values = Feature_value.build_disj ~loc ?domain name unsorted_values in (name, {cst=Different values;in_param=[];})
| ({Ast.kind=Ast.Else (fv1,fn2,fv2); name=name}, loc) ->
let v1 = match Feature_value.build_disj ~loc ?domain name [fv1] with [one] -> one | _ -> failwith "BUG Else" in
let v2 = match Feature_value.build_disj ~loc ?domain name [fv2] with [one] -> one | _ -> failwith "BUG Else" in
(name, {cst=Else (v1,fn2,v2);in_param=[];})
| ({Ast.kind=Ast.Equal_param var; name=name}, loc) ->
begin
match pat_vars with
......@@ -438,7 +447,19 @@ module P_fs = struct
| ((fn_pat, {P_feature.cst=P_feature.Absent})::t_pat, []) -> loop acc (t_pat, [])
| ((fn_pat, {P_feature.cst=P_feature.Absent})::t_pat, (fn, fa)::t) when fn_pat < fn -> loop acc (t_pat, (fn, fa)::t)
(* Two next cases: each feature_name present in p_fs must be in instance: [] means unif failure *)
(* look for the second part of an Else construction*)
| ((_, {P_feature.cst=P_feature.Else (_,fn2,fv2)})::t_pat,[]) ->
begin
try if (List.assoc fn2 g_fs) <> fv2 then raise Fail
with Not_found -> raise Fail
end; loop acc (t_pat, [])
| ((fn_pat, {P_feature.cst=P_feature.Else (_,fn2,fv2)})::t_pat,(fn, fv)::t) when fn_pat < fn ->
begin
try if (List.assoc fn2 g_fs) <> fv2 then raise Fail
with Not_found -> raise Fail
end; loop acc (t_pat, t)
(* Two next cases: each feature_name present in p_fs must be in instance *)
| _, [] -> raise Fail
| ((fn_pat, _)::_, (fn, _)::_) when fn_pat < fn -> raise Fail
......@@ -450,6 +471,7 @@ module P_fs = struct
| P_feature.Absent -> raise Fail
| P_feature.Equal fv when not (List_.sort_mem atom fv) -> raise Fail
| P_feature.Different fv when List_.sort_mem atom fv -> raise Fail
| P_feature.Else (fv1,_,_) when fv1 <> atom -> raise Fail
| _ -> () in
(* if constraint part don't fail, look for lexical parameters *)
......
......@@ -126,6 +126,7 @@ and label_parser target = parse
| '}' { Global.label_flag := false; RACC }
| ',' { COMA }
| '|' { PIPE }
| '/' { SLASH }
| '@' general_ident as cmd_var { AROBAS_ID cmd_var }
| "@#" color as col { COLOR col }
......@@ -232,6 +233,8 @@ and standard target = parse
| ">=" | "≥" { GE }
| '|' { PIPE }
| '/' { SLASH }
| "->" { EDGE }
| "-[^" { Global.label_flag := true; LTR_EDGE_LEFT_NEG }
| "-[" { Global.label_flag := true; LTR_EDGE_LEFT }
......
......@@ -48,6 +48,7 @@ let localize t = (t,get_loc ())
%token EQUAL /* = */
%token DISEQUAL /* <> */
%token BANG /* ! */
%token SLASH /* / */
%token STAR /* * */
%token LT /* < */
%token GT /* > */
......@@ -574,6 +575,11 @@ node_features:
| BANG name_loc=simple_id_with_loc
{ let (name,loc) = name_loc in ({Ast.kind = Ast.Absent; name=Ast.to_uname name}, loc) }
/* mwepos=ADV/upos=ADV */
| name1_loc=simple_id_with_loc EQUAL fv1=feature_value SLASH name2=simple_id EQUAL fv2=feature_value
{ let (name1,loc) = name1_loc in ({Ast.kind = Ast.Else (fv1,name2,fv2); name=Ast.to_uname name1}, loc) }
/*=============================================================================================*/
/* COMMANDS DEFINITION */
/*=============================================================================================*/
......
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