Commits

Sébastien Ferré  committed 0af8d55

Added optionals to LISQL (maybe) on S1, P1, and P2.

  • Participants
  • Parent commits ddb3325

Comments (0)

Files changed (6)

     let uri_Or = Qname (prefix, "Or")
     let uri_Minus = Qname (prefix, "Minus")
     let uri_Not = Qname (prefix, "Not")
+    let uri_Maybe = Qname (prefix, "Maybe")
     let uri_ToggleEvery = Qname (prefix, "ToggleEvery")
     let uri_ToggleOnly = Qname (prefix, "ToggleOnly")
     let uri_For = Qname (prefix, "For")
   let switch_menu = query_menubar_factory#add_submenu "Switch" in
   let switch_menu_factory = new GMenu.factory switch_menu in
   let cmd_compl = switch_menu_factory#add_item "not __" in
+  let cmd_optional = switch_menu_factory#add_item "maybe __" in
   let cmd_every = switch_menu_factory#add_item "every __" in
   let cmd_only = switch_menu_factory#add_item "only __" in
   let cmd_quote = switch_menu_factory#add_item "{ __ }" in
 	(fun () -> 
 	  Logui.item Logui.uri_Not (fun obs -> []);
 	  self#transf Lisql.focus_compl);
+      cmd_optional # connect # activate ~callback:
+	(fun () -> 
+	  Logui.item Logui.uri_Maybe (fun obs -> []);
+	  self#transf Lisql.focus_optional);
       cmd_every # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_ToggleEvery (fun obs -> []);
 	~text:"Add or create an exception (and not) to the current query focus";
       tooltips#set_tip cmd_compl#coerce
 	~text:"Apply negation (not) to the current query focus";
+      tooltips#set_tip cmd_optional#coerce
+	~text:"Apply optional (maybe) to the current query focus";
       tooltips#set_tip cmd_every#coerce
 	~text:"Toggle the use of the 'every' determiner";
       tooltips#set_tip cmd_only#coerce

File src/lisql.ml

   | NAnd lnp -> List.iter check_update_s1 lnp
   | NOr lnp -> failwith "Invalid update: some disjunction between NPs"
   | NNot np -> check_update_s1 np
+  | NMaybe np -> failwith "Invalid update: optional NP (maybe)"
 and check_update_p1 = function
   | Var _ -> ()
   | NameRoot -> ()
   | And lf -> List.iter check_update_p1 lf
   | Or _ -> failwith "Invalid description: disjunctions are not allowed (or)"
   | Not f1 -> check_update_p1 f1 (* failwith "Invalid description: negations are not allowed (not)" *)
+  | Maybe _ -> failwith "Invalid description: optionals are not allowed (maybe)"
 and check_update_p1_args i args =
   Array.iteri (fun j a -> if j <> i-1 then check_update_p1 a) args
     (* the i-th argument is unsignificant, and therefore allowed to be Thing *)
   | NOr lnp -> NOr (List.map (simpl_s1 store) lnp)
   | NNot (NNot np1) -> simpl_s1 store np1
   | NNot np1 -> NNot (simpl_s1 store np1)
+  | NMaybe (NMaybe np1) -> NMaybe (simpl_s1 store np1)
+  | NMaybe np1 -> NMaybe (simpl_s1 store np1)
 and simpl_s2 store : s2 -> s2 = function
   | Exists -> Exists
   | Forall -> Forall
   | Or lf -> Or (List.map (simpl_p1 store) lf)
   | Not (Not f1) -> simpl_p1 store f1
   | Not f1 -> Not (simpl_p1 store f1)
+  | Maybe (Maybe f1) -> Maybe (simpl_p1 store f1)
+  | Maybe f1 -> Maybe (simpl_p1 store f1)
   | f -> f
 and simpl_p2 store = function
   | Opt r -> Opt (simpl_p2 store r)
   | Trans r -> Trans (simpl_p2 store r)
   | Direct r -> Direct (simpl_p2 store r)
   | Compose (r1,r2) -> Compose (simpl_p2 store r1, simpl_p2 store r2)
-  | RNot r1 -> RNot (simpl_p2 store r1)
   | RAnd (r1,r2) -> RAnd (simpl_p2 store r1, simpl_p2 store r2)
   | ROr (r1,r2) -> ROr (simpl_p2 store r1, simpl_p2 store r2)
+  | RNot r1 -> RNot (simpl_p2 store r1)
+  | RMaybe r1 -> RMaybe (simpl_p2 store r1)
   | r -> r
 
 
   | And lf1, _ ->
       List.exists (fun f1 -> entails_p1 ~obs store f1 f2) lf1
   | Not f1a, Not f2a -> entails_p1 ~obs store f2a f1a
+  | Maybe f1a, Maybe f2a -> entails_p1 ~obs store f1a f2a
+  | _, Maybe f2a -> entails_p1 ~obs store f1 f2a
   | _, Thing -> true
   | _, Var _ -> false
   | Name n, _ -> Ext.mem (store#get_entity n) (store#tab_extent ~obs f2)
       | NNot np1 -> Some (AtS1 (np1,k))
       | _ -> Some (AtS1 (np, NNot0 (np,k))))
 
+let focus_optional : transf = function
+  | AtP1 (f,k) ->
+      ( match f with
+      | Maybe f1 -> Some (AtP1 (f1,k))
+      | _ -> Some (AtP1 (f, Maybe0 (f,k))))
+  | AtS1 (np,k) ->
+      ( match np with
+      | NMaybe np1 -> Some (AtS1 (np1,k))
+      | _ -> Some (AtS1 (np, NMaybe0 (np,k))))
+
 let focus_union x : transf = function
   | AtP1 (f,k) ->
       let f, k =
       | NAndN (n,l,k') -> intent_s1 (NAnd (Common.list_set_nth l n np)) k'
       | NOrN (n,l,k') -> intent_s1 np k'
       | NNot0 (_,k') -> intent_s1 np k'
+      | NMaybe0 (_,k') -> intent_s1 np k'
     and intent_p1 c = function
       | Is1 (np,_,k') -> intent_s (Is (intent_exist_s1 np,c)) k' (* BEWARE of scope of variable in focus *)
       | Qu1 (q,_,k') -> intent_s1 (Qu (Exists,c)) k'
       | AndN (n,l,k') -> intent_p1 (And (Common.list_set_nth l n c)) k'
       | OrN (n,l,k') -> intent_p1 c k'
       | Not0 (_,k') -> intent_p1 c k'
+      | Maybe0 (_,k') -> intent_p1 c k'
     and intent_exist_s1 = function
       | Qu (_,c) -> Qu (Exists,c)
       | NAnd l -> NAnd (List.map intent_exist_s1 l)
       | NOr l -> NOr (List.map intent_exist_s1 l)
       | NNot np -> intent_exist_s1 np
+      | NMaybe np -> intent_exist_s1 np
 
     let intent : focus -> intent = function
       | AtP1 (c, Is1 (NAnd _ ,_, k')) ->
       | NAndN (n,l,k') -> intent_s1 f k'
       | NOrN (n,l,k') -> intent_s1 f k'
       | NNot0 (_,k') -> intent_s1 f k'
+      | NMaybe0 (_,k') -> intent_s1 f k'
     and intent_p1 (f : p1 -> intent) : context_p1 -> intent = function
       | Is1 (np,_,k') ->
 	  intent_s (intent_np f np) k'
 	  intent_p1 f k'
       | Not0 (_,k') ->
 	  intent_p1 f k'
+      | Maybe0 (_,k') ->
+	  intent_p1 f k'
     and intent_np f : s1 -> intent = function
       | Qu (q,c) -> f c
       | NAnd l -> CAnd (List.map (intent_np f) l)
       | NOr l -> COr (List.map (intent_np f) l)
       | NNot np -> intent_np f np
+      | NMaybe np -> intent_np f np
 	    
     let intent : focus -> intent = function
       | AtP1 (f,k) -> intent_p1 (function Thing -> CExists f | c -> CExists (And [f; c])) k

File src/lisql_ast.ml

   | NAnd of s1 list
   | NOr of s1 list
   | NNot of s1
+  | NMaybe of s1
 and s2 =
   | Exists
   | Forall
   | And of p1 list
   | Or of p1 list
   | Not of p1
+  | Maybe of p1
 and p2 =
   | Univ
   | Self
   | Trans of p2
   | Direct of p2
   | Compose of p2 * p2
-  | RNot of p2
   | RAnd of p2 * p2
   | ROr of p2 * p2
+  | RNot of p2
+  | RMaybe of p2
 and orientation =
   | Fwd (* object *)
   | Bwd (* subject *)
   | NAndN of int * s1 list * context_s1
   | NOrN of int * s1 list * context_s1
   | NNot0 of s1 * context_s1
+  | NMaybe0 of s1 * context_s1
 and context_p1 =
   | Is1 of s1 * p1 * context_s
   | Qu1 of s2 * p1 * context_s1
   | AndN of int * p1 list * context_p1
   | OrN of int * p1 list * context_p1
   | Not0 of p1 * context_p1
+  | Maybe0 of p1 * context_p1
 
 (* focus and transformation definition *)
 
   | NAnd l -> List.fold_left (fun res np -> LSet.union res (vars_s1 np)) (LSet.empty ()) l
   | NOr l -> List.fold_left (fun res np -> LSet.union res (vars_s1 np)) (LSet.empty ()) l
   | NNot np -> vars_s1 np
+  | NMaybe np -> vars_s1 np
 and vars_p1 q =
   match q with
   | Var v -> LSet.singleton v
   | And l -> List.fold_left (fun res f -> LSet.union res (vars_p1 f)) (LSet.empty ()) l
   | Or l -> List.fold_left (fun res f -> LSet.union res (vars_p1 f)) (LSet.empty ()) l
   | Not f -> vars_p1 f
+  | Maybe f -> vars_p1 f
 
 let new_var_s a = get_new_var (vars_s a)
 let new_var_p1 q = get_new_var (vars_p1 q)
   | Qu (q,c) -> Qu (q, subst_p1 env c)
   | NAnd l -> NAnd (List.map (subst_s1 env) l)
   | NOr l -> NOr (List.map (subst_s1 env) l)
-  | NNot np -> subst_s1 env np
+  | NNot np -> NNot (subst_s1 env np)
+  | NMaybe np -> NMaybe (subst_s1 env np)
 and subst_p1 env c =
   match c with
   | Var v -> (try List.assoc v env with Not_found -> c)
   | And l -> And (List.map (subst_p1 env) l)
   | Or l -> Or (List.map (subst_p1 env) l)
   | Not c' -> Not (subst_p1 env c')
+  | Maybe c' -> Maybe (subst_p1 env c')
 and subst_args env args =
   Array.map (subst_p1 env) args
 
   | Trans r1 -> Trans (reverse_p2 r1)
   | Direct r1 -> Direct (reverse_p2 r1)
   | Compose (r1,r2) -> Compose (reverse_p2 r2, reverse_p2 r1)
-  | RNot r1 -> RNot (reverse_p2 r1)
   | RAnd (r1,r2) -> RAnd (reverse_p2 r1, reverse_p2 r2)
   | ROr (r1,r2) -> ROr (reverse_p2 r1, reverse_p2 r2)
+  | RNot r1 -> RNot (reverse_p2 r1)
+  | RMaybe r1 -> RMaybe (reverse_p2 r1)
 and reverse_orientation = function
   | Fwd -> Bwd
   | Bwd -> Fwd
       n1 = n2 && same_list_but n1 l1 l2 && same_context_s1 k1' k2'
   | NNot0 (_,k1'), NNot0 (_,k2') ->
       same_context_s1 k1' k2'
+  | NMaybe0 (_,k1'), NMaybe0 (_,k2') ->
+      same_context_s1 k1' k2'
   | _, _ -> false
 and same_context_p1 k1 k2 =
   match k1, k2 with
       n1 = n2 && same_list_but n1 l1 l2 && same_context_p1 k1' k2'
   | Not0 (_,k1'), Not0 (_,k2') ->
       same_context_p1 k1' k2'
+  | Maybe0 (_,k1'), Maybe0 (_,k2') ->
+      same_context_p1 k1' k2'
   | _, _ -> false
 and same_args_but is args1 args2 =
   let n1 = Array.length args1 in
       let l' = Common.list_set_nth l n np in
       decontext_s1_gen ~decontext_s ~decontext_p1 (NOr l', k')
   | NNot0 (_,k') -> decontext_s1_gen ~decontext_s ~decontext_p1 (NNot np, k')
+  | NMaybe0 (_,k') -> decontext_s1_gen ~decontext_s ~decontext_p1 (NMaybe np, k')
 
 let rec decontext_p1_gen ~decontext_s ~decontext_s1 (f, k : p1 * context_p1) =
   match k with
       let l' = Common.list_set_nth l n f in
       decontext_p1_gen ~decontext_s ~decontext_s1 (Or l', k')
   | Not0 (_,k') -> decontext_p1_gen ~decontext_s ~decontext_s1 (Not f, k')
+  | Maybe0 (_,k') -> decontext_p1_gen ~decontext_s ~decontext_s1 (Maybe f, k')
   | Quote0 (_,k') -> decontext_p1_gen ~decontext_s ~decontext_s1 (Quote f, k')
 
 let rec decontext_s a_k = decontext_s_gen ~decontext_nil:(fun a -> a) ~decontext_p1 a_k
       | l' -> NOr l', k')
   | NNot0 (_,k') ->
       simpl_context_thing_s1 k'
+  | NMaybe0 (_,k') ->
+      simpl_context_thing_s1 k'
   | _ -> top_s1, k
 and simpl_context_thing_p1 (k : context_p1) : p1 * context_p1 =
   match k with
       | l' -> Or l', k')
   | Not0 (_,k') ->
       simpl_context_thing_p1 k'
+  | Maybe0 (_,k') ->
+      simpl_context_thing_p1 k'
   | _ -> top_p1, k
 
 let rec focus_first : transf = function
   | NOr [] -> assert false
   | NOr l -> focus_first_s1 (NOrN (0,l,k)) (List.hd l)
   | NNot np1 -> focus_first_s1 (NNot0 (np1,k)) np1
+  | NMaybe np1 -> focus_first_s1 (NMaybe0 (np1,k)) np1
 
 let rec focus_down : transf = function
   | AtS1 (np,k) -> focus_down_s1 k np
       | np0::_ -> Some (AtS1 (np0, NOrN (0,l,k))))
   | NNot np0 ->
       Some (AtS1 (np0, NNot0 (np0, k)))
+  | NMaybe np0 ->
+      Some (AtS1 (np0, NMaybe0 (np0, k)))
 and focus_down_p1 k = function
   | Thing -> None
   | Var _ -> None
       | f0::_ -> Some (AtP1 (f0, OrN (0,l,k))))
   | Not f0 ->
       Some (AtP1 (f0, Not0 (f0, k)))
+  | Maybe f0 ->
+      Some (AtP1 (f0, Maybe0 (f0, k)))
 
 let rec focus_up : transf = function
   | AtS1 (np,k) -> focus_up_s1 np k
       Some (AtS1 (NOr l', k'))
   | NNot0 (_,k') ->
       Some (AtS1 (NNot np, k'))
+  | NMaybe0 (_,k') ->
+      Some (AtS1 (NMaybe np, k'))
 and focus_up_p1 f = function
   | Is1 (np,_,k') -> focus_up_s (Is (np,f)) k'
   | Qu1 (q,_,k') ->
       Some (AtP1 (Or l', k'))
   | Not0 (_,k') ->
       Some (AtP1 (Not f, k'))
+  | Maybe0 (_,k') ->
+      Some (AtP1 (Maybe f, k'))
 
 let rec focus_up_and foc =
   match foc with
 	let l' = Common.list_set_nth l n np in
 	Some (AtS1 (List.nth l (n+1), NOrN (n+1,l',k')))
   | NNot0 (_,k') -> None
+  | NMaybe0 (_,k') -> None
 and focus_right_p1 k f =
   match k with
   | Is1 (np,_,k') -> None
 	let l' = Common.list_set_nth l n f in
 	Some (AtP1 (List.nth l (n+1), OrN (n+1,l',k')))
   | Not0 (_,k') -> None
+  | Maybe0 (_,k') -> None
 
 let rec focus_left : transf = function
   | AtS1 (np,k) -> focus_left_s1 k np
 	let l' = Common.list_set_nth l n np in
 	Some (AtS1 (List.nth l (n-1), NOrN (n-1,l',k')))
   | NNot0 (_,k') -> None
+  | NMaybe0 (_,k') -> None
 and focus_left_p1 k f =
   match k with
   | Is1 (np,_,k') ->
 	let l' = Common.list_set_nth l n f in
 	Some (AtP1 (List.nth l (n-1), OrN (n-1,l',k')))
   | Not0 (_,k') -> None
+  | Maybe0 (_,k') -> None
 
 let focus_of_s a =
   match focus_first_s NilS a with

File src/lisql_pretty.ml

   | NNot np1 ->
       pp#string "not"; print_space pp;
       print0_s1 ~obs store prec_not (NNot0 (np1,k)) ~focus np1 pp
+  | NMaybe np1 ->
+      pp#string "maybe"; print_space pp;
+      print0_s1 ~obs store prec_not (NMaybe0 (np1,k)) ~focus np1 pp
 and print0_s2 ~obs store prec q pp =
   match q with
   | Exists -> pp#string "a"
       let k0 = Not0 (f1,k) in
       pp#string "not"; print_space pp;
       print0_p1 ~obs store prec_not k0 ~focus f1 pp
+  | Maybe f1 ->
+      let k0 = Maybe0 (f1,k) in
+      pp#string "maybe"; print_space pp;
+      print0_p1 ~obs store prec_not k0 ~focus f1 pp
   | Quote f1 ->
       let k0 = Quote0 (f1,k) in
       print_left_curly_bracket pp;
 	(fun pp ->
 	  print_p2 ~obs store prec_atom r1 pp; print_space pp; print_p2 ~obs store prec_atom r2 pp)
 	pp
-  | RNot r1 ->
-      print_in_scope prec prec_not
-	(fun pp -> pp#string "not"; print_space pp; print_p2 ~obs store prec_not r1 pp)
-	pp
   | RAnd (r1,r2) ->
       print_in_scope prec prec_and
 	(fun pp ->
 	  print_space pp; pp#string "or"; print_space pp;
 	  print_p2 ~obs store prec_or r2 pp)
 	pp
+  | RNot r1 ->
+      print_in_scope prec prec_not
+	(fun pp -> pp#string "not"; print_space pp; print_p2 ~obs store prec_not r1 pp)
+	pp
+  | RMaybe r1 ->
+      print_in_scope prec prec_not
+	(fun pp -> pp#string "maybe"; print_space pp; print_p2 ~obs store prec_not r1 pp)
+	pp
 and print_p2_atom ~obs store d a pp =
   print_role ~obs store d a pp
 and print_struct ~obs store prec k ~focus funct i_opt args st_opt pp =

File src/lisql_semantics.ml

       Fol.or_list (List.map (fun np -> fol_s1 ~obs store gv d np) l)
   | NNot np1 ->
       Prop.Not (fol_s1 ~obs store gv d np1)
+  | NMaybe np1 ->
+      Prop.Maybe (fol_s1 ~obs store gv d np1)
 and fol_s2 ~obs store gv (d1 : Extension.var -> Fol.fol_prop) (d2 : Extension.var -> Fol.fol_prop) : s2 -> Fol.fol_prop = function
   | Exists ->
       let x = gv#get in
 	(fol_p1 ~obs store gv x f1) l
   | Not f1 ->
       Prop.Not (fol_p1 ~obs store gv x f1)
+  | Maybe f1 ->
+      Prop.Maybe (fol_p1 ~obs store gv x f1)
   | Quote f1 ->
       let s = Syntax.string_of_class f1 in
       fol_p1 ~obs store gv x (Name (Rdf.Literal (s, Rdf.Typed Namespace.uri_Class)))
       let z = gv#get in
       Prop.And (fol_p2 ~obs store gv lm x z r1,
 		fol_p2 ~obs store gv lm z y r2)
-  | RNot r1 ->
-      Prop.Not (fol_p2 ~obs store gv lm x y r1)
   | RAnd (r1,r2) ->
       Prop.And (fol_p2 ~obs store gv lm x y r1, fol_p2 ~obs store gv lm x y r2)
   | ROr (r1,r2) ->
       Prop.Or (fol_p2 ~obs store gv lm x y r1, fol_p2 ~obs store gv lm x y r2)
+  | RNot r1 ->
+      Prop.Not (fol_p2 ~obs store gv lm x y r1)
+  | RMaybe r1 ->
+      Prop.Maybe (fol_p2 ~obs store gv lm x y r1)
 and fol_pred ~obs store gv lm x y a =
   if a = Operator.leq then
     Prop.Atom (Fol.FOrder ([Fol.Reflexive],x,y))

File src/lisql_syntax.ml

 	( _ = parse_and; lnp1 = LIST1 parse_s1 SEP parse_and; _ = parse_right_round_bracket -> NAnd (np1::lnp1)
         | _ = parse_or; lnp1 = LIST1 parse_s1 SEP parse_or; _ = parse_right_round_bracket -> NOr (np1::lnp1)
 	| _ = parse_right_round_bracket -> NAnd [np1] )
-    | "not"; _ = parse_space; np1 = parse_s1 -> NNot np1 ]
+    | "not"; _ = parse_space; np1 = parse_s1 -> NNot np1
+    | "maybe"; _ = parse_space; np1 = parse_s1 -> NMaybe np1 ]
 and parse_s2 = dcg
     [  -> Exists
     | "every"; _ = parse_space -> Forall
         | _ = parse_or; lc1 = LIST1 parse_p1 SEP parse_or; _ = parse_right_round_bracket -> Or (c1::lc1)
 	| _ = parse_right_round_bracket -> And [c1] )
     | "not"; _ = parse_space; c1 = parse_p1 -> Not c1
+    | "maybe"; _ = parse_space; c1 = parse_p1 -> Maybe c1
     | _ = parse_left_curly_bracket; c1 = parse_p1; _ = parse_right_curly_bracket -> Quote c1
     | x = parse_var; _ = parse_space; "such"; _ = parse_space; "that"; _ = parse_space; s = parse_s -> SuchThat (x,s)
     | _ = parse_is; funct = parse_uri; _ = parse_left_round_bracket; i_opt, args = parse_args when "" i_opt = None; _ = parse_right_round_bracket ->
     | "trans"; _ = parse_space; r1 = parse_p2 -> Trans r1
     | "direct"; _ = parse_space; r1 = parse_p2 -> Direct r1
     | "not"; _ = parse_space; r1 = parse_p2 -> RNot r1
+    | "maybe"; _ = parse_space; r1 = parse_p2 -> RMaybe r1
     | _ = parse_left_round_bracket; r1 = parse_p2;
 	( _ = parse_and; r2 = parse_p2; _ = parse_right_round_bracket -> RAnd (r1,r2)
         | _ = parse_or; r2 = parse_p2; _ = parse_right_round_bracket -> ROr (r1,r2)
     [ Qu (q,c) -> print_s2 of q; print_s1_c of c
     | NAnd lnp -> "("; LIST1 print_s1 SEP " and " of lnp; ")"
     | NOr lnp -> "("; LIST1 print_s1 SEP " or " of lnp; ")"
-    | NNot np1 -> "not"; print_space; print_s1 of np1 ]
+    | NNot np1 -> "not"; print_space; print_s1 of np1
+    | NMaybe np1 -> "maybe"; print_space; print_s1 of np1 ]
 and print_s2 = ipp
     [ Exists ->
     | Forall -> "every"; print_space
     | And lc -> "("; LIST1 print_p1 SEP " and " of lc; ")"
     | Or lc -> "("; LIST1 print_p1 SEP " or " of lc; ")"
     | Not c1 -> "not"; print_space; print_p1 of c1
+    | Maybe c1 -> "maybe"; print_space; print_p1 of c1
     | SuchThat (x,s) -> print_var of x; print_space; "such that"; print_space; print_s of s
     | Quote c1 -> "{ "; print_p1 of c1; " }"
     | Struct (funct,args) ->
     | Trans r1 -> "trans"; print_space; print_p2 of r1
     | Direct r1 -> "direct"; print_space; print_p2 of r1
     | Compose (r1,r2) -> "("; print_p2 of r1; print_space; print_p2 of r2; ")"
-    | RNot r1 -> "not"; print_space; print_p2 of r1
     | RAnd (r1,r2) -> "("; print_p2 of r1; " and "; print_p2 of r2; ")"
-    | ROr (r1,r2) -> "("; print_p2 of r1; " or "; print_p2 of r2; ")" ]
+    | ROr (r1,r2) -> "("; print_p2 of r1; " or "; print_p2 of r2; ")"
+    | RNot r1 -> "not"; print_space; print_p2 of r1
+    | RMaybe r1 -> "maybe"; print_space; print_p2 of r1 ]
 and print_p2_fwd = ipp
     [ a -> when a = Operator.leq then "\226\137\164"
     | a -> when a = Operator.lt then "<"