New: add 3 new pre-defined Lutin operators: 'nor', '#', and n-ary xor

nb: the infix binary 'xor' already existed.
nb2: xor (and so #) can be costly

_oasis

@@ -33,6 +33,24 @@ Executable lutin
   CompiledObject: native
   CClib: -lcamlidl
 
+Executable "lutin.dbg"
+  Path:   lutin/src
+  MainIs: main.ml
+  BuildDepends: str,unix,num,rdbg-plugin (>= 1.177),lutin-utils,ezdl,gbddml,polka,camlp4,camlidl,gmp
+  NativeOpt: -w A -package num # XXX turn around a bug in oasis/ocamlbuild/ocamlfind?
+  Build: true
+  Install:false
+  CompiledObject: byte
+  CClib: -lcamlidl
+# to use ocamldebug:
+#  - here: set CompiledObject from native to byte
+#  - from emacs: [M-x ocamldebug] ~/lus2lic/_build/src/main.byte
+#  - from ocamldebug prompt: 
+#      cd test
+#      set arg blabla
+#      dir ~/lurette/lutin/src ~/lurette/_build/src ~/rdbg/src ~/rdbg/_build/src ~/lutils/src ~/lutils/_build/src
+
+
 Library lutin
    XMETADescription: Provides an API to call Lutin from ocaml (and rdbg)
    Path:    lutin/src

_tags

 # OASIS_START
-# DO NOT EDIT (digest: 71d84d7cf0a80c1b7d8a7d1353354192)
+# DO NOT EDIT (digest: e206596fa32c72a65d0b3f6b19835f56)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -156,6 +156,21 @@ true: annot, bin_annot
 <lurette-nocaml/src/*.ml{,i,y}>: use_lutin
 <lurette-nocaml/src/*.ml{,i,y}>: use_lutin-utils
 <lurette-nocaml/src/*.ml{,i,y}>: use_polka
+# Executable lutin.dbg
+"lutin/src/main.byte": oasis_executable_lutin_dbg_cclib
+"lutin/src/main.byte": oasis_executable_lutin_dbg_native
+<lutin/src/*.ml{,i,y}>: oasis_executable_lutin_dbg_native
+"lutin/src/main.byte": package(camlidl)
+"lutin/src/main.byte": package(camlp4)
+"lutin/src/main.byte": package(gmp)
+"lutin/src/main.byte": package(num)
+"lutin/src/main.byte": package(rdbg-plugin)
+"lutin/src/main.byte": package(str)
+"lutin/src/main.byte": package(unix)
+"lutin/src/main.byte": use_ezdl
+"lutin/src/main.byte": use_gbddml
+"lutin/src/main.byte": use_lutin-utils
+"lutin/src/main.byte": use_polka
 # Executable lutin
 "lutin/src/main.native": oasis_executable_lutin_cclib
 "lutin/src/main.native": oasis_executable_lutin_native

examples/xor/nary.lut

+
+
+node Xor()
+returns(
+   X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100
+   :bool) =
+loop
+   xor(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+
+node Nor()
+returns(
+   X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100
+   :bool) =
+loop
+   nor(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100) 
+   
+node Diese()
+returns(
+   X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100
+   :bool) =
+   xor (X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+    fby
+    -- to check that a nor id generated from times to times
+    loop
+   #(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+   and (xor(pre X0, pre X1, pre X2, pre X3, pre X4, pre X5, pre X6, pre X7, pre X8, pre X9,
+   pre X10, pre X11, pre X12, pre X13, pre X14, pre X15, pre X16, pre X17, pre X18, pre X19,
+   pre X20, pre X21, pre X22, pre X23, pre X24, pre X25, pre X26, pre X27, pre X28, pre X29,
+   pre X30, pre X31, pre X32, pre X33, pre X34, pre X35, pre X36, pre X37, pre X38, pre X39,
+   pre X40, pre X41, pre X42, pre X43, pre X44, pre X45, pre X46, pre X47, pre X48, pre X49,
+   pre X50, pre X51, pre X52, pre X53, pre X54, pre X55, pre X56, pre X57, pre X58, pre X59,
+   pre X60, pre X61, pre X62, pre X63, pre X64, pre X65, pre X66, pre X67, pre X68, pre X69,
+   pre X70, pre X71, pre X72, pre X73, pre X74, pre X75, pre X76, pre X77, pre X78, pre X79,
+   pre X80, pre X81, pre X82, pre X83, pre X84, pre X85, pre X86, pre X87, pre X88, pre X89,
+   pre X90, pre X91, pre X92, pre X93, pre X94, pre X95, pre X96, pre X97, pre X98, pre X99, pre X100))
+   
+(*
+node nary() returns(
+   X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+   X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+   X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+   X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+   X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+   X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+   X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+   X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+   X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+   X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100
+   :bool) =
+   loop {
+     | Nor(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+           X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+           X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+           X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+           X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+           X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+           X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+           X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+           X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+           X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+     | Xor(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+           X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+           X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+           X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+           X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+           X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+           X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+           X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+           X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+           X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+     | Diese(X0, X1, X2, X3, X4, X5, X6, X7, X8, X9,
+         X10, X11, X12, X13, X14, X15, X16, X17, X18, X19,
+         X20, X21, X22, X23, X24, X25, X26, X27, X28, X29,
+         X30, X31, X32, X33, X34, X35, X36, X37, X38, X39,
+         X40, X41, X42, X43, X44, X45, X46, X47, X48, X49,
+         X50, X51, X52, X53, X54, X55, X56, X57, X58, X59,
+         X60, X61, X62, X63, X64, X65, X66, X67, X68, X69,
+         X70, X71, X72, X73, X74, X75, X76, X77, X78, X79,
+         X80, X81, X82, X83, X84, X85, X86, X87, X88, X89,
+         X90, X91, X92, X93, X94, X95, X96, X97, X98, X99, X100)
+         }
+         *)
\ No newline at end of file

lutin/src/ckTypeEff.ml

@@ -29,6 +29,7 @@ type t =
 |  TEFF_except
 |  TEFF_trace
 |  TEFF_data of basic
+|  TEFF_list of basic
 |  TEFF_tuple of basic list
 |	TEFF_any of string * any_cond
 |	TEFF_ref of basic
@@ -73,24 +74,25 @@ function
 )
 (* pretty-print des types *)
 let rec to_string = ( function
- 	TEFF_data d -> (basic_to_string d)
-| 	TEFF_tuple l -> String.concat "*" (List.map basic_to_string l)
-|	TEFF_ref x -> (basic_to_string x)^" ref"
-|	TEFF_trace -> "trace"
-|	TEFF_weight -> "weight"
-|	TEFF_except -> "exception"
-|	TEFF_any (s, _) -> s
-) and prof_to_string = ( function
-	(tl, t) -> (
-		sprintf "%s->%s"
-			(list_to_string tl)
-			(list_to_string t)
-	)
-) and list_to_string = ( function
-	[] -> ""
-|	t::[] -> to_string t
-|	t::l -> sprintf "%s*%s" (to_string t) (list_to_string l)
-)
+ 	 | TEFF_data d -> (basic_to_string d)
+    |	TEFF_list d -> (basic_to_string d)^ " list"
+    |	TEFF_tuple l -> String.concat "*" (List.map basic_to_string l)
+    |	TEFF_ref x -> (basic_to_string x)^" ref"
+    |	TEFF_trace -> "trace"
+    |	TEFF_weight -> "weight"
+    |	TEFF_except -> "exception"
+    |	TEFF_any (s, _) -> s
+  ) and prof_to_string = ( function
+	   (tl, t) -> (
+		  sprintf "%s->%s"
+			 (list_to_string tl)
+			 (list_to_string t)
+	   )
+  ) and list_to_string = ( function
+	   [] -> ""
+    |	t::[] -> to_string t
+    |	t::l -> sprintf "%s*%s" (to_string t) (list_to_string l)
+  )
 
 let ref_of = function
 	TEFF_data x -> TEFF_ref x 
@@ -137,6 +139,7 @@ let get_prof tinl tout = (tinl, tout)
 
 (* TYPE USUELS *)
 let boolean  = TEFF_data Bool
+let booleans = TEFF_list Bool
 let boolref  = TEFF_ref Bool
 let intref  = TEFF_ref Int
 let integer   = TEFF_data Int
@@ -163,6 +166,8 @@ let prof_bt_t = ([boolean;trace], [trace])
 let prof_iit_t = ([integer;integer;trace], [trace])
 let prof_b_b = ([boolean], [boolean])
 let prof_bb_b = ([boolean;boolean], [boolean])
+let prof_bl_b = ([booleans], [boolean])
+                
 let prof_ii_i = ([integer;integer], [integer])
 let prof_iii_i = ([integer;integer;integer], [integer])
 let prof_et_t = ([except;trace], [trace])
@@ -211,23 +216,30 @@ let lifts_to t1 t2 = (
 	Failure OU Invalid_argument (on fait dans le dtail ?)
 *)
 let rec match_prof tel prof = (
-	(* table locale pour les types any *)
-	let anytab = Hashtbl.create 2 in
-	match prof with (txl, tres) ->
-	let doit tc tx = (
-		match_in_type anytab tc tx
-	) in
-	let _tins = List.map2 doit tel txl in
-	let _tout = List.map (match_out_type anytab) tres in
-	(* ICI : on a le profil effectif, 
-		est-ce que ca peut etre utile ??? *)
-	Verbose.exe ~flag:dbg (fun _ ->
-		Printf.fprintf stderr "CkTypeEff.match [%s] with (%s) gives %s\n"
-			(list_to_string tel)
-			(prof_to_string prof)
-			(list_to_string _tout)
-	);
-	_tout
+  (* table locale pour les types any *)
+  let anytab = Hashtbl.create 2 in
+  match prof with
+  | ([TEFF_list Bool], [TEFF_data Bool]) -> (* a special case for xor/nor/# *)
+	 let doit tc =
+      try match_in_type anytab tc (TEFF_ref Bool)
+      with _ -> match_in_type anytab tc boolean
+    in
+	 let _tins = List.map doit tel in
+	 let _tout = List.map (match_out_type anytab) [TEFF_data Bool] in
+    _tout
+  | (txl, tres) ->
+	 let doit tc tx = match_in_type anytab tc tx in
+	 let _tins = List.map2 doit tel txl in
+	 let _tout = List.map (match_out_type anytab) tres in
+	 (* ICI : on a le profil effectif, 
+		 est-ce que ca peut etre utile ??? *)
+	 Verbose.exe ~flag:dbg (fun _ ->
+		  Printf.fprintf stderr "CkTypeEff.match [%s] with (%s) gives %s\n"
+			 (list_to_string tel)
+			 (prof_to_string prof)
+			 (list_to_string _tout)
+	   );
+	 _tout
 )
 (*
 Vrifie la compatibilit :
@@ -235,34 +247,30 @@ V
 - d'un type attendu (texptd)
 - dans un table d'assoc. des any (anytab)
 *)
-and match_in_type anytab tobtd texptd = (
-	match (tobtd, texptd) with
-	(_ , TEFF_any (k, cond)) -> (
+and match_in_type anytab tobtd texptd =
+  match (tobtd, texptd) with
+  | (_ , TEFF_any (k, cond)) -> (
 		try (
-			let tprev = Util.hfind anytab k in
-			match_in_type anytab tobtd tprev
-		) with Not_found -> (
-			match (cond tobtd) with
-			Some t -> (
-				Hashtbl.add anytab k t ;
-				t
-			) |
-			None -> (
-				failwith "uncompatible types"
-			)
-		)	
-	) |
-	_ -> (
+		  let tprev = Util.hfind anytab k in
+		  match_in_type anytab tobtd tprev
+      )
+      with Not_found -> (
+			 match (cond tobtd) with
+		    | Some t -> (Hashtbl.add anytab k t ; t)
+          | None -> failwith "uncompatible types"
+		  )
+	 )
+  | _ -> (
 		if (lifts_to tobtd texptd) then texptd
 		else failwith "uncompatible types"
-	)
-) and match_out_type anytab tres = (
-	match tres with
-		TEFF_any (k, _) -> (
-			try (
-				Util.hfind anytab k
-			) with Not_found -> (
-				failwith "uncompatible types"					
-			)
-		) | _ -> tres
+	 )
+and match_out_type anytab tres = (
+  match tres with
+	 TEFF_any (k, _) -> (
+		try (
+		  Util.hfind anytab k
+		) with Not_found -> (
+			 failwith "uncompatible types"					
+		  )
+	 ) | _ -> tres
 )

lutin/src/ckTypeEff.mli

@@ -25,6 +25,7 @@ type t =
 |  TEFF_except
 |  TEFF_trace
 |  TEFF_data of basic
+|  TEFF_list of basic
 |  TEFF_tuple of basic list
 |	TEFF_any of string * any_cond
 |	TEFF_ref of basic
@@ -97,6 +98,7 @@ val prof_bt_t  : profile
 val prof_iit_t  : profile
 val prof_b_b  : profile
 val prof_bb_b  : profile
+val prof_bl_b  : profile
 val prof_ii_i  : profile
 val prof_iii_i  : profile
 

lutin/src/exp.ml

@@ -59,6 +59,9 @@ and formula =
   | And  of formula * formula
   | Or   of formula * formula
   | Xor  of formula * formula
+  | NXor of formula list
+  | Nor  of formula list
+  | Diese of formula list
   | Impl of formula * formula
   | IteB of formula * formula * formula
   | Not  of formula
@@ -251,8 +254,12 @@ let rec (simplifie_a_little : formula -> formula) =
 	         else
 	           f12'
       | Xor(f1, f2) -> Xor(simplifie_a_little f1, simplifie_a_little f2)
+      | NXor fl -> NXor(List.map simplifie_a_little fl)
+      | Nor fl -> Nor(List.map simplifie_a_little fl)
+      | Diese fl -> Diese(List.map simplifie_a_little fl)
       | Impl(f1, f2) -> Impl(simplifie_a_little f1, simplifie_a_little f2)
-      | IteB(f1, f2, f3) -> IteB(simplifie_a_little f1, simplifie_a_little f2, simplifie_a_little f3)
+      | IteB(f1, f2, f3) -> IteB(simplifie_a_little f1, simplifie_a_little f2,
+                                 simplifie_a_little f3)
       | Not(f1) -> Not(simplifie_a_little f1)
       | EqB(f1, f2) -> EqB(simplifie_a_little f1, simplifie_a_little f2)
 
@@ -293,7 +300,9 @@ and (f2s : int -> formula -> string) =
 	           (i2tab i)  ^ "xor \n" ^ 
 	           (f2s i f2) ^ "\n" ^ 
 	           (i2tab i)  ^ ")"
-
+        | NXor fl -> (i2tab i) ^ "xor(" ^ (String.concat "," (List.map (f2s i) fl)) ^ ")" 
+        | Nor fl -> (i2tab i) ^ "nor(" ^ (String.concat "," (List.map (f2s i) fl)) ^ ")" 
+        | Diese fl -> (i2tab i) ^ "#(" ^ (String.concat "," (List.map (f2s i) fl)) ^ ")" 
         | Impl(f1, f2) ->
 	         (i2tab i)  ^ "(\n" ^ 
 	           (f2s i f1) ^ "\n" ^

lutin/src/exp.mli

@@ -25,6 +25,9 @@ and formula =
   | And  of formula * formula
   | Or   of formula * formula
   | Xor  of formula * formula
+  | NXor of formula list
+  | Nor  of formula list
+  | Diese of formula list
   | Impl of formula * formula
   | IteB of formula * formula * formula
   | Not  of formula

lutin/src/formula_to_bdd.ml

@@ -290,6 +290,68 @@ type comp = SupZero | SupEqZero | EqZero
    it's just an heuristic anyway
 *)
 
+let rec translate_nor fl =
+  assert (fl <> []);
+  let aux facc f = And(facc, Not(f)) in
+  List.fold_left aux (Not (List.hd fl)) (List.tl fl)
+  
+let rec translate_nary_and fl = (* n-ary "and" *)
+  assert (fl <> []);
+  let aux facc f = And(facc, f) in
+  List.fold_left aux (List.hd fl) (List.tl fl)
+  
+let rec translate_nary_or fl = (* n-ary "or" *)
+  assert (fl <> []);
+  let aux facc f = Or(facc, f) in
+  List.fold_left aux (List.hd fl) (List.tl fl)
+  
+let translate_nxor fl =
+  let n = List.length fl in
+  let split i l =
+    let rec aux i acc = function
+    | [] -> assert false
+    | x::tail -> if i = 0 then x, List.rev_append acc tail else aux (i-1) (x::acc) tail
+    in
+    aux i [] l
+  in
+  let rec aux acc i =
+    if i = n then acc else
+      let cur =
+        let x,l = split i fl in
+        And(x, Nor(l))
+      in
+      let acc = Or(cur, acc) in
+      aux acc (i+1)
+  in
+  aux False 0
+    
+let translate_nxor_alt fl =
+  (* Using the following formula:
+     XOR(ϕ1,ϕ2,...,ϕn) = OR(ϕ1,ϕ2,...,ϕn) ∧ AND ¬(ϕi∧ϕj)
+                                             i<j≤n             
+
+ It uses twice less connectors than the previous one, but it happens to be 10x slower!
+*)
+  assert (fl <> []);
+  let or_part = translate_nary_or fl in
+  let gen_pairs l =
+    let rec aux acc l =
+      match l with
+      | [] -> acc
+      | x::tail ->
+        let cur_pairs = List.map (fun y -> x,y) tail in
+        let acc = List.rev_append cur_pairs acc in
+        aux acc tail 
+    in
+    aux [] l
+  in
+  let pairs: (Exp.formula * Exp.formula) list = gen_pairs fl in
+  let pairs: Exp.formula list = List.map (fun (f1, f2) -> Not(And(f1,f2))) pairs in
+  let and_part = translate_nary_and pairs in
+  And(or_part, and_part)
+
+let translate_diese fl = Or(translate_nor fl, translate_nxor fl)
+
 
 let rec (translate_do : t -> Var.env_in -> Var.env -> string -> int -> Exp.formula ->
          t * Bdd.t * bool) =
@@ -324,6 +386,9 @@ let rec (translate_do : t -> Var.env_in -> Var.env -> string -> int -> Exp.formu
           let (t, bdd2, dep2) = (translate_do t input memory ctx_msg vl f2) in 
           (t, Bdd.xor bdd1 bdd2, dep1 || dep2)
 
+        | NXor(fl) -> translate_do t input memory ctx_msg vl (translate_nxor fl)
+        | Diese(fl) -> translate_do t input memory ctx_msg vl (translate_diese fl)
+        | Nor(fl) -> translate_do t input memory ctx_msg vl (translate_nor fl)
         | IteB(f1, f2, f3) ->
           let (t, bdd1, dep1) = (translate_do t input memory ctx_msg vl f1) in
           let (t, bdd2, dep2) = (translate_do t input memory ctx_msg vl f2) in

lutin/src/lutExe.ml

@@ -339,42 +339,42 @@ let string_of_guard g = (
 *)
 
 let rec contextual_id2exp (it:t) data (eval:bool) (idref:CoAlgExp.node) = (
-   let unalias s =
-      (Util.StringMap.find s (Expand.alias_tab it.expanded_code)).Expand.ai_def_exp
-   in
-   match idref with
-   | CoAlgExp.AE_alias id -> (
+  let unalias s =
+    (Util.StringMap.find s (Expand.alias_tab it.expanded_code)).Expand.ai_def_exp
+  in
+  match idref with
+  | CoAlgExp.AE_alias id -> (
       let e' = unalias id in
       contextual_lutexp2exp it data e'
-   )
-   | CoAlgExp.AE_support id -> (
+    )
+  | CoAlgExp.AE_support id -> (
       (* does the value exist in data.curs ? *)
-      let res = try (
-           let v = Value.OfIdent.get data.curs id in
-         Glue.lucky_exp_of_value v
-      ) with Not_found -> (
-         Glue.lucky_exp_var_ref (id2var it id)
-      ) in res
-   )
-   | CoAlgExp.AE_pre id -> (
+      let res =
+        try 
+          let v = Value.OfIdent.get data.curs id in
+          Glue.lucky_exp_of_value v
+        with Not_found -> (
+            Glue.lucky_exp_var_ref (id2var it id)
+          )
+      in
+      res
+    )
+  | CoAlgExp.AE_pre id -> (
       (* the value MUST be data.pres *)
-      try (
-         let v = Value.OfIdent.get data.pres id in
-         Glue.lucky_exp_of_value v
-      ) with Not_found -> raise (
-         Internal_error ("LutExe.contextual_id2exp",
-            "can't find the value of pre("^(CoIdent.to_string id)^
-              ") in the current context"
-         )
-      )
-   
-   )
-   | _ -> assert false
+      try 
+        let v = Value.OfIdent.get data.pres id in
+        Glue.lucky_exp_of_value v
+      with Not_found ->  
+        raise (Global_error (
+            "Can't find the value of pre("^(CoIdent.to_string id)^
+            ") in the current context"))
+    )
+  | _ -> assert false
 ) and
-contextual_lutexp2exp (it:t) data e = (
-   (* PARTIAL EVAL *)
-   Glue.lucky_exp_of true (contextual_id2exp it data) e
-)
+  contextual_lutexp2exp (it:t) data e = (
+    (* PARTIAL EVAL *)
+    Glue.lucky_exp_of true (contextual_id2exp it data) e
+  )
 
 (** exceptions and type *)
 exception Deadlock of int (* Attach the event nb to ease debugging when this exc 

lutin/src/lutLexer.mll

@@ -59,6 +59,8 @@ Hashtbl.add keywords "true"      (function s -> TK_TRUE s) ;;
 
 Hashtbl.add keywords "or"        (function s -> TK_OR s) ;;
 Hashtbl.add keywords "xor"       (function s -> TK_XOR s) ;;
+Hashtbl.add keywords "nor"       (function s -> TK_NOR s) ;;
+Hashtbl.add keywords "#"         (function s -> TK_DIESE s) ;;
 Hashtbl.add keywords "and"       (function s -> TK_AND s) ;;
 Hashtbl.add keywords "not"       (function s -> TK_NOT s) ;;
 Hashtbl.add keywords "if"        (function s -> TK_IF s) ;;
@@ -71,11 +73,7 @@ Hashtbl.add keywords "mod"       (function s -> TK_MOD s) ;;
 Hashtbl.add keywords "and"       (function s -> TK_AND s) ;;
 *)
 
-let is_a_keyword ( s: string ) = (
-	try
-		let res = Hashtbl.find keywords s in (Some res)
-	with Not_found -> ( None )
-)
+let is_a_keyword ( s: string ) = Hashtbl.find_opt keywords s
 
 let token_code tk = (
    match tk with
@@ -153,7 +151,9 @@ let token_code tk = (
       | TK_CLOSE_PAR  lxm -> ("TK_CLOSE_PAR", lxm)
 
       | TK_OR   lxm -> ("TK_OR", lxm)
+      | TK_NOR  lxm -> ("TK_NOR", lxm)
       | TK_XOR  lxm -> ("TK_XOR", lxm)
+      | TK_DIESE lxm -> ("TK_DIESE", lxm)
       | TK_AND  lxm -> ("TK_AND", lxm)
       | TK_IMPL lxm -> ("TK_IMPL", lxm)
       | TK_ASSIGN lxm -> ("TK_ASSIGN", lxm)
@@ -245,6 +245,7 @@ rule lexer = parse
 	| "*"  { TK_TIMES ( Lexeme.make lexbuf ) }
 	| "|"  { TK_BAR ( Lexeme.make lexbuf ) }
 	| "="  { TK_EQ ( Lexeme.make lexbuf ) }
+   | "#"  { TK_DIESE ( Lexeme.make lexbuf ) }
 
 	| "."  { TK_DOT ( Lexeme.make lexbuf ) }
 	| ","  { TK_COMA ( Lexeme.make lexbuf ) }

lutin/src/lutParser.mly

@@ -203,6 +203,8 @@ let make_val_exp ven lxm = {
 %token <Lexeme.t> TK_NOT
 %token <Lexeme.t> TK_OR
 %token <Lexeme.t> TK_XOR
+%token <Lexeme.t> TK_NOR
+%token <Lexeme.t> TK_DIESE
 %token <Lexeme.t> TK_AND
 %token <Lexeme.t> TK_IMPL
 %token <Lexeme.t> TK_ASSIGN
@@ -846,6 +848,8 @@ lutExp:
 	/* oprateurs ternaires */
 	|	TK_IF lutExp TK_THEN lutExp TK_ELSE lutExp
 			{ make_val_exp (CALL_n (flagit "ite" $1, [$2;$4;$6])) $1 }
+	/* n-aire */
+	|	lutNaryExp { $1 }
 	;
 
 lutUnExp:
@@ -871,8 +875,25 @@ lutBinExp:
 	|	lutExp TK_LTE lutExp { make_val_exp (CALL_n (flagit "lte" $2, [$1;$3])) $2 }
 	|	lutExp TK_GT lutExp { make_val_exp (CALL_n (flagit "gt" $2, [$1;$3])) $2 }
 	|	lutExp TK_GTE lutExp { make_val_exp (CALL_n (flagit "gte" $2, [$1;$3])) $2 }