From 6698aaa3f4aad142a99f5480d0a4789c06c2978e Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 10:35:58 +0200
Subject: [PATCH 01/32] [functionality] add Functional constructor

---
 src/compiler.ml    | 11 +++++++++--
 src/parser/ast.ml  |  2 ++
 src/parser/ast.mli |  2 ++
 3 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index daab33b35..e94e0e492 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -679,7 +679,7 @@ end = struct (* {{{ *)
       | If s :: rest ->
          if r.ifexpr <> None then duplicate_err "if";
          aux_attrs { r with ifexpr = Some s } rest
-      | (External | Index _) as a :: _-> illegal_err a
+      | (External | Index _ | Functional) as a :: _-> illegal_err a
     in
     let attributes = aux_attrs { insertion = None; id = None; ifexpr = None } attributes in
     begin
@@ -702,7 +702,7 @@ end = struct (* {{{ *)
       | If s :: rest ->
          if r.cifexpr <> None then duplicate_err "if";
          aux_chr { r with cifexpr = Some s } rest
-      | (Before _ | After _ | Replace _ | Remove _ | External | Index _) as a :: _ -> illegal_err a 
+      | (Before _ | After _ | Replace _ | Remove _ | External | Index _ | Functional) as a :: _ -> illegal_err a 
     in
     let cid = Loc.show loc in 
     { c with Chr.attributes = aux_chr { cid; cifexpr = None } attributes }
@@ -733,6 +733,13 @@ end = struct (* {{{ *)
            | Some (Structured.Index _) -> duplicate_err "index"
            | Some _ -> error ~loc "external predicates cannot be indexed"
          end
+      | Functional :: rest ->
+          begin match r with
+           | None -> aux_tatt (Some Functional) rest
+           | Some (Structured.Index _) -> duplicate_err "index"
+           | Some _ -> error ~loc "external predicates cannot be indexed"
+
+         end
       | (Before _ | After _ | Replace _ | Remove _ | Name _ | If _) as a :: _ -> illegal_err a 
     in
     let attributes = aux_tatt None attributes in
diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index 63a5bc833..85886d6c9 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -164,6 +164,7 @@ type raw_attribute =
   | Remove of string
   | External
   | Index of int list * string option
+  | Functional
 [@@deriving show]
 
 module Clause = struct
@@ -342,6 +343,7 @@ and insertion_place = Before of string | After of string
 and tattribute =
   | External
   | Index of int list * tindex option
+  | Functional
 and tindex = Map | HashMap | DiscriminationTree
 and 'a shorthand = {
   iloc : Loc.t;
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index f127f581f..b77dd3b7f 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -93,6 +93,7 @@ type raw_attribute =
   | Remove of string
   | External
   | Index of int list * string option
+  | Functional
 [@@ deriving show]
 
 module Clause : sig
@@ -240,6 +241,7 @@ and cattribute = {
 and tattribute =
   | External
   | Index of int list * tindex option
+  | Functional
 and tindex = Map | HashMap | DiscriminationTree
 and 'a shorthand = {
   iloc : Loc.t;

From 5757765609ed975dcfff96f153c017872d74ea5c Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 2 Sep 2024 18:49:54 +0200
Subject: [PATCH 02/32] [functionality] add to lexer and grammar

---
 src/parser/grammar.mly   | 1 +
 src/parser/lexer.mll.in  | 1 +
 src/parser/test_lexer.ml | 1 +
 src/parser/tokens.mly    | 1 +
 4 files changed, 4 insertions(+)

diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 3e4531542..7cb6749df 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -310,6 +310,7 @@ attribute:
 | REPLACE; s = STRING { Replace s }
 | REMOVE; s = STRING { Remove s }
 | EXTERNAL { External }
+| FUNCTIONAL { Functional }
 | INDEX; LPAREN; l = nonempty_list(indexing) ; RPAREN; o = option(STRING) { Index (l,o) }
 
 indexing:
diff --git a/src/parser/lexer.mll.in b/src/parser/lexer.mll.in
index 007a25890..5aadb5b5c 100644
--- a/src/parser/lexer.mll.in
+++ b/src/parser/lexer.mll.in
@@ -172,6 +172,7 @@ and token = parse
 | "pi" { PI }
 | "sigma" { SIGMA }
 | "after" { AFTER }
+| "functional" { FUNCTIONAL }
 | "before" { BEFORE }
 | "replace" { REPLACE }
 | "remove" { REMOVE }
diff --git a/src/parser/test_lexer.ml b/src/parser/test_lexer.ml
index c972ec2d7..742473e51 100644
--- a/src/parser/test_lexer.ml
+++ b/src/parser/test_lexer.ml
@@ -49,6 +49,7 @@ type t = Tokens.token =
   | IMPORT
   | IFF
   | IF
+  | FUNCTIONAL
   | FULLSTOP
   | FRESHUV
   | FLOAT of ( float )
diff --git a/src/parser/tokens.mly b/src/parser/tokens.mly
index c1331ac41..1ba23ff4b 100644
--- a/src/parser/tokens.mly
+++ b/src/parser/tokens.mly
@@ -57,6 +57,7 @@
 %token IF
 %token BEFORE
 %token AFTER
+%token FUNCTIONAL
 %token REPLACE
 %token REMOVE
 %token NAME 

From 89b4db00129db1859aab65b8d507594bacb17ce1 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 10:54:28 +0200
Subject: [PATCH 03/32] [functionality] pass functionality and modes to the
 checker

---
 src/compiler.ml       | 127 ++++++++++++++++++++++++++++--------------
 src/elpi-checker.elpi |   2 +-
 src/parser/ast.ml     |   2 +
 src/parser/ast.mli    |   2 +
 4 files changed, 89 insertions(+), 44 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index e94e0e492..0542dd09d 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -530,6 +530,7 @@ and pbody = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : (mode * Loc.t) C.Map.t;
+  functionality : C.Set.t;
   body : block list;
   (* defined (global) symbols (including in sub blocks) *)
   symbols : C.Set.t;
@@ -553,6 +554,7 @@ type program = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : (mode * Loc.t) C.Map.t;
+  functionality : C.Set.t;
   clauses : (preterm,Ast.Structured.attribute) Ast.Clause.t list;
   chr : block_constraint list;
   local_names : int;
@@ -567,6 +569,7 @@ type program = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : (mode * Loc.t) C.Map.t;
+  functionality: C.Set.t;
   clauses : (preterm,attribute) Ast.Clause.t list;
   prolog_program : index;
   indexing : (mode * indexing) C.Map.t;
@@ -586,6 +589,7 @@ let empty () = {
   types = C.Map.empty;
   type_abbrevs = C.Map.empty;
   modes = C.Map.empty;
+  functionality = C.Set.empty;
   clauses = [];
   prolog_program = { idx = Ptmap.empty; time = 0; times = StrMap.empty };
   indexing = C.Map.empty;
@@ -616,6 +620,7 @@ type 'a query = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : mode C.Map.t;
+  functionality : C.Set.t;
   clauses : (preterm,Assembled.attribute) Ast.Clause.t list;
   prolog_program : index;
   chr : block_constraint list;
@@ -751,99 +756,103 @@ end = struct (* {{{ *)
 
 
   let run _ dl =
-    let rec aux_run ns blocks clauses macros types tabbrs modes locals chr accs = function
+    let rec aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs = function
       | Program.Ignored _ :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
       | (Program.End _ :: _ | []) as rest ->
           { body = List.rev (cl2b clauses @ blocks);
             types = List.rev types;
             type_abbrevs = List.rev tabbrs;
             macros = List.rev macros;
-            modes = List.rev modes },
+            modes = List.rev modes;
+            functionality = List.rev functionality },
           locals,
           List.rev chr,
           rest
       | Program.Begin loc :: rest ->
-          let p, locals1, chr1, rest = aux_run ns [] [] [] [] [] [] [] [] accs rest in
+          let p, locals1, chr1, rest = aux_run ns [] [] [] [] [] [] [] [] [] accs rest in
           if chr1 <> [] then
             error "CHR cannot be declared inside an anonymous block";
           aux_end_block loc ns (Locals(locals1,p) :: cl2b clauses @ blocks)
-            [] macros types tabbrs modes locals chr accs rest
+            [] macros types tabbrs modes functionality locals chr accs rest
       | Program.Constraint (loc, ctx_filter, clique) :: rest ->
           if chr <> [] then
             error "Constraint blocks cannot be nested";
-          let p, locals1, chr, rest = aux_run ns [] [] [] [] [] [] [] [] accs rest in
+          let p, locals1, chr, rest = aux_run ns [] [] [] [] [] [] [] [] [] accs rest in
           if locals1 <> [] then
             error "locals cannot be declared inside a Constraint block";
           aux_end_block loc ns (Constraints({ctx_filter;clique;rules=chr},p) :: cl2b clauses @ blocks)
-            [] macros types tabbrs modes locals [] accs rest
+            [] macros types tabbrs modes functionality locals [] accs rest
       | Program.Namespace (loc, n) :: rest ->
-          let p, locals1, chr1, rest = aux_run (n::ns) [] [] [] [] [] [] [] [] StrSet.empty rest in
+          let p, locals1, chr1, rest = aux_run (n::ns) [] [] [] [] [] [] [] [] [] StrSet.empty rest in
           if chr1 <> [] then
             error "CHR cannot be declared inside a namespace block";
           if locals1 <> [] then
             error "locals cannot be declared inside a namespace block";
           aux_end_block loc ns (Namespace (n,p) :: cl2b clauses @ blocks)
-            [] macros types tabbrs modes locals chr accs rest
+            [] macros types tabbrs modes functionality locals chr accs rest
       | Program.Shorten (loc,[]) :: _ ->
           anomaly ~loc "parser returns empty list of shorten directives"
       | Program.Shorten (loc,directives) :: rest ->
           let shorthand (full_name,short_name) = { iloc = loc; full_name; short_name } in
           let shorthands = List.map shorthand directives in
-          let p, locals1, chr1, rest = aux_run ns [] [] [] [] [] [] [] [] accs rest in
+          let p, locals1, chr1, rest = aux_run ns [] [] [] [] [] [] [] [] [] accs rest in
           if locals1 <> [] then
             error "locals cannot be declared after a shorthand";
           if chr1 <> [] then
             error "CHR cannot be declared after a shorthand";
           aux_run ns ((Shorten(shorthands,p) :: cl2b clauses @ blocks))
-            [] macros types tabbrs modes locals chr accs rest
+            [] macros types tabbrs modes functionality locals chr accs rest
 
       | Program.Accumulated (_,[]) :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
 
       | Program.Accumulated (loc,(digest,a) :: more) :: rest ->
           let rest = Program.Accumulated (loc, more) :: rest in
           let digest = String.concat "." (digest :: List.map F.show ns) in
           if StrSet.mem digest accs then
-            aux_run ns blocks clauses macros types tabbrs modes locals chr accs rest
+            aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
           else
-            aux_run ns blocks clauses macros types tabbrs modes locals chr
+            aux_run ns blocks clauses macros types tabbrs modes functionality locals chr
               (StrSet.add digest accs)
               (Program.Begin loc :: a @ Program.End loc :: rest)
 
       | Program.Clause c :: rest ->
           let c = structure_clause_attributes c in
-          aux_run ns blocks (c::clauses) macros types tabbrs modes locals chr accs rest
+          aux_run ns blocks (c::clauses) macros types tabbrs modes functionality locals chr accs rest
       | Program.Macro m :: rest ->
-          aux_run ns blocks clauses (m::macros) types tabbrs modes locals chr accs rest
+          aux_run ns blocks clauses (m::macros) types tabbrs modes functionality locals chr accs rest
       | Program.Pred (t,m) :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
             (Program.Mode [m] :: Program.Type [t] :: rest)
       | Program.Mode ms :: rest ->
-          aux_run ns blocks clauses macros types tabbrs (ms @ modes) locals chr accs rest
+          aux_run ns blocks clauses macros types tabbrs (ms @ modes) functionality locals chr accs rest
+      | Program.Functionality f :: rest ->
+          assert (0 = 1);
+          aux_run ns blocks clauses macros types tabbrs modes (f @ functionality) locals chr accs rest
       | Program.Type [] :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
       | Program.Type (t::ts) :: rest ->
           let t = structure_type_attributes t in
           let types = if List.mem t types then types else t :: types in
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
             (Program.Type ts :: rest)
       | Program.TypeAbbreviation abbr :: rest ->
-          aux_run ns blocks clauses macros types (abbr :: tabbrs) modes locals chr accs rest
+          aux_run ns blocks clauses macros types (abbr :: tabbrs) modes functionality locals chr accs rest
       | Program.Local l :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes (l@locals) chr accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality (l@locals) chr accs rest
       | Program.Chr r :: rest ->
           let r = structure_chr_attributes r in
-          aux_run ns blocks clauses macros types tabbrs modes locals (r::chr) accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals (r::chr) accs rest
 
-    and aux_end_block loc ns blocks clauses macros types tabbrs modes locals chr accs rest =
+    and aux_end_block loc ns blocks clauses macros types tabbrs modes functionality locals chr accs rest =
       match rest with
       | Program.End _ :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes locals chr accs rest
+          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
       | _ -> error ~loc "matching } is missing"
 
     in
-    let blocks, locals, chr, rest = aux_run [] [] [] [] [] [] [] [] [] StrSet.empty dl in
+    let blocks, locals, chr, rest = aux_run [] [] [] [] [] [] [] [] [] [] StrSet.empty dl in
     begin match rest with
     | [] -> ()
     | Program.End loc :: _ -> error ~loc "extra }"
@@ -948,6 +957,7 @@ module ToDBL : sig
   (* Exported since also used to flatten (here we "flatten" locals) *)
   val prefix_const : State.t -> string list -> C.t -> State.t * C.t
   val merge_modes : State.t -> (mode * Loc.t) Map.t -> (mode * Loc.t) Map.t -> (mode * Loc.t) Map.t
+  val merge_functionality : C.Set.t -> C.Set.t -> C.Set.t
   val merge_types : State.t -> 
     Types.types C.Map.t ->
     Types.types C.Map.t ->
@@ -1347,6 +1357,10 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     check_duplicate_mode state mname (args,loc) modes;
     state, C.Map.add mname (args,loc) modes
 
+  let compile_functionality (state, (functionality: C.Set.t)) name =
+    let state, mname = funct_of_ast state name in
+    state, C.Set.add mname functionality
+
   let merge_modes state m1 m2 =
     if C.Map.is_empty m1 then m2 else
     C.Map.fold (fun k v m ->
@@ -1355,6 +1369,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     m2 m1
   let merge_types _s t1 t2 =
     C.Map.union (fun _ l1 l2 -> Some (Types.merge l1 l2)) t1 t2
+  let merge_functionality m1 m2 = C.Set.union m1 m2
 
   let merge_type_abbrevs s m1 m2 =
     let len = C.Map.cardinal m1 in
@@ -1444,7 +1459,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
   let run (state : State.t) ~toplevel_macros p =
     let geti = let i = ref ~-1 in fun () -> incr i; !i in
  (* FIXME: otypes omodes - NO, rewrite spilling on data.term *)
-    let rec compile_program omacros lcs state { macros; types; type_abbrevs; modes; body } =
+    let rec compile_program omacros lcs state { macros; types; type_abbrevs; modes; body; functionality } =
       check_no_overlap_macros omacros macros;
       let active_macros =
         List.fold_left compile_macro omacros macros in
@@ -1454,6 +1469,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
         map_acc (compile_type lcs) state types in
       let types = List.fold_left (fun m t -> map_append t.Types.decl.tname t m) C.Map.empty types in
       let state, modes = List.fold_left compile_mode (state,C.Map.empty) modes in
+      let state, functionality = List.fold_left compile_functionality (state,C.Set.empty) functionality in
       let defs_m = defs_of_modes modes in
       let defs_t = defs_of_types types in
       let defs_ta = defs_of_type_abbrevs type_abbrevs in
@@ -1461,7 +1477,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
         compile_body active_macros types type_abbrevs modes lcs C.Set.empty state body in
       let symbols = C.Set.(union (union (union defs_m defs_t) defs_b) defs_ta) in
       (state : State.t), lcs, active_macros,
-      { Structured.types; type_abbrevs; modes; body; symbols }
+      { Structured.types; type_abbrevs; modes; functionality; body; symbols }
 
     and compile_body macros types type_abbrevs (modes : (mode * Loc.t) C.Map.t) lcs defs state = function
       | [] -> lcs, state, types, type_abbrevs, modes, defs, []
@@ -1669,6 +1685,9 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
 
   let apply_subst_modes ?live_symbols s m =
     C.Map.fold (fun c v m -> C.Map.add (apply_subst_constant ?live_symbols s c) v m) m C.Map.empty
+    
+  let apply_subst_functionality ?live_symbols s f =
+    C.Set.fold (fun c m -> C.Set.add (apply_subst_constant ?live_symbols s c) m) f C.Set.empty
 
   let apply_subst_chr ?live_symbols st s (l: (block_constraint)) =
     let app_sub_const f = smart_map (f (apply_subst_constant ?live_symbols s)) in
@@ -1729,7 +1748,7 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
 
   let run state
     { Structured.local_names;
-      pbody = { types; type_abbrevs; modes; body; symbols = _ };
+      pbody = { types; type_abbrevs; modes; body; functionality; symbols = _ };
       toplevel_macros;
     }
   =
@@ -1739,11 +1758,13 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
     let types = apply_subst_types ~live_symbols state empty_subst types in
     let type_abbrevs = apply_subst_type_abbrevs ~live_symbols state empty_subst type_abbrevs in
     let modes = apply_subst_modes ~live_symbols empty_subst modes in
+    let functionality = apply_subst_functionality ~live_symbols empty_subst functionality in
     let types, type_abbrevs, modes, clauses, chr =
       compile_body live_symbols state local_names types type_abbrevs modes [] [] empty_subst body in
     !live_symbols, toplevel_macros, { Flat.types;
       type_abbrevs;
       modes;
+      functionality;
       clauses;
       chr = List.rev chr;
       local_names;
@@ -1756,6 +1777,7 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
       Flat.types;
       type_abbrevs;
       modes;
+      functionality;
       clauses;
       chr;
       local_names;
@@ -1765,6 +1787,7 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
       Flat.types = apply_subst_types state f types;
       type_abbrevs = apply_subst_type_abbrevs state f type_abbrevs;
       modes = apply_subst_modes f modes;
+      functionality = apply_subst_functionality f functionality;
       clauses = apply_subst_clauses state f clauses;
       chr = smart_map (apply_subst_chr state f) chr;
       local_names;
@@ -2180,18 +2203,18 @@ let compile_clause modes initial_depth (state, index, clauses)
 
 
 let assemble flags state code  (ul : compilation_unit list) =
-
   let local_names = code.Assembled.local_names in
 
-  let state, index, indexing, clauses, types, type_abbrevs, modes, chr_rev =
-    List.fold_left (fun (state, index, idx1, clauses, t1, ta1, m1, c1) ({ symbol_table; code }  as _u) ->
-      let state, { Flat.clauses = cl2; types = t2; type_abbrevs = ta2; modes = m2; chr = c2; } =
+  let state, index, indexing, clauses, types, type_abbrevs, modes, functionality, chr_rev =
+    List.fold_left (fun (state, index, idx1, clauses, t1, ta1, m1, f1, c1) ({ symbol_table; code }  as _u) ->
+      let state, { Flat.clauses = cl2; types = t2; type_abbrevs = ta2; modes = m2; functionality = f2; chr = c2; } =
         let state, shift = Stdlib.Result.get_ok @@ Symbols.build_shift ~flags ~base:state symbol_table in
         let code =
           if C.Map.is_empty shift then code
           else Flatten.relocate state shift code in
         state, code in
       let modes = ToDBL.merge_modes state m1 m2 in
+      let functionality = ToDBL.merge_functionality f1 f2 in
       let type_abbrevs = ToDBL.merge_type_abbrevs state ta1 ta2 in
       let types = ToDBL.merge_types state t1 t2 in
 
@@ -2203,19 +2226,17 @@ let assemble flags state code  (ul : compilation_unit list) =
       let cl2 = filter_if flags clause_ifexpr cl2 in
       let cl2 = List.map (Spill.spill_clause state ~types ~modes:(fun c -> fst @@ C.Map.find c modes)) cl2 in
       let c2 = List.map (Spill.spill_chr state ~types ~modes:(fun c -> fst @@ C.Map.find c modes)) c2 in
-  
       let state, index,clauses =
         List.fold_left (compile_clause modes local_names) (state,index,clauses) cl2 in
       
-      state, index, idx2, clauses, types, type_abbrevs, modes, c2 :: c1
-    ) (state, code.Assembled.prolog_program, code.Assembled.indexing, code.clauses, code.Assembled.types, code.Assembled.type_abbrevs, code.Assembled.modes, []) ul in
+      state, index, idx2, clauses, types, type_abbrevs, modes, functionality, c2 :: c1
+    ) (state, code.prolog_program, code.indexing, code.clauses, code.types, code.type_abbrevs, code.modes, code.functionality, []) ul in
   let prolog_program = index in
-
-  let chr = List.concat (code.Assembled.chr :: List.rev chr_rev) in
+  let chr = List.concat (code.chr :: List.rev chr_rev) in
   let chr =
     let pifexpr { pifexpr } = pifexpr in
     List.map (fun {ctx_filter;clique;rules} -> {ctx_filter;clique;rules=filter_if flags pifexpr rules}) chr in
-  state, { Assembled.clauses; indexing; prolog_program; types; type_abbrevs; modes; chr; local_names = code.Assembled.local_names; toplevel_macros = code.Assembled.toplevel_macros }
+  state, { Assembled.clauses; indexing; prolog_program; types; type_abbrevs; modes; functionality; chr; local_names = code.local_names; toplevel_macros = code.toplevel_macros }
 
 end (* }}} *)
 
@@ -2419,6 +2440,7 @@ let query_of_ast (compiler_state, assembled_program) t state_update =
   {
     WithMain.types;
     modes;
+    functionality = assembled_program.Assembled.functionality;
     type_abbrevs;
     prolog_program = assembled_program.Assembled.prolog_program;
     clauses = assembled_program.Assembled.clauses;
@@ -2452,8 +2474,9 @@ let query_of_term (compiler_state, assembled_program) f =
     WithMain.types;
     type_abbrevs;
     modes;
-    prolog_program = assembled_program.Assembled.prolog_program;
-    clauses = assembled_program.Assembled.clauses;
+    functionality = assembled_program.functionality;
+    clauses = assembled_program.clauses;
+    prolog_program = assembled_program.prolog_program;
     chr = assembled_program.Assembled.chr;
     initial_depth;
     query;
@@ -2642,6 +2665,9 @@ let clausec  = D.Global_symbols.declare_global_symbol "clause"
 let checkc   = D.Global_symbols.declare_global_symbol "check"
 let colonc   = D.Global_symbols.declare_global_symbol "`:"
 let colonec  = D.Global_symbols.declare_global_symbol "`:="
+let truec    = D.Global_symbols.declare_global_symbol "true"
+let falsec   = D.Global_symbols.declare_global_symbol "false"
+let pairc    = D.Global_symbols.declare_global_symbol "pr"
 
 let mkQApp ~on_type l =
   let c = if on_type then tappc else appc in
@@ -2813,7 +2839,7 @@ let term_of_ast ~depth state text =
 ;;
 
 let static_check ~exec ~checker:(state,program)
-  ({ WithMain.types; type_abbrevs; initial_depth; compiler_state } as q) =
+  ({ WithMain.types; type_abbrevs; functionality; modes; initial_depth; compiler_state } as q) =
   let time = `Compiletime in
   let state, p,q = quote_syntax time state q in
 
@@ -2827,6 +2853,8 @@ let static_check ~exec ~checker:(state,program)
       let state, tavaluet = quote_preterm time ~compiler_state state ~on_type:true tavaluet in
       state, App(colonec, D.C.of_string (Symbols.show compiler_state name), [lam2forall tavaluet])) state
     in
+
+
   let state, tlist = C.Map.fold (fun tname l (state,tl) ->
     let l = l.Types.lst in
     let state, l =
@@ -2839,11 +2867,24 @@ let static_check ~exec ~checker:(state,program)
         state, l :: tl)
       types (state,[]) in
   let tlist = List.concat (List.rev tlist) in
+
+    (* Building functionality *)
+  let state, functionality = C.Set.fold (fun tname (state,tl) ->
+    let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
+    state, c :: tl) functionality (state,[]) in
+
+  (* Building modes *)
+  let state, modes = C.Map.fold (fun tname v (state,tl) -> 
+    let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
+    let m = List.map (function Input -> Const truec | Output -> Const falsec) v in
+    state, (App(pairc, c, [R.list_to_lp_list m])) :: tl) modes (state,[]) in
+
   let loc = Loc.initial "(static_check)" in
+  let args = q :: List.map R.list_to_lp_list [tlist; talist; modes; functionality] in
   let query =
     query_of_term (state, program) (fun ~depth state ->
       assert(depth=0);
-      state, (loc,App(checkc,R.list_to_lp_list p,[q;R.list_to_lp_list tlist;R.list_to_lp_list talist])), []) in
+      state, (loc,App(checkc,R.list_to_lp_list p, args)), []) in
   let executable = optimize_query query in
   exec executable <> Failure
 ;;
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 13462d969..9525f1803 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -348,7 +348,7 @@ compile-type-abbreviations [(S `:= T)|TS] [Clause|Clauses] :-
   compile-type-abbreviations TS Clauses.
 
 :name "check:main"
-check P Q DeclaredTypes TypeAbbreviations :-
+check P Q DeclaredTypes TypeAbbreviations Modes FuncPred :-
   compile-type-abbreviations TypeAbbreviations Abbrevs,
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
   warn-linear P, !,
diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index 85886d6c9..21c43be24 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -251,6 +251,7 @@ module Program = struct
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
     | Mode of Func.t Mode.t list
+    | Functionality of Func.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list
@@ -316,6 +317,7 @@ type program = {
   types : tattribute Type.t list;
   type_abbrevs : Func.t TypeAbbreviation.t list;
   modes : Func.t Mode.t list;
+  functionality : Func.t list;
   body : block list;
 }
 and cattribute = {
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index b77dd3b7f..b03d947ec 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -176,6 +176,7 @@ module Program : sig
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
     | Mode of Func.t Mode.t list
+    | Functionality of Func.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list
@@ -214,6 +215,7 @@ type program = {
   types : tattribute Type.t list;
   type_abbrevs : Func.t TypeAbbreviation.t list;
   modes : Func.t Mode.t list;
+  functionality : Func.t list;
   body : block list;
 }
 and block_constraint = {

From 66484be4ef9716f697cbf9253658511754373fe4 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 17 Sep 2024 16:39:01 +0200
Subject: [PATCH 04/32] [mode-checking] wip

---
 src/builtin.elpi        | 10 +++++
 src/builtin.ml          |  4 ++
 src/builtin_map.elpi    |  7 +++
 src/builtin_set.elpi    |  9 +++-
 src/builtin_stdlib.elpi |  6 ++-
 src/elpi-checker.elpi   | 99 ++++++++++++++++++++++++++++++++++++++++-
 6 files changed, 132 insertions(+), 3 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 9d1e5a8c5..77d1f3847 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -172,6 +172,8 @@ external pred ge_ i:A, i:A.
 
 type (<), (>), (=<), (>=) A -> A -> prop.
 
+mode ((<) i i). mode ((>) i i). mode ((=<) i i). mode ((>=) i i). 
+
 X  > Y  :- gt_ X Y.
 
 X  < Y  :- lt_ X Y.
@@ -182,6 +184,8 @@ X  >= Y :- ge_ X Y.
 
 type (i<), (i>), (i=<), (i>=) int -> int -> prop.
 
+mode ((i<) i i). mode ((i>) i i). mode ((i=<) i i). mode ((i>=) i i). 
+
 X i< Y  :- lt_ X Y.
 
 X i> Y  :- gt_ X Y.
@@ -192,6 +196,8 @@ X i>= Y :- ge_ X Y.
 
 type (r<), (r>), (r=<), (r>=) float -> float -> prop.
 
+mode ((r<) i i). mode ((r>) i i). mode ((r=<) i i). mode ((r>=) i i). 
+
 X r< Y  :- lt_ X Y.
 
 X r> Y  :- gt_ X Y.
@@ -202,6 +208,8 @@ X r>= Y :- ge_ X Y.
 
 type (s<), (s>), (s=<), (s>=) string -> string -> prop.
 
+mode ((s<) i i). mode ((s>) i i). mode ((s=<) i i). mode ((s>=) i i). 
+
 X s< Y  :- lt_ X Y.
 
 X s> Y  :- gt_ X Y.
@@ -660,6 +668,8 @@ map [X|XS] F [Y|YS] :- F X Y, map XS F YS.
 
 pred map-i i:list A, i:(int -> A -> B -> prop), o:list B.
 map-i L F R :- map-i.aux L 0 F R.
+
+pred map-i.aux i:list A, i:int, i:(int -> A -> B -> prop), o:list B.
 map-i.aux [] _ _ [].
 map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS.
 
diff --git a/src/builtin.ml b/src/builtin.ml
index d794e9893..f1d0739ae 100644
--- a/src/builtin.ml
+++ b/src/builtin.ml
@@ -358,24 +358,28 @@ let core_builtins = let open BuiltIn in let open ContextualConversion in [
   @ [
 
   LPCode "type (<), (>), (=<), (>=) A -> A -> prop.";
+  LPCode "mode ((<) i i). mode ((>) i i). mode ((=<) i i). mode ((>=) i i). ";
   LPCode "X  > Y  :- gt_ X Y.";
   LPCode "X  < Y  :- lt_ X Y.";
   LPCode "X  =< Y :- le_ X Y.";
   LPCode "X  >= Y :- ge_ X Y.";
 
   LPCode "type (i<), (i>), (i=<), (i>=) int -> int -> prop.";
+  LPCode "mode ((i<) i i). mode ((i>) i i). mode ((i=<) i i). mode ((i>=) i i). ";
   LPCode "X i< Y  :- lt_ X Y.";
   LPCode "X i> Y  :- gt_ X Y.";
   LPCode "X i=< Y :- le_ X Y.";
   LPCode "X i>= Y :- ge_ X Y.";
 
   LPCode "type (r<), (r>), (r=<), (r>=) float -> float -> prop.";
+  LPCode "mode ((r<) i i). mode ((r>) i i). mode ((r=<) i i). mode ((r>=) i i). ";
   LPCode "X r< Y  :- lt_ X Y.";
   LPCode "X r> Y  :- gt_ X Y.";
   LPCode "X r=< Y :- le_ X Y.";
   LPCode "X r>= Y :- ge_ X Y.";
 
   LPCode "type (s<), (s>), (s=<), (s>=) string -> string -> prop.";
+  LPCode "mode ((s<) i i). mode ((s>) i i). mode ((s=<) i i). mode ((s>=) i i). ";
   LPCode "X s< Y  :- lt_ X Y.";
   LPCode "X s> Y  :- gt_ X Y.";
   LPCode "X s=< Y :- le_ X Y.";
diff --git a/src/builtin_map.elpi b/src/builtin_map.elpi
index 9566e4652..9c0666e2d 100644
--- a/src/builtin_map.elpi
+++ b/src/builtin_map.elpi
@@ -45,6 +45,7 @@ bal L K V R T :-
   HR2 is HR + 2,
   bal.aux HL HR HL2 HR2 L K V R T.
 
+pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
 bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
   HL > HR2, {height LL} >= {height LR}, !,
   create LL LV LD {create LR X D R} T.
@@ -62,12 +63,16 @@ bal.aux _ _ _ _ L K V R T :- create L K V R T.
 pred add i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
 add empty _ K V T :- create empty K V empty T.
 add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1.
+
+pred add.aux i:cmp, i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
 add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H. 
 add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T.
 add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T.
 
 pred find i:map K V, i:(K -> K -> cmp -> prop), i:K, o:V.
 find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V.
+
+pred find.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, o:V.
 find.aux eq _   _ _ V _ V.
 find.aux lt Cmp L _ _ K V :- find L Cmp K V.
 find.aux gt Cmp _ R _ K V :- find R Cmp K V.
@@ -90,6 +95,8 @@ merge M1 M2 R :-
 pred remove i:map K V, i:(K -> K -> cmp -> prop), i:K, o:map K V.
 remove empty _ _ empty :- !.
 remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
+
+pred remove.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
 remove.aux eq _   L R _ _ _ M :- merge L R M.
 remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
 remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
diff --git a/src/builtin_set.elpi b/src/builtin_set.elpi
index db1337f9a..e9efecc33 100644
--- a/src/builtin_set.elpi
+++ b/src/builtin_set.elpi
@@ -48,6 +48,7 @@ bal L E R T :-
   HR2 is HR + 2,
   bal.aux HL HR HL2 HR2 L E R T.
 
+pred bal.aux i:int, i:int, i:int, i:int, i:set E, i:E, i:set E, o:set E.
 bal.aux HL _ _ HR2 (node LL LV LR _) X R T :-
   HL > HR2, {height LL} >= {height LR}, !,
   create LL LV {create LR X R} T.
@@ -65,13 +66,17 @@ bal.aux _ _ _ _ L E R T :- create L E R T.
 pred add i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
 add empty _ E T :- create empty E empty T.
 add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S.
-add.aux eq _ L R X _ H (node L X R H).
+
+pred add.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, i:int, o:set E.
+add.aux eq _   L R X _ H (node L X R H).
 add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T.
 add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T.
 
 pred mem i:set E, i:(E -> E -> cmp -> prop), i:E.
 mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E.
 mem.aux eq _ _ _ _.
+
+pred mem.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E.
 mem.aux lt Cmp L _ E :- mem L Cmp E.
 mem.aux gt Cmp _ R E :- mem R Cmp E.
 
@@ -93,6 +98,8 @@ merge M1 M2 R :-
 pred remove i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
 remove empty _ _ empty.
 remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M.
+
+pred remove.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, o:set E.
 remove.aux eq _   L R _ _ M :- merge L R M.
 remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M.
 remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M.
diff --git a/src/builtin_stdlib.elpi b/src/builtin_stdlib.elpi
index ff8f92f60..b67feb533 100644
--- a/src/builtin_stdlib.elpi
+++ b/src/builtin_stdlib.elpi
@@ -135,6 +135,8 @@ map [X|XS] F [Y|YS] :- F X Y, map XS F YS.
 
 pred map-i i:list A, i:(int -> A -> B -> prop), o:list B.
 map-i L F R :- map-i.aux L 0 F R.
+
+pred map-i.aux i:list A, i:int, i:(int -> A -> B -> prop), o:list B.
 map-i.aux [] _ _ [].
 map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS.
 
@@ -243,8 +245,10 @@ null [].
 
 pred iota i:int, o:list int.
 iota N L :- iota.aux 0 N L.
+
+pred iota.aux i:int, i:int, o:list int.
 iota.aux X X [] :- !.
-iota.aux N X [N|R] :- M is N + 1, iota.aux M X R.
+iota.aux N X [N|R] :- std.spy(M is N + 1), iota.aux M X R.
 
 % [intersperse X L R] R is [L0, X, ..., X, LN]
 :index(_ 1)
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 9525f1803..7c72fa210 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -213,7 +213,7 @@ pred str_concat i:list string, o:string.
 str_concat [] "".
 str_concat [S|SS] R :- str_concat SS RR, R is S ^ " " ^ RR.
 
-warn-undeclared Known (pr ( "main") _) ff :- !.
+warn-undeclared _Known (pr ( "main") _) ff :- !.
 warn-undeclared Known (pr ( S) _) ff :- rex_match ".*\\.aux" S, !.
 warn-undeclared Known (pr ( S) _) ff :- rex_match ".*\\.aux\\." S, !.
 warn-undeclared Known (pr ( S) LOC) tt :-
@@ -347,8 +347,105 @@ compile-type-abbreviations [(S `:= T)|TS] [Clause|Clauses] :-
   type->ppt-clause S [] T Clause,
   compile-type-abbreviations TS Clauses.
 
+to-constant V :- V = cdata "0".
+
+to-rigid-term N :- name N, !.
+to-rigid-term V :- var V, !, to-constant V.
+to-rigid-term (cdata (uvar _ as V)) :- !, to-constant V.
+to-rigid-term (cdata _ as N) :- !.
+to-rigid-term (app L) :- !, std.forall L to-rigid-term.
+to-rigid-term (lam F) :- !, pi x\ to-rigid-term (F x).
+to-rigid-term (const V) :- var V, !, V = "A".
+to-rigid-term (const _ as A) :- !.
+to-rigid-term A :- halt "Error in to-rigid-term" A.
+
+find-mode [] X _ :- !, halt "No mode for" X, fail.
+% find-mode [pr A _|_] D _ :- print "Looking for the mode of" D "(comparing with" A ")", fail.
+find-mode [pr X R|_] X R :- !.
+find-mode [_ | Xs] X R :- find-mode Xs X R, !.
+
+set-head-mode Head Args AllModes :-
+  find-mode AllModes Head Mode, !, 
+  std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
+set-head-mode _ _ _.
+
+variadic-mode (const "halt").
+variadic-mode (const "print").
+
+is-ho-predicate (cdata "0").
+
+check-well-modes-negative AllModes N :- name N, !.
+check-well-modes-negative AllModes V :- var V, !, to-constant V.
+check-well-modes-negative AllModes (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-modes-negative AllModes (cdata _ as N) :- !.
+check-well-modes-negative AllModes (app [const "," | L]) :- !,
+  std.forall L (x\ if (var x) (halt "Passed flexible to ,") (check-well-modes-negative AllModes x)).
+check-well-modes-negative AllModes (app [const "pi", lam B]) :- !,
+  pi x\ check-well-modes-negative AllModes (B x).
+check-well-modes-negative AllModes (app [const "=>", Hyp, Body]) :- !,
+  print "Going to check the positive term" Hyp,
+  check-well-moded-positive Hyp [] AllModes,
+  check-well-modes-negative AllModes Body.
+check-well-modes-negative _ (app [HD|_]) :- variadic-mode HD, !.
+check-well-modes-negative AllModes (app[HD|TL]) :-
+  is-ho-predicate HD, !, std.forall to-rigid-term TL. % NOTE: Here heuristic: all args are in output mode,
+                                           % i.e. they become rigid
+check-well-modes-negative AllModes (app [HD|Args]) :- !,
+  if (find-mode AllModes HD Mode) true (halt "Check-well-modes-negative: no mode for" HD),
+  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args) true, to-rigid-term t).
+check-well-modes-negative AllModes (lam F) :- !, pi x\ check-well-modes-negative AllModes (F x).
+check-well-modes-negative AllModes (const V) :- var V, !, V = "A". % NOT SURE: Rigidifying the string
+check-well-modes-negative AllModes (const _ as A) :- !.
+check-well-modes-negative AllModes A :- halt "Error in to-rigid-term" A.
+
+check-well-modes-negative-list [] _ :- !.
+check-well-modes-negative-list [X | Xs] AllModes :-
+  check-well-modes-negative AllModes X,
+  check-well-modes-negative-list Xs AllModes.
+
+to-check _ :- !, true.
+to-check (const "a") :- !.
+to-check (const "b") :- !.
+to-check (const "c") :- !.
+to-check (arg B) :- !, pi x\ to-check (B x).
+to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
+  to-check Head.
+
+check-well-moded-positive (arg B) T AllModes :- !,
+  check-well-moded-positive (B X) [X|T] AllModes.
+check-well-moded-positive (const _) _ _ :- !.
+check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) NamesRev AllModes :-
+  set-head-mode Head Args AllModes, 
+  check-well-modes-negative-list Prem AllModes, !,
+  print "After check the clause is" P.
+
+check-well-moded-positive (app [(const ":-"), (const _) | Prem]) _ AllModes :- !,
+  check-well-modes-negative-list Prem AllModes.
+check-well-moded-positive (app [(const "pi"), lam B]) _ AllModes :- !,
+  check-well-moded-positive (B X) _ AllModes. % Here positive, hence Lam is applied to a fresh variable
+check-well-moded-positive (app [(const ",") | L]) _ AllModes :- !,
+  std.forall L (x\ check-well-moded-positive x _ AllModes).
+check-well-moded-positive (app ([const "::", A, L])) X AllModes :- !,
+  check-well-moded-positive A X AllModes,
+  check-well-moded-positive L X AllModes.
+check-well-moded-positive (app _ as T) _ _ :- !, print "TODO: for" T.
+
+check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
+
+check-well-moded-prog [] _ :- !.
+check-well-moded-prog [clause _Loc _Vars Body | Tl] Modes :-
+  to-check Body, !,
+  print "Going to check" Body,
+  check-well-moded-positive Body [] Modes, !,
+  check-well-moded-prog Tl Modes.
+check-well-moded-prog [_ | Tl] Modes :-
+  check-well-moded-prog Tl Modes.
+
+check-overlapping-prog [] _ :- !.
+
 :name "check:main"
 check P Q DeclaredTypes TypeAbbreviations Modes FuncPred :-
+  check-well-moded-prog P Modes,
   compile-type-abbreviations TypeAbbreviations Abbrevs,
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
   warn-linear P, !,

From 619b9d6b0cfb0a10e30b476b969e62eb2a7ee94a Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 19 Sep 2024 10:19:04 +0200
Subject: [PATCH 05/32] [mode checker] update

---
 src/builtin.elpi        |  18 +++++-
 src/builtin_stdlib.elpi |   2 +-
 src/elpi-checker.elpi   | 140 ++++++++++++++++++++++++----------------
 3 files changed, 102 insertions(+), 58 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 77d1f3847..53a0dda16 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -778,6 +778,8 @@ null [].
 
 pred iota i:int, o:list int.
 iota N L :- iota.aux 0 N L.
+
+pred iota.aux i:int, i:int, o:list int.
 iota.aux X X [] :- !.
 iota.aux N X [N|R] :- M is N + 1, iota.aux M X R.
 
@@ -1186,6 +1188,7 @@ bal L K V R T :-
   HR2 is HR + 2,
   bal.aux HL HR HL2 HR2 L K V R T.
 
+pred bal.aux i:int, i:int, i:int, i:int, i:map K V, i:K, i:V, i:map K V, o:map K V.
 bal.aux HL _ _ HR2 (node LL LV LD LR _) X D R T :-
   HL > HR2, {height LL} >= {height LR}, !,
   create LL LV LD {create LR X D R} T.
@@ -1203,12 +1206,16 @@ bal.aux _ _ _ _ L K V R T :- create L K V R T.
 pred add i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
 add empty _ K V T :- create empty K V empty T.
 add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1.
+
+pred add.aux i:cmp, i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
 add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H. 
 add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T.
 add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T.
 
 pred find i:map K V, i:(K -> K -> cmp -> prop), i:K, o:V.
 find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V.
+
+pred find.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, o:V.
 find.aux eq _   _ _ V _ V.
 find.aux lt Cmp L _ _ K V :- find L Cmp K V.
 find.aux gt Cmp _ R _ K V :- find R Cmp K V.
@@ -1231,6 +1238,8 @@ merge M1 M2 R :-
 pred remove i:map K V, i:(K -> K -> cmp -> prop), i:K, o:map K V.
 remove empty _ _ empty :- !.
 remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
+
+pred remove.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
 remove.aux eq _   L R _ _ _ M :- merge L R M.
 remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
 remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
@@ -1296,6 +1305,7 @@ bal L E R T :-
   HR2 is HR + 2,
   bal.aux HL HR HL2 HR2 L E R T.
 
+pred bal.aux i:int, i:int, i:int, i:int, i:set E, i:E, i:set E, o:set E.
 bal.aux HL _ _ HR2 (node LL LV LR _) X R T :-
   HL > HR2, {height LL} >= {height LR}, !,
   create LL LV {create LR X R} T.
@@ -1313,13 +1323,17 @@ bal.aux _ _ _ _ L E R T :- create L E R T.
 pred add i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
 add empty _ E T :- create empty E empty T.
 add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S.
-add.aux eq _ L R X _ H (node L X R H).
+
+pred add.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, i:int, o:set E.
+add.aux eq _   L R X _ H (node L X R H).
 add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T.
 add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T.
 
 pred mem i:set E, i:(E -> E -> cmp -> prop), i:E.
 mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E.
 mem.aux eq _ _ _ _.
+
+pred mem.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E.
 mem.aux lt Cmp L _ E :- mem L Cmp E.
 mem.aux gt Cmp _ R E :- mem R Cmp E.
 
@@ -1341,6 +1355,8 @@ merge M1 M2 R :-
 pred remove i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
 remove empty _ _ empty.
 remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M.
+
+pred remove.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, o:set E.
 remove.aux eq _   L R _ _ M :- merge L R M.
 remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M.
 remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M.
diff --git a/src/builtin_stdlib.elpi b/src/builtin_stdlib.elpi
index b67feb533..088fbaddc 100644
--- a/src/builtin_stdlib.elpi
+++ b/src/builtin_stdlib.elpi
@@ -248,7 +248,7 @@ iota N L :- iota.aux 0 N L.
 
 pred iota.aux i:int, i:int, o:list int.
 iota.aux X X [] :- !.
-iota.aux N X [N|R] :- std.spy(M is N + 1), iota.aux M X R.
+iota.aux N X [N|R] :- M is N + 1, iota.aux M X R.
 
 % [intersperse X L R] R is [L0, X, ..., X, LN]
 :index(_ 1)
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 7c72fa210..7794e57f6 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -26,6 +26,7 @@ type unknown term -> err.
 type assert prop -> err -> prop.
 
 type error list (pair (ctype "Loc.t") string) -> bool -> prop.
+mode (error i o).
 
 :name "default-typechecking-error"
 error Msg tt :- std.forall Msg (x\ sigma L M\ fst x L, snd x M, print L "Error:" M).
@@ -34,6 +35,7 @@ type warning (ctype "Loc.t") -> string -> prop.
 :name "default-typechecking-warning"
 warning Loc Msg :- print Loc "Warning:" Msg.
 
+mode (assert i i).
 assert P _ :- P, !.
 assert _ (type-err T Ty ETy) :- !,
   checking LOC,
@@ -48,6 +50,7 @@ assert _ (wrong-arity T Ty A) :- !,
           " but is applied to " ^ {pp-list A},
   error [pr LOC MSG] _.
 
+mode (stash-new i i).
 stash-new E S :- open_safe E L, ( std.mem! L S ; stash_in_safe E S ), !.
 
 report-all-failures-if-no-success P RC :-
@@ -101,6 +104,7 @@ rm-any-variadic prop prop.
 rm-any-variadic (arrow A1 B1) (arrow A2 B2) :- rm-any-variadic A1 A2, rm-any-variadic B1 B2.
 rm-any-variadic (uvar as X) X.
 
+mode (rm-any-variadic-list i o).
 rm-any-variadic-list [] [].
 rm-any-variadic-list [X|XS] [Y|YS] :- rm-any-variadic X Y, rm-any-variadic-list XS YS.
 
@@ -139,6 +143,7 @@ of-app (uvar as Ty)  [] TGT HD (D - []) :- !,
 of-app Ty Args _ HD (D - []) :- !,
   assert false (wrong-arity (app [HD|D]) Ty Args).
 
+mode (of-clause i i).
 of-clause [N|NS] (arg C) :- !, pi x\ 
  (pp x N :- !) => (pi Tf\ of x Tf :- !, assert (unif T Tf) (type-err x T Tf)) =>
  of-clause NS (C x).
@@ -153,11 +158,11 @@ type checking (ctype "Loc.t") -> prop.
 log-tc-clause Loc Query :- !, print {trace.counter "run"} "typecheck" Loc Query.
 log-tc-clause _ _.
 
-
-typecheck P _ T0 NP RC :- D is {gettimeofday} - T0, D > 10.0, !,
+mode (typecheck i i i i i).
+typecheck P _ T0 NP _RC :- D is {gettimeofday} - T0, D > 10.0, !,
   print "[skipping" {std.length P} "clauses out of" NP "due to time limit]".
 
-typecheck [] (clause Loc Names Query) T0 _ RC :-
+typecheck [] (clause Loc Names Query) _ _ RC :-
   log-tc-clause Loc Query,
   checking Loc =>
     report-all-failures-if-no-success (of-clause Names Query) RC.
@@ -201,10 +206,12 @@ mode (under-env i i).
 
 type known term -> prop.
 
+mode (similar i i).
 similar S1 S2 :-
   R is ".*\\." ^ {rex_replace "[\\+\\*]" "." S2},
   rex_match R S1.
 
+mode (filter-similar i i o).
 filter-similar [] _ [].
 filter-similar [const K `: _ |KS] S [K|R] :- similar K S, !, filter-similar KS S R.
 filter-similar [_|KS] S R :- filter-similar KS S R.
@@ -213,15 +220,17 @@ pred str_concat i:list string, o:string.
 str_concat [] "".
 str_concat [S|SS] R :- str_concat SS RR, R is S ^ " " ^ RR.
 
+mode (warn-undeclared i i o).
 warn-undeclared _Known (pr ( "main") _) ff :- !.
-warn-undeclared Known (pr ( S) _) ff :- rex_match ".*\\.aux" S, !.
-warn-undeclared Known (pr ( S) _) ff :- rex_match ".*\\.aux\\." S, !.
+warn-undeclared _ (pr ( S) _) ff :- rex_match ".*\\.aux" S, !.
+warn-undeclared _ (pr ( S) _) ff :- rex_match ".*\\.aux\\." S, !.
 warn-undeclared Known (pr ( S) LOC) tt :-
   filter-similar Known S Hints,
   if (Hints = []) (H = "") (H is " Did you mean " ^ {str_concat Hints} ^ "?"),
   MSG is "constant " ^ S ^ " has no declared type." ^ H,
   warning LOC MSG.
 
+mode (forall_uto10 i i i).
 forall_uto10 [] _ _ :- !.
 forall_uto10 [X|XS] N P :- N < 10, !,
   P X Done, !,
@@ -231,6 +240,7 @@ forall_uto10 ([pr _ LOC|_] as L) _ _ :-
   Msg is "[suppressing " ^ {term_to_string {std.length L}} ^ " warnings]",
   warning LOC Msg.
   
+mode (under-decl-env i i).
 under-decl-env [] P :- P.
 under-decl-env [ X `: PT | XS ] P :-
   %print "Assume" X PT,
@@ -241,6 +251,7 @@ under-undecl-env [ pr X _ | XS ] P :-
   %print "Assume" X PT,
   (of (const X) Ty_ :- !) => under-undecl-env XS P.
 
+mode (rm-known i i o).
 rm-known (const N `: _) S S1 :- std.string.map.remove N S S1.
 
 :if "TIME:CHECKER"
@@ -251,6 +262,7 @@ pred check-all-symbols i:std.string.map loc.
 :name "check-all-symbols:main"
 check-all-symbols _.
 
+mode (typecheck-program i i i o).
 :name "typecheck-program:main"
 typecheck-program P Q DeclaredTypes RC :-
   KnownTypes = [
@@ -298,11 +310,12 @@ report-linear [(V >>> uvar) |NS] :-
 report-linear [(_ >>> _) | NS] :- report-linear NS.
 
 type count A -> list B -> prop.
+mode (count i i).
 count (lam F) E :- pi x\ count (F x) E.
 count (app [X|XS]) E :- !, count X E, count (app XS) E.
 count (app []) _ :- !.
 count X E :- variable X, !, incr X E.
-count A _.
+count _ _.
 
 mode (incr i i).
 incr X [(X >>> K) | _] :- add1 K.
@@ -312,13 +325,15 @@ mode (add1 i).
 add1 (uvar as K) :- K = 1 + FRESH_.
 add1 (1 + K) :- add1 K.
 
+mode (check-non-linear i i i).
 check-non-linear [N|NS] (arg C) L :- pi x\
  (pp x N :- !) => (variable x) => check-non-linear NS (C x) [(x >>> FRESH_) | L].
 check-non-linear [] (arg C) L :- pi x\
- (variable x) => check-non-linear NS (C x) [(x >>> FRESH_) | L].
+ (variable x) => check-non-linear _ (C x) [(x >>> FRESH_) | L].
 check-non-linear _ C L :-
   count C L, report-linear L.
 
+mode (warn-linear i).
 :name "warn-linear:main"
 warn-linear [].
 warn-linear [ (clause Loc Names Clause) |CS] :-
@@ -331,11 +346,13 @@ main.
 
 % ------- entry ---------------------------------------
 
+mode (type->ppt-clause i i i o).
 type->ppt-clause S ACC (forall F) (pi C) :- !,
   pi x\ type->ppt-clause S [x|ACC] (F x) (C x).
 type->ppt-clause S [] T (pi Str\ ppt T Str :- !, ppt (tconst S) Str).
 type->ppt-clause S ACC T (pi Str\ ppt T Str :- !, ppt (tapp [tconst S|Args]) Str) :- std.rev ACC Args.
 
+mode (compile-type-abbreviations i o).
 compile-type-abbreviations [] [].
 compile-type-abbreviations [(_ `:= tconst _)|TS] Clauses :- !,
   % we don't refold immediate aliases
@@ -349,105 +366,116 @@ compile-type-abbreviations [(S `:= T)|TS] [Clause|Clauses] :-
 
 to-constant V :- V = cdata "0".
 
+mode (to-rigid-term i).
 to-rigid-term N :- name N, !.
 to-rigid-term V :- var V, !, to-constant V.
 to-rigid-term (cdata (uvar _ as V)) :- !, to-constant V.
-to-rigid-term (cdata _ as N) :- !.
+to-rigid-term (cdata _) :- !.
 to-rigid-term (app L) :- !, std.forall L to-rigid-term.
 to-rigid-term (lam F) :- !, pi x\ to-rigid-term (F x).
-to-rigid-term (const V) :- var V, !, V = "A".
-to-rigid-term (const _ as A) :- !.
+to-rigid-term (const _) :- !.
 to-rigid-term A :- halt "Error in to-rigid-term" A.
 
-find-mode [] X _ :- !, halt "No mode for" X, fail.
-% find-mode [pr A _|_] D _ :- print "Looking for the mode of" D "(comparing with" A ")", fail.
-find-mode [pr X R|_] X R :- !.
-find-mode [_ | Xs] X R :- find-mode Xs X R, !.
+mode (build-mode i o).
+build-mode L R :- std.map L (x\r\ r = false) R.
+
+mode (find-mode i i i o).
+find-mode [] X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
+find-mode [] X Args R :- !, print "No mode for" X, build-mode Args R.
+find-mode [pr X R|_] X _ R :- !.
+find-mode [_ | Xs] X Args R :- !, find-mode Xs X Args R.
 
+mode (set-head-mode i i i).
 set-head-mode Head Args AllModes :-
-  find-mode AllModes Head Mode, !, 
+  find-mode AllModes Head Args Mode, !, 
   std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
 set-head-mode _ _ _.
 
+mode (variadic-mode i).
 variadic-mode (const "halt").
 variadic-mode (const "print").
 
+mode (is-ho-predicate i).
 is-ho-predicate (cdata "0").
 
-check-well-modes-negative AllModes N :- name N, !.
-check-well-modes-negative AllModes V :- var V, !, to-constant V.
-check-well-modes-negative AllModes (cdata (uvar _ as V)) :- !, to-constant V.
-check-well-modes-negative AllModes (cdata _ as N) :- !.
+mode (check-well-modes-negative i i).
+check-well-modes-negative _        N :- name N, !.
+check-well-modes-negative _        V :- var V, !, to-constant V.
+check-well-modes-negative _        (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-modes-negative _        (cdata _) :- !.
 check-well-modes-negative AllModes (app [const "," | L]) :- !,
   std.forall L (x\ if (var x) (halt "Passed flexible to ,") (check-well-modes-negative AllModes x)).
 check-well-modes-negative AllModes (app [const "pi", lam B]) :- !,
   pi x\ check-well-modes-negative AllModes (B x).
 check-well-modes-negative AllModes (app [const "=>", Hyp, Body]) :- !,
   print "Going to check the positive term" Hyp,
-  check-well-moded-positive Hyp [] AllModes,
+  check-well-moded-positive Hyp AllModes,
   check-well-modes-negative AllModes Body.
 check-well-modes-negative _ (app [HD|_]) :- variadic-mode HD, !.
-check-well-modes-negative AllModes (app[HD|TL]) :-
-  is-ho-predicate HD, !, std.forall to-rigid-term TL. % NOTE: Here heuristic: all args are in output mode,
-                                           % i.e. they become rigid
 check-well-modes-negative AllModes (app [HD|Args]) :- !,
-  if (find-mode AllModes HD Mode) true (halt "Check-well-modes-negative: no mode for" HD),
-  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args) true, to-rigid-term t).
+  find-mode AllModes HD Args Mode,
+  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args) (to-rigid-term t)).
 check-well-modes-negative AllModes (lam F) :- !, pi x\ check-well-modes-negative AllModes (F x).
-check-well-modes-negative AllModes (const V) :- var V, !, V = "A". % NOT SURE: Rigidifying the string
-check-well-modes-negative AllModes (const _ as A) :- !.
-check-well-modes-negative AllModes A :- halt "Error in to-rigid-term" A.
+check-well-modes-negative _        (const _ as _) :- !.
+check-well-modes-negative _         A :- halt "Error in to-rigid-term" A.
 
+mode (check-well-modes-negative-list i i).
 check-well-modes-negative-list [] _ :- !.
 check-well-modes-negative-list [X | Xs] AllModes :-
   check-well-modes-negative AllModes X,
   check-well-modes-negative-list Xs AllModes.
 
+mode (to-check i).
 to-check _ :- !, true.
-to-check (const "a") :- !.
-to-check (const "b") :- !.
-to-check (const "c") :- !.
-to-check (arg B) :- !, pi x\ to-check (B x).
-to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
-  to-check Head.
-
-check-well-moded-positive (arg B) T AllModes :- !,
-  check-well-moded-positive (B X) [X|T] AllModes.
-check-well-moded-positive (const _) _ _ :- !.
-check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) NamesRev AllModes :-
+% to-check (const "a") :- !.
+% to-check (const "b") :- !.
+% to-check (const "c") :- !.
+% to-check (arg B) :- !, pi x\ to-check (B x).
+% to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
+%   to-check Head.
+
+mode (check-well-moded-positive i i).
+check-well-moded-positive uvar _ :- halt "Got uvar in check well-moded-positive".
+check-well-moded-positive (arg B) AllModes :- !,
+  check-well-moded-positive (B X_) AllModes.
+check-well-moded-positive (const _) _ :- !.
+check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) AllModes :-
   set-head-mode Head Args AllModes, 
   check-well-modes-negative-list Prem AllModes, !,
   print "After check the clause is" P.
 
-check-well-moded-positive (app [(const ":-"), (const _) | Prem]) _ AllModes :- !,
+check-well-moded-positive (app [(const ":-"), (const _) | Prem]) AllModes :- !,
   check-well-modes-negative-list Prem AllModes.
-check-well-moded-positive (app [(const "pi"), lam B]) _ AllModes :- !,
-  check-well-moded-positive (B X) _ AllModes. % Here positive, hence Lam is applied to a fresh variable
-check-well-moded-positive (app [(const ",") | L]) _ AllModes :- !,
-  std.forall L (x\ check-well-moded-positive x _ AllModes).
-check-well-moded-positive (app ([const "::", A, L])) X AllModes :- !,
-  check-well-moded-positive A X AllModes,
-  check-well-moded-positive L X AllModes.
-check-well-moded-positive (app _ as T) _ _ :- !, print "TODO: for" T.
-
-check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
-
+check-well-moded-positive (app [(const "pi"), lam B]) AllModes :- !,
+  check-well-moded-positive (B X_) AllModes. % Here positive, hence Lam is applied to a fresh variable
+check-well-moded-positive (app [(const ",") | L]) AllModes :- !,
+  std.forall L (x\ check-well-moded-positive x AllModes).
+check-well-moded-positive (app ([const "::", A, L])) AllModes :- !,
+  check-well-moded-positive A AllModes,
+  check-well-moded-positive L AllModes.
+check-well-moded-positive (app _ as T) _ :- !, print "TODO: for" T.
+check-well-moded-positive (cdata "0") _ :- !.
+
+check-well-moded-positive A _ :- halt "check-well-moded-positive: Uncaught branch in" A.
+
+mode (check-well-moded-prog i i).
 check-well-moded-prog [] _ :- !.
-check-well-moded-prog [clause _Loc _Vars Body | Tl] Modes :-
+check-well-moded-prog [clause Loc _Vars Body | Tl] Modes :-
   to-check Body, !,
-  print "Going to check" Body,
-  check-well-moded-positive Body [] Modes, !,
+  print "Going to check" Loc Body,
+  check-well-moded-positive Body Modes, !,
   check-well-moded-prog Tl Modes.
 check-well-moded-prog [_ | Tl] Modes :-
   check-well-moded-prog Tl Modes.
 
 check-overlapping-prog [] _ :- !.
 
+mode (check i i i i i i).
 :name "check:main"
-check P Q DeclaredTypes TypeAbbreviations Modes FuncPred :-
-  check-well-moded-prog P Modes,
+check P Q DeclaredTypes TypeAbbreviations Modes _FuncPred :-
   compile-type-abbreviations TypeAbbreviations Abbrevs,
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
+  check-well-moded-prog P Modes,
   warn-linear P, !,
   if (var RC) (true) (fail).
 

From 3a7d13b9e719dc864ba4a6182aac05766c26df01 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 19 Sep 2024 12:57:39 +0200
Subject: [PATCH 06/32] [mode-checking] pass loc to error msg

---
 src/elpi-checker.elpi | 90 +++++++++++++++++++++----------------------
 1 file changed, 45 insertions(+), 45 deletions(-)

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 7794e57f6..e931f062c 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -398,32 +398,32 @@ variadic-mode (const "print").
 mode (is-ho-predicate i).
 is-ho-predicate (cdata "0").
 
-mode (check-well-modes-negative i i).
-check-well-modes-negative _        N :- name N, !.
-check-well-modes-negative _        V :- var V, !, to-constant V.
-check-well-modes-negative _        (cdata (uvar _ as V)) :- !, to-constant V.
-check-well-modes-negative _        (cdata _) :- !.
-check-well-modes-negative AllModes (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) (halt "Passed flexible to ,") (check-well-modes-negative AllModes x)).
-check-well-modes-negative AllModes (app [const "pi", lam B]) :- !,
-  pi x\ check-well-modes-negative AllModes (B x).
-check-well-modes-negative AllModes (app [const "=>", Hyp, Body]) :- !,
+mode (check-well-modes-negative i i i).
+check-well-modes-negative _ _        N :- name N, !.
+check-well-modes-negative _ _        V :- var V, !, to-constant V.
+check-well-modes-negative _ _        (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-modes-negative _ _        (cdata _) :- !.
+check-well-modes-negative AllModes Loc (app [const "," | L]) :- !,
+  std.forall L (x\ if (var x) (halt "Passed flexible to ,") (check-well-modes-negative AllModes Loc x)).
+check-well-modes-negative AllModes Loc (app [const "pi", lam B]) :- !,
+  pi x\ check-well-modes-negative AllModes Loc (B x).
+check-well-modes-negative AllModes Loc (app [const "=>", Hyp, Body]) :- !,
   print "Going to check the positive term" Hyp,
-  check-well-moded-positive Hyp AllModes,
-  check-well-modes-negative AllModes Body.
-check-well-modes-negative _ (app [HD|_]) :- variadic-mode HD, !.
-check-well-modes-negative AllModes (app [HD|Args]) :- !,
+  check-well-moded-positive Hyp AllModes Loc,
+  check-well-modes-negative AllModes Loc Body.
+check-well-modes-negative _ _ (app [HD|_]) :- variadic-mode HD, !.
+check-well-modes-negative AllModes Loc (app [HD|Args]) :- !,
   find-mode AllModes HD Args Mode,
-  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args) (to-rigid-term t)).
-check-well-modes-negative AllModes (lam F) :- !, pi x\ check-well-modes-negative AllModes (F x).
-check-well-modes-negative _        (const _ as _) :- !.
-check-well-modes-negative _         A :- halt "Error in to-rigid-term" A.
+  % TODO: go in depth if we have (f (g x)): x should be rigid if the mode of g is (i) ?
+  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args Loc) (to-rigid-term t)).
+check-well-modes-negative AllModes Loc (lam F) :- !, pi x\ check-well-modes-negative AllModes Loc (F x).
+check-well-modes-negative _ _       (const _ as _) :- !.
 
-mode (check-well-modes-negative-list i i).
-check-well-modes-negative-list [] _ :- !.
-check-well-modes-negative-list [X | Xs] AllModes :-
-  check-well-modes-negative AllModes X,
-  check-well-modes-negative-list Xs AllModes.
+mode (check-well-modes-negative-list i i i).
+check-well-modes-negative-list [] _ _ :- !.
+check-well-modes-negative-list [X | Xs] Modes Loc :-
+  check-well-modes-negative Modes Loc X,
+  check-well-modes-negative-list Xs Modes Loc.
 
 mode (to-check i).
 to-check _ :- !, true.
@@ -434,36 +434,36 @@ to-check _ :- !, true.
 % to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
 %   to-check Head.
 
-mode (check-well-moded-positive i i).
-check-well-moded-positive uvar _ :- halt "Got uvar in check well-moded-positive".
-check-well-moded-positive (arg B) AllModes :- !,
-  check-well-moded-positive (B X_) AllModes.
-check-well-moded-positive (const _) _ :- !.
-check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) AllModes :-
-  set-head-mode Head Args AllModes, 
-  check-well-modes-negative-list Prem AllModes, !,
+mode (check-well-moded-positive i i i).
+check-well-moded-positive uvar _ _ :- halt "Got uvar in check well-moded-positive".
+check-well-moded-positive (arg B) Modes Loc :- !,
+  check-well-moded-positive (B X_) Modes Loc.
+check-well-moded-positive (const _) _ _ :- !.
+check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) Modes Loc :-
+  set-head-mode Head Args Modes, 
+  check-well-modes-negative-list Prem Modes Loc, !,
   print "After check the clause is" P.
 
-check-well-moded-positive (app [(const ":-"), (const _) | Prem]) AllModes :- !,
-  check-well-modes-negative-list Prem AllModes.
-check-well-moded-positive (app [(const "pi"), lam B]) AllModes :- !,
-  check-well-moded-positive (B X_) AllModes. % Here positive, hence Lam is applied to a fresh variable
-check-well-moded-positive (app [(const ",") | L]) AllModes :- !,
-  std.forall L (x\ check-well-moded-positive x AllModes).
-check-well-moded-positive (app ([const "::", A, L])) AllModes :- !,
-  check-well-moded-positive A AllModes,
-  check-well-moded-positive L AllModes.
-check-well-moded-positive (app _ as T) _ :- !, print "TODO: for" T.
-check-well-moded-positive (cdata "0") _ :- !.
+check-well-moded-positive (app [(const ":-"), (const _) | Prem]) Modes Loc :- !,
+  check-well-modes-negative-list Prem Modes Loc.
+check-well-moded-positive (app [(const "pi"), lam B]) Modes Loc :- !,
+  check-well-moded-positive (B X_) Modes Loc. % Here positive, hence Lam is applied to a fresh variable
+check-well-moded-positive (app [(const ",") | L]) Modes Loc :- !,
+  std.forall L (x\ check-well-moded-positive x Modes Loc).
+check-well-moded-positive (app ([const "::", A, L])) Modes Loc :- !,
+  check-well-moded-positive A Modes Loc,
+  check-well-moded-positive L Modes Loc.
+check-well-moded-positive (app _ as T) _ _ :- !, print "TODO: for" T.
+check-well-moded-positive (cdata "0") _ _ :- !.
 
-check-well-moded-positive A _ :- halt "check-well-moded-positive: Uncaught branch in" A.
+check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
 
 mode (check-well-moded-prog i i).
 check-well-moded-prog [] _ :- !.
 check-well-moded-prog [clause Loc _Vars Body | Tl] Modes :-
   to-check Body, !,
-  print "Going to check" Loc Body,
-  check-well-moded-positive Body Modes, !,
+  % print "Going to check" Loc Body,
+  check-well-moded-positive Body Modes Loc, !,
   check-well-moded-prog Tl Modes.
 check-well-moded-prog [_ | Tl] Modes :-
   check-well-moded-prog Tl Modes.

From 31e4177a4628c8af2c49ee2254ff4169cbf64629 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 19 Sep 2024 12:57:57 +0200
Subject: [PATCH 07/32] [mode-checking] check head output mode is rigid

---
 src/elpi-checker.elpi | 163 +++++++++++++++++++++++++-----------------
 1 file changed, 98 insertions(+), 65 deletions(-)

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index e931f062c..0e40dca46 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -31,6 +31,7 @@ mode (error i o).
 :name "default-typechecking-error"
 error Msg tt :- std.forall Msg (x\ sigma L M\ fst x L, snd x M, print L "Error:" M).
 
+mode (warning i i).
 type warning (ctype "Loc.t") -> string -> prop.
 :name "default-typechecking-warning"
 warning Loc Msg :- print Loc "Warning:" Msg.
@@ -177,6 +178,7 @@ refresh (forall F) T :- !, refresh (F FRESH_) T.
 refresh (tconst "any") FRESH_ :- !.
 refresh X X.
 
+% mode (safe-dest-app i o o).
 safe-dest-app (app [X | A]) X A :- !.
 safe-dest-app X X [].
 
@@ -364,7 +366,9 @@ compile-type-abbreviations [(S `:= T)|TS] [Clause|Clauses] :-
   type->ppt-clause S [] T Clause,
   compile-type-abbreviations TS Clauses.
 
-to-constant V :- V = cdata "0".
+macro @rigid-term :- (cdata "rigid-term").
+
+to-constant V :- V = @rigid-term.
 
 mode (to-rigid-term i).
 to-rigid-term N :- name N, !.
@@ -376,54 +380,84 @@ to-rigid-term (lam F) :- !, pi x\ to-rigid-term (F x).
 to-rigid-term (const _) :- !.
 to-rigid-term A :- halt "Error in to-rigid-term" A.
 
+mode (is-rigid-term i).
+is-rigid-term N :- name N, !.
+is-rigid-term V :- var V, !, fail.
+is-rigid-term (cdata (uvar _ as V)) :- !, to-constant V.
+is-rigid-term (cdata _) :- !.
+is-rigid-term (app L) :- !, std.forall L is-rigid-term.
+is-rigid-term (lam F) :- !, pi x\ is-rigid-term (F x).
+is-rigid-term (const _) :- !.
+is-rigid-term A :- halt "Error in is-rigid-term" A.
+
 mode (build-mode i o).
 build-mode L R :- std.map L (x\r\ r = false) R.
 
-mode (find-mode i i i o).
-find-mode [] X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
-find-mode [] X Args R :- !, print "No mode for" X, build-mode Args R.
-find-mode [pr X R|_] X _ R :- !.
-find-mode [_ | Xs] X Args R :- !, find-mode Xs X Args R.
-
-mode (set-head-mode i i i).
-set-head-mode Head Args AllModes :-
-  find-mode AllModes Head Args Mode, !, 
+pred add-no-modes o:list A, i:A.
+add-no-modes X T :- var X, !, X = [T|Y_], print "No mode for" T.
+add-no-modes [X|_] Y :- not (var X), X = Y, !.
+add-no-modes [X|Xs] T :- var Xs, !, print "No mode for" X, Xs = [T|Y_].
+add-no-modes [_|Xs] T :- !, add-no-modes Xs T.
+
+mode (find-mode i i i i o).
+find-mode [] NoModesz_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
+find-mode [] NoModes X Args R :- !, add-no-modes NoModes X, build-mode Args R .
+find-mode [pr X R|_] _ X _ R :- !.
+find-mode [_ | Xs] NoModes X Args R :- !, find-mode Xs NoModes X Args R.
+
+mode (set-head-mode i i i i).
+set-head-mode NoModes Head Args AllModes :-
+  find-mode AllModes NoModes Head Args Mode, !,
   std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
-set-head-mode _ _ _.
+set-head-mode _ _ _ _.
+
+mode (check-head-output i i i i i).
+check-head-output NoModes Head Args AllModes Loc :-
+  find-mode AllModes NoModes Head Args Mode, !, 
+  std.forall2 Mode Args (m\t\ 
+    if m true (if (is-rigid-term t) true (print "There is an output of\"" Head "\"that is not rigid" Args Loc))).
+check-head-output _ _ _ _ _.
 
 mode (variadic-mode i).
 variadic-mode (const "halt").
 variadic-mode (const "print").
 
 mode (is-ho-predicate i).
-is-ho-predicate (cdata "0").
-
-mode (check-well-modes-negative i i i).
-check-well-modes-negative _ _        N :- name N, !.
-check-well-modes-negative _ _        V :- var V, !, to-constant V.
-check-well-modes-negative _ _        (cdata (uvar _ as V)) :- !, to-constant V.
-check-well-modes-negative _ _        (cdata _) :- !.
-check-well-modes-negative AllModes Loc (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) (halt "Passed flexible to ,") (check-well-modes-negative AllModes Loc x)).
-check-well-modes-negative AllModes Loc (app [const "pi", lam B]) :- !,
-  pi x\ check-well-modes-negative AllModes Loc (B x).
-check-well-modes-negative AllModes Loc (app [const "=>", Hyp, Body]) :- !,
-  print "Going to check the positive term" Hyp,
-  check-well-moded-positive Hyp AllModes Loc,
-  check-well-modes-negative AllModes Loc Body.
-check-well-modes-negative _ _ (app [HD|_]) :- variadic-mode HD, !.
-check-well-modes-negative AllModes Loc (app [HD|Args]) :- !,
-  find-mode AllModes HD Args Mode,
+is-ho-predicate (@rigid-term).
+
+pred map-var o:A, i:string, o:prop.
+map-var V S R :- var V, !, R = (get-str X S :- X == V).
+
+pred get-str o:A, o:string.
+
+mode (check-well-modes-negative i i i i).
+check-well-modes-negative _ _ _        N :- name N, !.
+% check-well-modes-negative _ _ _        V :- var V, !, to-constant V.
+check-well-modes-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-modes-negative _ _ _        (cdata _) :- !.
+check-well-modes-negative NoModes AllModes Loc (app [const "," | L]) :- !,
+  std.forall L (x\ if (var x) (halt "Passed flexible to ," Loc) (check-well-modes-negative NoModes AllModes Loc x)).
+check-well-modes-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
+  pi x\ check-well-modes-negative NoModes AllModes Loc (B x).
+check-well-modes-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
+  check-well-moded-positive NoModes Hyp AllModes Loc [],
+  check-well-modes-negative NoModes AllModes Loc Body.
+check-well-modes-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
+check-well-modes-negative NoModes AllModes Loc (app [HD|Args]) :- !,
+  find-mode AllModes NoModes HD Args Mode,
   % TODO: go in depth if we have (f (g x)): x should be rigid if the mode of g is (i) ?
-  std.forall2 Mode Args (m\t\ if (m, var t) (halt "Invalid mode call for" HD Args Loc) (to-rigid-term t)).
-check-well-modes-negative AllModes Loc (lam F) :- !, pi x\ check-well-modes-negative AllModes Loc (F x).
-check-well-modes-negative _ _       (const _ as _) :- !.
-
-mode (check-well-modes-negative-list i i i).
-check-well-modes-negative-list [] _ _ :- !.
-check-well-modes-negative-list [X | Xs] Modes Loc :-
-  check-well-modes-negative Modes Loc X,
-  check-well-modes-negative-list Xs Modes Loc.
+  std.forall2 Mode Args (m\t\ if (m, var t) (
+    std.map Args get-str Args',
+    halt "Invalid mode call for" HD Args' Loc
+  ) (to-rigid-term t)).
+check-well-modes-negative NoModes AllModes Loc (lam F) :- !, pi x\ check-well-modes-negative NoModes AllModes Loc (F x).
+check-well-modes-negative _ _ _       (const _ as _) :- !.
+
+mode (check-well-modes-negative-list i i i i).
+check-well-modes-negative-list [] _ _ _ :- !.
+check-well-modes-negative-list [X | Xs] NoModes Modes Loc :-
+  check-well-modes-negative NoModes Modes Loc X,
+  check-well-modes-negative-list Xs NoModes Modes Loc.
 
 mode (to-check i).
 to-check _ :- !, true.
@@ -434,38 +468,37 @@ to-check _ :- !, true.
 % to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
 %   to-check Head.
 
-mode (check-well-moded-positive i i i).
-check-well-moded-positive uvar _ _ :- halt "Got uvar in check well-moded-positive".
-check-well-moded-positive (arg B) Modes Loc :- !,
-  check-well-moded-positive (B X_) Modes Loc.
-check-well-moded-positive (const _) _ _ :- !.
-check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem] as P) Modes Loc :-
-  set-head-mode Head Args Modes, 
-  check-well-modes-negative-list Prem Modes Loc, !,
-  print "After check the clause is" P.
-
-check-well-moded-positive (app [(const ":-"), (const _) | Prem]) Modes Loc :- !,
-  check-well-modes-negative-list Prem Modes Loc.
-check-well-moded-positive (app [(const "pi"), lam B]) Modes Loc :- !,
-  check-well-moded-positive (B X_) Modes Loc. % Here positive, hence Lam is applied to a fresh variable
-check-well-moded-positive (app [(const ",") | L]) Modes Loc :- !,
-  std.forall L (x\ check-well-moded-positive x Modes Loc).
-check-well-moded-positive (app ([const "::", A, L])) Modes Loc :- !,
-  check-well-moded-positive A Modes Loc,
-  check-well-moded-positive L Modes Loc.
-check-well-moded-positive (app _ as T) _ _ :- !, print "TODO: for" T.
-check-well-moded-positive (cdata "0") _ _ :- !.
-
-check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
+% mode (check-well-moded-positive i i i i).
+pred check-well-moded-positive o:A, i:B, i:C, i:D, i:E.
+check-well-moded-positive _ X _ _ _ :- var X, halt "Got uvar in check well-moded-positive".
+check-well-moded-positive NoModes (arg B) Modes Loc [N|Names] :- !,
+  map-var X N P,
+  P => check-well-moded-positive NoModes (B X) Modes Loc Names.
+check-well-moded-positive _ (const _) _ _ _ :- !.
+check-well-moded-positive NoModes (app [(const ":-"), (app [Head | Args]) | Prem]) Modes Loc Names_ :-
+  set-head-mode NoModes Head Args Modes, 
+  check-well-modes-negative-list Prem NoModes Modes Loc,
+  check-head-output NoModes Head Args Modes Loc.
+check-well-moded-positive NoModes (app [(const ":-"), (const _) | Prem]) Modes Loc Names_ :- !,
+   check-well-modes-negative-list Prem NoModes Modes Loc.
+check-well-moded-positive NoModes (app [(const "pi"), lam B]) Modes Loc Names :- !,
+  check-well-moded-positive NoModes (B X_) Modes Loc Names.
+check-well-moded-positive NoModes (app [(const ",") | L]) Modes Loc Names :- !,
+  std.forall L (x\ check-well-moded-positive NoModes x Modes Loc Names).
+check-well-moded-positive NoModes (app ([const "::", A, L])) Modes Loc Names :- !,
+  check-well-moded-positive NoModes A Modes Loc Names,
+  check-well-moded-positive NoModes L Modes Loc Names.
+check-well-moded-positive _ (app _) _ _ _ :- !. % print "TODO: for" T.
+check-well-moded-positive _ (@rigid-term) _ _ _ :- !.
+
+check-well-moded-positive _ A _ _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
 
 mode (check-well-moded-prog i i).
 check-well-moded-prog [] _ :- !.
-check-well-moded-prog [clause Loc _Vars Body | Tl] Modes :-
+check-well-moded-prog [clause Loc Vars Body | Tl] Modes :-
   to-check Body, !,
   % print "Going to check" Loc Body,
-  check-well-moded-positive Body Modes Loc, !,
-  check-well-moded-prog Tl Modes.
-check-well-moded-prog [_ | Tl] Modes :-
+  check-well-moded-positive NoModes_ Body Modes Loc Vars, !,
   check-well-moded-prog Tl Modes.
 
 check-overlapping-prog [] _ :- !.

From 90cc0aff412042fcb0e705f9e81402c3695d948c Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 19 Sep 2024 14:10:31 +0200
Subject: [PATCH 08/32] [mode-checking] non-fatal mode checker

---
 src/builtin.elpi      |  2 +-
 src/builtin.ml        |  2 +-
 src/elpi-checker.elpi | 29 ++++++++++++++++-------------
 3 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 53a0dda16..967e3d25a 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -25,7 +25,7 @@ typeabbrev string (ctype "string").
 typeabbrev float (ctype "float").
 
 
-pred (;) o:prop, o:prop.
+pred (;) i:prop, i:prop.
 
 (A ; _) :- A.
 
diff --git a/src/builtin.ml b/src/builtin.ml
index f1d0739ae..01aad7f37 100644
--- a/src/builtin.ml
+++ b/src/builtin.ml
@@ -277,7 +277,7 @@ let core_builtins = let open BuiltIn in let open ContextualConversion in [
   MLData BuiltInData.string;
   MLData BuiltInData.float;
 
-  LPCode "pred (;) o:prop, o:prop.";
+  LPCode "pred (;) i:prop, i:prop.";
   LPCode "(A ; _) :- A.";
   LPCode "(_ ; B) :- B.";
 
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 0e40dca46..aa10415d8 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -399,13 +399,13 @@ add-no-modes [X|_] Y :- not (var X), X = Y, !.
 add-no-modes [X|Xs] T :- var Xs, !, print "No mode for" X, Xs = [T|Y_].
 add-no-modes [_|Xs] T :- !, add-no-modes Xs T.
 
-mode (find-mode i i i i o).
-find-mode [] NoModesz_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
+mode (find-mode i o i i o).
+find-mode [] NoModes_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
 find-mode [] NoModes X Args R :- !, add-no-modes NoModes X, build-mode Args R .
 find-mode [pr X R|_] _ X _ R :- !.
 find-mode [_ | Xs] NoModes X Args R :- !, find-mode Xs NoModes X Args R.
 
-mode (set-head-mode i i i i).
+mode (set-head-mode o i i i).
 set-head-mode NoModes Head Args AllModes :-
   find-mode AllModes NoModes Head Args Mode, !,
   std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
@@ -414,8 +414,10 @@ set-head-mode _ _ _ _.
 mode (check-head-output i i i i i).
 check-head-output NoModes Head Args AllModes Loc :-
   find-mode AllModes NoModes Head Args Mode, !, 
-  std.forall2 Mode Args (m\t\ 
-    if m true (if (is-rigid-term t) true (print "There is an output of\"" Head "\"that is not rigid" Args Loc))).
+  std.forall2 Mode Args (m\t\ sigma Args'\
+    if m true (if (is-rigid-term t) true (
+      std.assert!(std.map Args get-str Args') "Should not fail",
+      print "There is an output of\"" Head "\"that is not rigid" Args' Loc))).
 check-head-output _ _ _ _ _.
 
 mode (variadic-mode i).
@@ -426,17 +428,18 @@ mode (is-ho-predicate i).
 is-ho-predicate (@rigid-term).
 
 pred map-var o:A, i:string, o:prop.
-map-var V S R :- var V, !, R = (get-str X S :- X == V).
+map-var V S R :- var V, !, R = (get-str X (cdata S) :- X == V, !).
 
-pred get-str o:A, o:string.
+pred get-str o:A, o:term.
+get-str X X :- not (var X), !.
 
-mode (check-well-modes-negative i i i i).
+mode (check-well-modes-negative o i i i).
 check-well-modes-negative _ _ _        N :- name N, !.
 % check-well-modes-negative _ _ _        V :- var V, !, to-constant V.
 check-well-modes-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
 check-well-modes-negative _ _ _        (cdata _) :- !.
 check-well-modes-negative NoModes AllModes Loc (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) (halt "Passed flexible to ," Loc) (check-well-modes-negative NoModes AllModes Loc x)).
+  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) (check-well-modes-negative NoModes AllModes Loc x)).
 check-well-modes-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
   pi x\ check-well-modes-negative NoModes AllModes Loc (B x).
 check-well-modes-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
@@ -446,14 +449,14 @@ check-well-modes-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
 check-well-modes-negative NoModes AllModes Loc (app [HD|Args]) :- !,
   find-mode AllModes NoModes HD Args Mode,
   % TODO: go in depth if we have (f (g x)): x should be rigid if the mode of g is (i) ?
-  std.forall2 Mode Args (m\t\ if (m, var t) (
-    std.map Args get-str Args',
-    halt "Invalid mode call for" HD Args' Loc
+  std.forall2 Mode Args (m\t\ sigma Args'\ if (m, var t) (
+    std.assert!(std.map Args get-str Args') "Should not fail",
+    if (fatal-no-mode) (halt "INVALID MODE CALL FOR" HD Args' Loc) (print "INVALID MODE CALL FOR" HD Args' Loc)
   ) (to-rigid-term t)).
 check-well-modes-negative NoModes AllModes Loc (lam F) :- !, pi x\ check-well-modes-negative NoModes AllModes Loc (F x).
 check-well-modes-negative _ _ _       (const _ as _) :- !.
 
-mode (check-well-modes-negative-list i i i i).
+mode (check-well-modes-negative-list i o i i).
 check-well-modes-negative-list [] _ _ _ :- !.
 check-well-modes-negative-list [X | Xs] NoModes Modes Loc :-
   check-well-modes-negative NoModes Modes Loc X,

From 53a68abbf5a354d2034efb4a72d6f64f4a8231f2 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Fri, 20 Sep 2024 09:15:56 +0200
Subject: [PATCH 09/32] [mode-checking] better get-str + some rename

---
 src/elpi-checker.elpi | 89 ++++++++++++++++++++++++++-----------------
 1 file changed, 54 insertions(+), 35 deletions(-)

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index aa10415d8..17e3908b5 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -428,39 +428,58 @@ mode (is-ho-predicate i).
 is-ho-predicate (@rigid-term).
 
 pred map-var o:A, i:string, o:prop.
-map-var V S R :- var V, !, R = (get-str X (cdata S) :- X == V, !).
-
-pred get-str o:A, o:term.
-get-str X X :- not (var X), !.
-
-mode (check-well-modes-negative o i i i).
-check-well-modes-negative _ _ _        N :- name N, !.
-% check-well-modes-negative _ _ _        V :- var V, !, to-constant V.
-check-well-modes-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
-check-well-modes-negative _ _ _        (cdata _) :- !.
-check-well-modes-negative NoModes AllModes Loc (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) (check-well-modes-negative NoModes AllModes Loc x)).
-check-well-modes-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
-  pi x\ check-well-modes-negative NoModes AllModes Loc (B x).
-check-well-modes-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
+map-var V S R :- var V, !, R = (get-str X (cdata S) :- same_term X V, !).
+
+pred get-str i:term, o:term.
+get-str N N :- name N, !.
+get-str (cdata _ as X) X :- !.
+get-str (app L) (app L'):- !, std.map L get-str L'.
+get-str (lam F) (lam F') :- !, pi x\ get-str (F x) (F' x).
+get-str (const T) (const T) :- !.
+get-str A A :- var A, !.
+get-str A _ :- halt "Error in get-str" A.
+
+pred check-args-mode i:D, o:A, i:B, i:C, i:prop, i:term.
+check-args-mode HD _ _ Loc Mode Arg :-
+  Mode, var Arg, !,
+  std.assert!(get-str Arg Arg') "Should not fail",
+  if (fatal-no-mode) (halt "WARNING: Flex arg" Arg' "passed to" HD Loc) (print "WARNING: Flex arg" Arg' "passed to" HD Loc).
+% TODO: following rule aims to go under lambda which are args of a predicate
+%       however, this is gives a error if partial application is used
+% check-args-mode _ NoModes AllModes Loc Mode Arg :-
+%   Mode, Arg = lam L, !,
+%   print ("Going under lambda") Arg,
+%   pi x\ std.assert!(check-well-moded-negative NoModes AllModes Loc (L x)) "Should not fail".
+check-args-mode _ _ _ _ Mode Arg :- Mode, !.
+check-args-mode _ _ _ _ Mode Arg :- 
+  not Mode, to-rigid-term Arg.
+
+mode (check-well-moded-negative o i i i).
+check-well-moded-negative _ _ _        N :- name N, !.
+% check-well-moded-negative _ _ _        V :- var V, !, to-constant V.
+check-well-moded-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-moded-negative _ _ _        (cdata _) :- !.
+check-well-moded-negative NoModes AllModes Loc (app [const "," | L]) :- !,
+  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) (check-well-moded-negative NoModes AllModes Loc x)).
+check-well-moded-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
+  pi x\ check-well-moded-negative NoModes AllModes Loc (B x).
+check-well-moded-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
   check-well-moded-positive NoModes Hyp AllModes Loc [],
-  check-well-modes-negative NoModes AllModes Loc Body.
-check-well-modes-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
-check-well-modes-negative NoModes AllModes Loc (app [HD|Args]) :- !,
+  check-well-moded-negative NoModes AllModes Loc Body.
+check-well-moded-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
+check-well-moded-negative NoModes AllModes Loc (app [HD|Args]) :- !,
   find-mode AllModes NoModes HD Args Mode,
-  % TODO: go in depth if we have (f (g x)): x should be rigid if the mode of g is (i) ?
-  std.forall2 Mode Args (m\t\ sigma Args'\ if (m, var t) (
-    std.assert!(std.map Args get-str Args') "Should not fail",
-    if (fatal-no-mode) (halt "INVALID MODE CALL FOR" HD Args' Loc) (print "INVALID MODE CALL FOR" HD Args' Loc)
-  ) (to-rigid-term t)).
-check-well-modes-negative NoModes AllModes Loc (lam F) :- !, pi x\ check-well-modes-negative NoModes AllModes Loc (F x).
-check-well-modes-negative _ _ _       (const _ as _) :- !.
-
-mode (check-well-modes-negative-list i o i i).
-check-well-modes-negative-list [] _ _ _ :- !.
-check-well-modes-negative-list [X | Xs] NoModes Modes Loc :-
-  check-well-modes-negative NoModes Modes Loc X,
-  check-well-modes-negative-list Xs NoModes Modes Loc.
+  if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for" HD Loc),
+  std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh").
+check-well-moded-negative NoModes AllModes Loc (lam F) :- !, 
+  pi x\ check-well-moded-negative NoModes AllModes Loc (F x).
+check-well-moded-negative _ _ _       (const _ as _) :- !.
+
+mode (check-well-moded-negative-list i o i i).
+check-well-moded-negative-list [] _ _ _ :- !.
+check-well-moded-negative-list [X | Xs] NoModes Modes Loc :-
+  check-well-moded-negative NoModes Modes Loc X,
+  check-well-moded-negative-list Xs NoModes Modes Loc.
 
 mode (to-check i).
 to-check _ :- !, true.
@@ -480,10 +499,10 @@ check-well-moded-positive NoModes (arg B) Modes Loc [N|Names] :- !,
 check-well-moded-positive _ (const _) _ _ _ :- !.
 check-well-moded-positive NoModes (app [(const ":-"), (app [Head | Args]) | Prem]) Modes Loc Names_ :-
   set-head-mode NoModes Head Args Modes, 
-  check-well-modes-negative-list Prem NoModes Modes Loc,
+  check-well-moded-negative-list Prem NoModes Modes Loc,
   check-head-output NoModes Head Args Modes Loc.
 check-well-moded-positive NoModes (app [(const ":-"), (const _) | Prem]) Modes Loc Names_ :- !,
-   check-well-modes-negative-list Prem NoModes Modes Loc.
+   check-well-moded-negative-list Prem NoModes Modes Loc.
 check-well-moded-positive NoModes (app [(const "pi"), lam B]) Modes Loc Names :- !,
   check-well-moded-positive NoModes (B X_) Modes Loc Names.
 check-well-moded-positive NoModes (app [(const ",") | L]) Modes Loc Names :- !,
@@ -511,8 +530,8 @@ mode (check i i i i i i).
 check P Q DeclaredTypes TypeAbbreviations Modes _FuncPred :-
   compile-type-abbreviations TypeAbbreviations Abbrevs,
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
-  check-well-moded-prog P Modes,
   warn-linear P, !,
-  if (var RC) (true) (fail).
+  if (var RC) (true) (fail),
+  check-well-moded-prog P Modes.
 
 % vim: set ft=lprolog:

From 81ff6b8d09d0bb446fdff7a7fbebdb32b51ad34f Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 23 Sep 2024 10:03:12 +0200
Subject: [PATCH 10/32] [mode-checking] update checker

---
 src/elpi-checker.elpi | 44 +++++++++++++++++++++++++++++--------------
 1 file changed, 30 insertions(+), 14 deletions(-)

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 17e3908b5..8a213617a 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -411,13 +411,22 @@ set-head-mode NoModes Head Args AllModes :-
   std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
 set-head-mode _ _ _ _.
 
+pred get-vars i:term, o:list term.
+get-vars N [] :- name N, !.
+get-vars (cdata _ as X) [] :- !.
+get-vars (app L) L'' :- !, std.map L get-vars L', std.flatten L' L''.
+get-vars (lam F) L :- !, pi x\ get-vars (F x) L.
+get-vars (const T) [] :- !.
+get-vars A [B] :- var A, !, get-str A B.
+get-vars A _ :- halt "Error in get-vars" A.
+
 mode (check-head-output i i i i i).
 check-head-output NoModes Head Args AllModes Loc :-
   find-mode AllModes NoModes Head Args Mode, !, 
-  std.forall2 Mode Args (m\t\ sigma Args'\
-    if m true (if (is-rigid-term t) true (
-      std.assert!(std.map Args get-str Args') "Should not fail",
-      print "There is an output of\"" Head "\"that is not rigid" Args' Loc))).
+  std.forall2 Mode Args (m\t\ sigma Vars\
+    std.assert! (get-vars t Vars) "Should not fail",
+    if m true (if (Vars = []) true (
+      print "WARNING: The variables" Vars "are is output position of the predicate\"" Head "\"and cannot be ensured to be ground" Loc))).
 check-head-output _ _ _ _ _.
 
 mode (variadic-mode i).
@@ -428,7 +437,7 @@ mode (is-ho-predicate i).
 is-ho-predicate (@rigid-term).
 
 pred map-var o:A, i:string, o:prop.
-map-var V S R :- var V, !, R = (get-str X (cdata S) :- same_term X V, !).
+map-var V S R :- var V, !, R = (get-str X (cdata S) :- var V, same_term X V, !).
 
 pred get-str i:term, o:term.
 get-str N N :- name N, !.
@@ -460,7 +469,8 @@ check-well-moded-negative _ _ _        N :- name N, !.
 check-well-moded-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
 check-well-moded-negative _ _ _        (cdata _) :- !.
 check-well-moded-negative NoModes AllModes Loc (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) (check-well-moded-negative NoModes AllModes Loc x)).
+  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) 
+  (check-well-moded-negative NoModes AllModes Loc x)).
 check-well-moded-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
   pi x\ check-well-moded-negative NoModes AllModes Loc (B x).
 check-well-moded-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
@@ -468,6 +478,10 @@ check-well-moded-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :-
   check-well-moded-negative NoModes AllModes Loc Body.
 check-well-moded-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
 check-well-moded-negative NoModes AllModes Loc (app [HD|Args]) :- !,
+  % print "Checking mode of" HD Args,
+  if (var HD) 
+    (if (fatal-no-mode) (halt "WARNING: Flex head symbol" HD "at" Loc) (print "WARNING: Flex head symbol" HD "at" Loc))
+    true,
   find-mode AllModes NoModes HD Args Mode,
   if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for" HD Loc),
   std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh").
@@ -492,12 +506,13 @@ to-check _ :- !, true.
 
 % mode (check-well-moded-positive i i i i).
 pred check-well-moded-positive o:A, i:B, i:C, i:D, i:E.
-check-well-moded-positive _ X _ _ _ :- var X, halt "Got uvar in check well-moded-positive".
+check-well-moded-positive _ X _ Loc _ :- var X, print "WARNING: Got uvar in check well-moded-positive" Loc.
 check-well-moded-positive NoModes (arg B) Modes Loc [N|Names] :- !,
   map-var X N P,
   P => check-well-moded-positive NoModes (B X) Modes Loc Names.
 check-well-moded-positive _ (const _) _ _ _ :- !.
 check-well-moded-positive NoModes (app [(const ":-"), (app [Head | Args]) | Prem]) Modes Loc Names_ :-
+  % print "Checking mode positive of" Head Args ":-" Prem,
   set-head-mode NoModes Head Args Modes, 
   check-well-moded-negative-list Prem NoModes Modes Loc,
   check-head-output NoModes Head Args Modes Loc.
@@ -515,13 +530,14 @@ check-well-moded-positive _ (@rigid-term) _ _ _ :- !.
 
 check-well-moded-positive _ A _ _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
 
-mode (check-well-moded-prog i i).
-check-well-moded-prog [] _ :- !.
-check-well-moded-prog [clause Loc Vars Body | Tl] Modes :-
+mode (check-well-moded-prog i o i).
+check-well-moded-prog [] _ _ :- !.
+check-well-moded-prog [clause Loc Vars Body | Tl] NoModes Modes :-
   to-check Body, !,
-  % print "Going to check" Loc Body,
-  check-well-moded-positive NoModes_ Body Modes Loc Vars, !,
-  check-well-moded-prog Tl Modes.
+  % print "====================================================",
+  % print "Going to check" Loc Vars Body,
+  check-well-moded-positive NoModes Body Modes Loc Vars, !,
+  check-well-moded-prog Tl NoModes Modes.
 
 check-overlapping-prog [] _ :- !.
 
@@ -532,6 +548,6 @@ check P Q DeclaredTypes TypeAbbreviations Modes _FuncPred :-
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
   warn-linear P, !,
   if (var RC) (true) (fail),
-  check-well-moded-prog P Modes.
+  check-well-moded-prog P NoModes_ Modes.
 
 % vim: set ft=lprolog:

From 3b3fdeef98c3e3558e8fc8f736e86675a2bddae9 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 12:38:29 +0200
Subject: [PATCH 11/32] [mode-checking] test promotion

---
 tests/sources/trace_findall.elab.json | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/tests/sources/trace_findall.elab.json b/tests/sources/trace_findall.elab.json
index 342a3baa0..1c10f9770 100644
--- a/tests/sources/trace_findall.elab.json
+++ b/tests/sources/trace_findall.elab.json
@@ -89,9 +89,9 @@
                     "File",
                     {
                       "filename": "builtin_stdlib.elpi",
-                      "line": 292,
+                      "line": 296,
                       "column": 0,
-                      "character": 9597
+                      "character": 9708
                     }
                   ]
                 }
@@ -117,9 +117,9 @@
                   "File",
                   {
                     "filename": "builtin_stdlib.elpi",
-                    "line": 292,
+                    "line": 296,
                     "column": 0,
-                    "character": 9597
+                    "character": 9708
                   }
                 ]
               }
@@ -442,9 +442,9 @@
                   "File",
                   {
                     "filename": "builtin_stdlib.elpi",
-                    "line": 292,
+                    "line": 296,
                     "column": 0,
-                    "character": 9597
+                    "character": 9708
                   }
                 ]
               }

From 8fb745fcaf1cc09a0812c0d84bd06afc9c156099 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 11:05:21 +0200
Subject: [PATCH 12/32] [mode-checking] datatype for mode with Fo and Ho

---
 src/compiler.ml    |  8 ++++----
 src/data.ml        |  9 ++++++---
 src/runtime.ml     | 14 +++++++-------
 src/utils/util.ml  | 10 ++++++++--
 src/utils/util.mli |  7 ++++++-
 5 files changed, 31 insertions(+), 17 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index 0542dd09d..b1a06daad 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1468,7 +1468,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
       let state, types =
         map_acc (compile_type lcs) state types in
       let types = List.fold_left (fun m t -> map_append t.Types.decl.tname t m) C.Map.empty types in
-      let state, modes = List.fold_left compile_mode (state,C.Map.empty) modes in
+      let state, (modes:(Data.mode * Loc.t) C.Map.t) = List.fold_left compile_mode (state,C.Map.empty) modes in
       let state, functionality = List.fold_left compile_functionality (state,C.Set.empty) functionality in
       let defs_m = defs_of_modes modes in
       let defs_t = defs_of_types types in
@@ -1479,7 +1479,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
       (state : State.t), lcs, active_macros,
       { Structured.types; type_abbrevs; modes; functionality; body; symbols }
 
-    and compile_body macros types type_abbrevs (modes : (mode * Loc.t) C.Map.t) lcs defs state = function
+    and compile_body macros types type_abbrevs (modes: (Data.mode * Loc.t) C.Map.t) lcs defs state = function
       | [] -> lcs, state, types, type_abbrevs, modes, defs, []
       | Locals (nlist, p) :: rest ->
           let orig_varmap = get_varmap state in
@@ -1857,7 +1857,7 @@ end = struct (* {{{ *)
       | `Arrow(arity,_),_ ->
           let missing = arity - nargs in
           let output_suffix =
-            let rec aux_output = function Output :: l -> 1 + aux_output l | _ -> 0 in
+            let rec aux_output = function x :: l when get_arg_mode x = Output -> 1 + aux_output l | _ -> 0 in
             aux_output (List.rev mode) in
           if missing > output_suffix then
             error ~loc Printf.(sprintf
@@ -2876,7 +2876,7 @@ let static_check ~exec ~checker:(state,program)
   (* Building modes *)
   let state, modes = C.Map.fold (fun tname v (state,tl) -> 
     let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
-    let m = List.map (function Input -> Const truec | Output -> Const falsec) v in
+    let m = List.map (fun x -> match get_arg_mode x with Input -> Const truec | Output -> Const falsec) v in
     state, (App(pairc, c, [R.list_to_lp_list m])) :: tl) modes (state,[]) in
 
   let loc = Loc.initial "(static_check)" in
diff --git a/src/data.ml b/src/data.ml
index db6eaaad8..ad3b739e5 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -127,11 +127,14 @@ type clause = {
     loc : Loc.t option; (* debug *)
     mutable timestamp : int list; (* for grafting *)
 }
-and 
-mode = arg_mode list
+and mode_aux = Util.mode_aux =
+  | Fo of arg_mode
+  | Ho of arg_mode * mode
+and mode = mode_aux list
 [@@deriving show, ord]
 
-let to_mode = function true -> Input | false -> Output
+let get_arg_mode = function Fo a -> a | Ho (a,_) -> a 
+let to_mode = function true -> Fo Input | false -> Fo Output
 
 type grafting_time = int list
 [@@deriving show, ord]
diff --git a/src/runtime.ml b/src/runtime.ml
index ad39813d6..e597a9330 100644
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -2382,7 +2382,7 @@ let tail_opt = function
 
 (** [hd_opt L] returns false if L = [[]] otherwise L.(0)  *)
 let hd_opt = function
-  | b :: _ -> b
+  | x :: _ -> get_arg_mode x
   | _ -> Output
 
 type clause_arg_classification =
@@ -2519,7 +2519,7 @@ let hash_goal_arg_list = hash_arg_list true
   node before each argument to be indexed. This special node is used during 
   instance retrival to know the mode of the current argument
 *)
-let arg_to_trie_path ~safe ~depth ~is_goal args arg_depths args_depths_ar arg_modes mp : Discrimination_tree.Path.t =
+let arg_to_trie_path ~safe ~depth ~is_goal args arg_depths args_depths_ar mode mp : Discrimination_tree.Path.t =
   let open Discrimination_tree in
   let path = Path.make (max mp 8) mkPathEnd in
   
@@ -2619,17 +2619,17 @@ let arg_to_trie_path ~safe ~depth ~is_goal args arg_depths args_depths_ar arg_mo
     aux ~safe ~depth is_goal arg_tl arg_depth_tl mode_tl
 
   (** main function: build the path of the arguments received in entry  *)
-  and aux ~safe ~depth is_goal args arg_depths arg_mode =
-    match args, arg_depths, arg_mode with 
+  and aux ~safe ~depth is_goal args arg_depths mode =
+    match args, arg_depths, mode with 
     | _, [], _ -> ()
     | arg_hd :: arg_tl, arg_depth_hd :: arg_depth_tl, [] ->
       make_sub_path arg_hd arg_tl arg_depth_hd arg_depth_tl Output []
     | arg_hd :: arg_tl, arg_depth_hd :: arg_depth_tl, mode_hd :: mode_tl ->
-      make_sub_path arg_hd arg_tl arg_depth_hd arg_depth_tl mode_hd mode_tl 
+      make_sub_path arg_hd arg_tl arg_depth_hd arg_depth_tl (get_arg_mode mode_hd) mode_tl 
     | _, _ :: _,_ -> anomaly "Invalid Index length" in
   begin
     if args == [] then emit_mode is_goal mkOutputMode
-    else aux ~safe ~depth is_goal args (if is_goal then Array.to_list args_depths_ar else arg_depths) arg_modes
+    else aux ~safe ~depth is_goal args (if is_goal then Array.to_list args_depths_ar else arg_depths) mode
   end;
   Path.stop path  
 
@@ -4008,7 +4008,7 @@ let make_runtime : ?max_steps: int -> ?delay_outside_fragment: bool -> 'x execut
           | x :: xs -> arg != C.dummy &&
              match c_mode with
              | [] -> unif ~argsdepth:depth ~matching:false (gid[@trace]) depth env c_depth arg x && for_all23 ~argsdepth:depth (unif (gid[@trace])) depth env c_depth args_of_g xs
-             | arg_mode :: ms -> unif ~argsdepth:depth ~matching:(arg_mode == Input) (gid[@trace]) depth env c_depth arg x && for_all3b3 ~argsdepth:depth (unif (gid[@trace])) depth env c_depth args_of_g xs ms false
+             | arg_mode :: ms -> unif ~argsdepth:depth ~matching:(get_arg_mode arg_mode == Input) (gid[@trace]) depth env c_depth arg x && for_all3b3 ~argsdepth:depth (unif (gid[@trace])) depth env c_depth args_of_g xs ms false
         with
         | false ->
             T.undo ~old_trail (); [%tcall backchain depth p (k, arg, args_of_g, gs) (gid[@trace]) next alts cutto_alts cs]
diff --git a/src/utils/util.ml b/src/utils/util.ml
index 3d81d49d7..62e184b02 100644
--- a/src/utils/util.ml
+++ b/src/utils/util.ml
@@ -232,14 +232,20 @@ let rec for_all3b p l1 l2 bl b =
 ;;
 
 type arg_mode = Input | Output
+and mode_aux =
+  | Fo of arg_mode
+  | Ho of arg_mode * mode
+and mode = mode_aux list
+
+let get_arg_mode = function Fo a -> a | Ho (a,_) -> a 
 
 let rec for_all3b3 ~argsdepth (p : argsdepth:int -> matching:bool -> 'a) x1 x2 x3 l1 l2 bl b =
   match (l1, l2, bl) with
   | ([], [], _) -> true
   | ([a1], [a2], []) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:b
-  | ([a1], [a2], b3::_) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:(b3 == Input)
+  | ([a1], [a2], b3::_) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:(get_arg_mode b3 == Input)
   | (a1::l1, a2::l2, []) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:b && for_all3b3 ~argsdepth p x1 x2 x3 l1 l2 bl b
-  | (a1::l1, a2::l2, b3::bl) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:(b3 == Input) && for_all3b3 ~argsdepth p x1 x2 x3 l1 l2 bl b
+  | (a1::l1, a2::l2, b3::bl) -> p ~argsdepth x1 x2 x3 a1 a2 ~matching:(get_arg_mode b3 == Input) && for_all3b3 ~argsdepth p x1 x2 x3 l1 l2 bl b
   | (_, _, _) -> false
 ;;
 
diff --git a/src/utils/util.mli b/src/utils/util.mli
index dfd961670..20245d687 100644
--- a/src/utils/util.mli
+++ b/src/utils/util.mli
@@ -118,7 +118,12 @@ val for_all2 : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool
 val for_all23 :  argsdepth:int -> (argsdepth:int -> matching:bool -> 'x -> 'y -> 'z -> 'a -> 'a -> bool) -> 'x -> 'y -> 'z -> 'a list -> 'a list -> bool
 val for_all3b : ('a -> 'a -> bool -> bool) -> 'a list -> 'a list -> bool list -> bool -> bool
 type arg_mode = Input | Output
-val for_all3b3 : argsdepth:int -> (argsdepth:int -> matching:bool -> 'x -> 'y -> 'z -> 'a -> 'a -> bool) -> 'x -> 'y -> 'z -> 'a list -> 'a list -> arg_mode list -> bool -> bool
+and mode_aux =
+  | Fo of arg_mode
+  | Ho of arg_mode * mode
+and mode = mode_aux list
+
+val for_all3b3 : argsdepth:int -> (argsdepth:int -> matching:bool -> 'x -> 'y -> 'z -> 'a -> 'a -> bool) -> 'x -> 'y -> 'z -> 'a list -> 'a list -> mode -> bool -> bool
 (*uses physical equality and calls anomaly if the element is not in the list*)
 val remove_from_list : 'a -> 'a list -> 'a list
 (* returns Some t where f x = Some t for the first x in the list s.t.

From ba3f78432ac0639e5c506163e423186890d202c7 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 11:06:20 +0200
Subject: [PATCH 13/32] [mode-checking] mode type in AST

---
 src/compiler.ml        | 7 ++++++-
 src/data.ml            | 1 +
 src/parser/ast.ml      | 5 ++++-
 src/parser/ast.mli     | 5 ++++-
 src/parser/grammar.mly | 4 ++--
 5 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index b1a06daad..bd550a77b 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1351,8 +1351,13 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
        ("Duplicate mode declaration for " ^ Symbols.show state name ^ " (also at "^
          Loc.show (snd (C.Map.find name map)) ^ ")")
 
+  let rec to_mode_rec = function
+    | [] -> []
+    | Ast.Mode.Fo fo :: tl -> Fo (bool2IO fo) :: to_mode_rec tl
+    | Ho (ho, xs) :: tl -> Ho (bool2IO ho, to_mode_rec xs) :: to_mode_rec tl
+
   let compile_mode (state, modes) { Ast.Mode.name; args; loc } =
-    let args = List.map to_mode args in
+    let args = to_mode_rec args in
     let state, mname = funct_of_ast state name in
     check_duplicate_mode state mname (args,loc) modes;
     state, C.Map.add mname (args,loc) modes
diff --git a/src/data.ml b/src/data.ml
index ad3b739e5..0533a3c07 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -133,6 +133,7 @@ and mode_aux = Util.mode_aux =
 and mode = mode_aux list
 [@@deriving show, ord]
 
+let bool2IO = function true -> Input | false -> Output
 let get_arg_mode = function Fo a -> a | Ho (a,_) -> a 
 let to_mode = function true -> Fo Input | false -> Fo Output
 
diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index 21c43be24..ff9895946 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -220,8 +220,11 @@ end
 
 module Mode = struct
 
+  type mode = Fo of bool | Ho of bool * (mode list)
+  [@@deriving show, ord]
+
   type 'name t =
-    { name : 'name; args : bool list; loc : Loc.t }
+    { name : 'name; args : mode list; loc : Loc.t }
   [@@deriving show, ord]
 
 end
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index b03d947ec..e0d39e19e 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -146,8 +146,11 @@ end
 
 module Mode : sig
 
+  type mode = Fo of bool | Ho of bool * (mode list)
+  [@@deriving show, ord]
+
   type 'name t =
-    { name : 'name; args : bool list; loc : Loc.t }
+    { name : 'name; args : mode list; loc : Loc.t }
   [@@ deriving show, ord]
 
 end
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 7cb6749df..4d581ab56 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -182,7 +182,7 @@ pred:
        mkApp (loc $loc(c)) [mkCon (t.loc)(* BUG *)"->";t;ty]) args (mkCon (loc $sloc) (* BUG *) "prop") }
  }
 pred_item:
-| io = IO_COLON; ty = type_term { (mode_of_IO io,ty) }
+| io = IO_COLON; ty = type_term { (Mode.Fo (mode_of_IO io),ty) }
 
 kind:
 | KIND; names = separated_nonempty_list(CONJ,constant); k = kind_term {
@@ -215,7 +215,7 @@ mode:
     { Mode.name = c; args = l; loc = loc $sloc } 
 }
 i_o:
-| io = IO { mode_of_IO io }
+| io = IO { Mode.Fo (mode_of_IO io) }
 
 macro:
 | MACRO; m = term; VDASH; b = term {

From 49e0b4c7811f9880e4da9a18777ff8f6ed77d424 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 23 Sep 2024 17:28:31 +0200
Subject: [PATCH 14/32] [mode-checking] extend grammar.mly to parse modes in
 predicate

---
 src/parser/grammar.mly | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 4d581ab56..0cd79c6fb 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -182,7 +182,34 @@ pred:
        mkApp (loc $loc(c)) [mkCon (t.loc)(* BUG *)"->";t;ty]) args (mkCon (loc $sloc) (* BUG *) "prop") }
  }
 pred_item:
-| io = IO_COLON; ty = type_term { (Mode.Fo (mode_of_IO io),ty) }
+// | io = IO_COLON; ty = type_term { (Mode.Fo (mode_of_IO io),ty) }
+| io = IO_COLON; c = constant { (Mode.Fo (mode_of_IO io), Const (fix_church c)) }
+| io = IO_COLON; LPAREN; hd = pred_item_opt; ARROW; l=separated_nonempty_list(ARROW, pred_item_opt); RPAREN 
+      { let mode, ty = List.split l in
+        let ty = snd hd :: ty in
+        let rec aux = function [] | [_] -> failwith "Error" 
+          | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
+        in
+        (
+          Mode.Ho (mode_of_IO io, mode), 
+          aux ty
+        ) }
+| io = IO_COLON; hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO io), mkAppF (loc $loc(hd)) hd args) }
+
+pred_item_opt:
+| io = option(IO_COLON); c = constant { (Mode.Fo (mode_of_IO (Option.value ~default:'o' io)), Const (fix_church c)) }
+| io = option(IO_COLON); LPAREN; hd = pred_item_opt; ARROW; l=separated_nonempty_list(ARROW, pred_item_opt); RPAREN 
+      { let mode, ty = List.split l in
+        let ty = snd hd :: ty in
+        let rec aux = function [] | [_] -> failwith "Error" 
+          | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
+        in
+        (
+          Mode.Ho (mode_of_IO (Option.value ~default:'o' io), mode), 
+          aux ty
+        ) }
+| io = option(IO_COLON); hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO (Option.value ~default:'o' io)), mkAppF (loc $loc(hd)) hd args) }
+
 
 kind:
 | KIND; names = separated_nonempty_list(CONJ,constant); k = kind_term {

From 339b783a2ac83bc300089bb0dbba6808810eac7d Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 24 Sep 2024 14:23:40 +0200
Subject: [PATCH 15/32] [mode-checking] pass ho-mode to checker

---
 src/builtin.elpi      |  42 +++++------
 src/compiler.ml       |  11 ++-
 src/data.ml           |   6 +-
 src/elpi-checker.elpi | 160 ++++++++++++++++++++++--------------------
 4 files changed, 119 insertions(+), 100 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 967e3d25a..722ec5e7c 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -862,17 +862,17 @@ external pred std.string.map.bindings i:std.string.map A,
 
 % [std.string.map.filter M F M1] Filter M w.r.t. the predicate F
 external pred std.string.map.filter i:std.string.map A, 
-                                    i:string -> A -> prop, 
+                                    i:(string -> A -> prop), 
                                     o:std.string.map A.
 
 % [std.string.map.map M F M1] Map M w.r.t. the predicate F
 external pred std.string.map.map i:std.string.map A, 
-                                 i:string -> A -> B -> prop, 
+                                 i:(string -> A -> B -> prop), 
                                  o:std.string.map B.
 
 % [std.string.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.string.map.fold i:std.string.map A, i:C, 
-                                  i:string -> A -> C -> C -> prop, o:C.
+                                  i:(string -> A -> C -> C -> prop), o:C.
 
 % CAVEAT: the type parameter of std.int.map must be a closed term
 
@@ -898,16 +898,16 @@ external pred std.int.map.find i:int, i:std.int.map A, o:A.
 external pred std.int.map.bindings i:std.int.map A, o:list (pair int A).
 
 % [std.int.map.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.int.map.filter i:std.int.map A, i:int -> A -> prop, 
+external pred std.int.map.filter i:std.int.map A, i:(int -> A -> prop), 
                                  o:std.int.map A.
 
 % [std.int.map.map M F M1] Map M w.r.t. the predicate F
-external pred std.int.map.map i:std.int.map A, i:int -> A -> B -> prop, 
+external pred std.int.map.map i:std.int.map A, i:(int -> A -> B -> prop), 
                               o:std.int.map B.
 
 % [std.int.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.int.map.fold i:std.int.map A, i:C, 
-                               i:int -> A -> C -> C -> prop, o:C.
+                               i:(int -> A -> C -> C -> prop), o:C.
 
 % CAVEAT: the type parameter of std.loc.map must be a closed term
 
@@ -933,16 +933,16 @@ external pred std.loc.map.find i:loc, i:std.loc.map A, o:A.
 external pred std.loc.map.bindings i:std.loc.map A, o:list (pair loc A).
 
 % [std.loc.map.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.loc.map.filter i:std.loc.map A, i:loc -> A -> prop, 
+external pred std.loc.map.filter i:std.loc.map A, i:(loc -> A -> prop), 
                                  o:std.loc.map A.
 
 % [std.loc.map.map M F M1] Map M w.r.t. the predicate F
-external pred std.loc.map.map i:std.loc.map A, i:loc -> A -> B -> prop, 
+external pred std.loc.map.map i:std.loc.map A, i:(loc -> A -> B -> prop), 
                               o:std.loc.map B.
 
 % [std.loc.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.loc.map.fold i:std.loc.map A, i:C, 
-                               i:loc -> A -> C -> C -> prop, o:C.
+                               i:(loc -> A -> C -> C -> prop), o:C.
 
 kind std.string.set type.
 
@@ -994,22 +994,22 @@ external pred std.string.set.max i:std.string.set, o:string.
 external pred std.string.set.cardinal i:std.string.set, o:int.
 
 % [std.string.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.string.set.filter i:std.string.set, i:string -> prop, 
+external pred std.string.set.filter i:std.string.set, i:(string -> prop), 
                                     o:std.string.set.
 
 % [std.string.set.map M F M1] Map M w.r.t. the predicate F
 external pred std.string.set.map i:std.string.set, 
-                                 i:string -> string -> prop, 
+                                 i:(string -> string -> prop), 
                                  o:std.string.set.
 
 % [std.string.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.string.set.fold i:std.string.set, i:A, 
-                                  i:string -> A -> A -> prop, o:A.
+                                  i:(string -> A -> A -> prop), o:A.
 
 % [std.string.set.partition M F M1 M2] Partitions M w.r.t. the predicate F,
 % M1 is where F holds
 external pred std.string.set.partition i:std.string.set, 
-                                       i:string -> prop, 
+                                       i:(string -> prop), 
                                        o:std.string.set, o:std.string.set.
 
 kind std.int.set type.
@@ -1060,20 +1060,20 @@ external pred std.int.set.max i:std.int.set, o:int.
 external pred std.int.set.cardinal i:std.int.set, o:int.
 
 % [std.int.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.int.set.filter i:std.int.set, i:int -> prop, 
+external pred std.int.set.filter i:std.int.set, i:(int -> prop), 
                                  o:std.int.set.
 
 % [std.int.set.map M F M1] Map M w.r.t. the predicate F
-external pred std.int.set.map i:std.int.set, i:int -> int -> prop, 
+external pred std.int.set.map i:std.int.set, i:(int -> int -> prop), 
                               o:std.int.set.
 
 % [std.int.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.int.set.fold i:std.int.set, i:A, 
-                               i:int -> A -> A -> prop, o:A.
+                               i:(int -> A -> A -> prop), o:A.
 
 % [std.int.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1
 % is where F holds
-external pred std.int.set.partition i:std.int.set, i:int -> prop, 
+external pred std.int.set.partition i:std.int.set, i:(int -> prop), 
                                     o:std.int.set, o:std.int.set.
 
 kind std.loc.set type.
@@ -1124,20 +1124,20 @@ external pred std.loc.set.max i:std.loc.set, o:loc.
 external pred std.loc.set.cardinal i:std.loc.set, o:int.
 
 % [std.loc.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.loc.set.filter i:std.loc.set, i:loc -> prop, 
+external pred std.loc.set.filter i:std.loc.set, i:(loc -> prop), 
                                  o:std.loc.set.
 
 % [std.loc.set.map M F M1] Map M w.r.t. the predicate F
-external pred std.loc.set.map i:std.loc.set, i:loc -> loc -> prop, 
+external pred std.loc.set.map i:std.loc.set, i:(loc -> loc -> prop), 
                               o:std.loc.set.
 
 % [std.loc.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.loc.set.fold i:std.loc.set, i:A, 
-                               i:loc -> A -> A -> prop, o:A.
+                               i:(loc -> A -> A -> prop), o:A.
 
 % [std.loc.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1
 % is where F holds
-external pred std.loc.set.partition i:std.loc.set, i:loc -> prop, 
+external pred std.loc.set.partition i:std.loc.set, i:(loc -> prop), 
                                     o:std.loc.set, o:std.loc.set.
 
 #line 0 "builtin_map.elpi"
diff --git a/src/compiler.ml b/src/compiler.ml
index bd550a77b..9c6f3b6f9 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -2674,6 +2674,9 @@ let truec    = D.Global_symbols.declare_global_symbol "true"
 let falsec   = D.Global_symbols.declare_global_symbol "false"
 let pairc    = D.Global_symbols.declare_global_symbol "pr"
 
+let modefoc  = D.Global_symbols.declare_global_symbol "mode-fo"
+let modehoc  = D.Global_symbols.declare_global_symbol "mode-ho"
+
 let mkQApp ~on_type l =
   let c = if on_type then tappc else appc in
   App(c,R.list_to_lp_list l,[])
@@ -2879,9 +2882,15 @@ let static_check ~exec ~checker:(state,program)
     state, c :: tl) functionality (state,[]) in
 
   (* Building modes *)
+  let arg_mode2bool = function Input -> Const truec | Output -> Const falsec in
+
+  let rec mode2elpi = function
+    | D.Fo b -> App(modefoc,arg_mode2bool b,[])
+    | D.Ho (b, l) -> App(modehoc,arg_mode2bool b,[R.list_to_lp_list @@ List.map mode2elpi l]) in
+
   let state, modes = C.Map.fold (fun tname v (state,tl) -> 
     let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
-    let m = List.map (fun x -> match get_arg_mode x with Input -> Const truec | Output -> Const falsec) v in
+    let m = List.map mode2elpi v in
     state, (App(pairc, c, [R.list_to_lp_list m])) :: tl) modes (state,[]) in
 
   let loc = Loc.initial "(static_check)" in
diff --git a/src/data.ml b/src/data.ml
index 0533a3c07..aa9160279 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -1299,7 +1299,11 @@ let pp_tab_args fmt l =
 
 let pp_arg sep fmt (dir,ty,doc) =
   let dir = if dir then "i" else "o" in
-  Fmt.fprintf fmt "%s:%s%s" dir ty sep
+  try 
+    (Re.Str.search_forward (Re.Str.regexp "->") ty 0 |> ignore);
+    Fmt.fprintf fmt "%s:(%s)%s" dir ty sep
+  with Not_found ->
+    Fmt.fprintf fmt "%s:%s%s" dir ty sep
 ;;
 
 let pp_args = pplist (pp_arg "") ", " ~pplastelem:(pp_arg "")
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 8a213617a..81afd9b17 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -168,6 +168,7 @@ typecheck [] (clause Loc Names Query) _ _ RC :-
   checking Loc =>
     report-all-failures-if-no-success (of-clause Names Query) RC.
 typecheck [ (clause Loc Names Clause) | Rest] Q T0 NP RC :-
+  % print "Typechecking Clause" Names Clause,
   log-tc-clause Loc Clause,
   checking Loc =>
     report-all-failures-if-no-success (of-clause Names Clause) RC, !,
@@ -391,7 +392,7 @@ is-rigid-term (const _) :- !.
 is-rigid-term A :- halt "Error in is-rigid-term" A.
 
 mode (build-mode i o).
-build-mode L R :- std.map L (x\r\ r = false) R.
+build-mode L R :- std.map L (x\r\ r = mode-fo false) R.
 
 pred add-no-modes o:list A, i:A.
 add-no-modes X T :- var X, !, X = [T|Y_], print "No mode for" T.
@@ -399,17 +400,25 @@ add-no-modes [X|_] Y :- not (var X), X = Y, !.
 add-no-modes [X|Xs] T :- var Xs, !, print "No mode for" X, Xs = [T|Y_].
 add-no-modes [_|Xs] T :- !, add-no-modes Xs T.
 
-mode (find-mode i o i i o).
-find-mode [] NoModes_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
-find-mode [] NoModes X Args R :- !, add-no-modes NoModes X, build-mode Args R .
-find-mode [pr X R|_] _ X _ R :- !.
-find-mode [_ | Xs] NoModes X Args R :- !, find-mode Xs NoModes X Args R.
+mode (find-mode.aux i i i i o).
+find-mode.aux [] NoModes_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
+find-mode.aux [] NoModes X Args R :- !, add-no-modes NoModes X, build-mode Args R .
+find-mode.aux [pr X R|_] _ X _ R :- !.
+find-mode.aux [_ | Xs] NoModes X Args R :- !, find-mode.aux Xs NoModes X Args R.
 
-mode (set-head-mode o i i i).
-set-head-mode NoModes Head Args AllModes :-
-  find-mode AllModes NoModes Head Args Mode, !,
-  std.forall2 Mode Args (m\t\ if m (to-rigid-term t) true).
-set-head-mode _ _ _ _.
+mode (find-mode i i o).
+find-mode X Args R :- modes Modes, no-modes NoModes, find-mode.aux Modes NoModes X Args R. 
+
+mode (get-head-mode i o).
+get-head-mode (mode-fo M) M :- !.
+get-head-mode (mode-ho M _) M :- !.
+
+mode (set-head-mode i i).
+set-head-mode Head Args :-
+  find-mode Head Args Mode, !,
+  if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for (2)" Head Loc),
+  std.forall2 Mode Args (m\t\ if (get-head-mode m true) (to-rigid-term t) true).
+set-head-mode _ _.
 
 pred get-vars i:term, o:list term.
 get-vars N [] :- name N, !.
@@ -420,14 +429,14 @@ get-vars (const T) [] :- !.
 get-vars A [B] :- var A, !, get-str A B.
 get-vars A _ :- halt "Error in get-vars" A.
 
-mode (check-head-output i i i i i).
-check-head-output NoModes Head Args AllModes Loc :-
-  find-mode AllModes NoModes Head Args Mode, !, 
+mode (check-head-output i i i).
+check-head-output Head Args Loc :-
+  find-mode Head Args Mode, !, 
   std.forall2 Mode Args (m\t\ sigma Vars\
     std.assert! (get-vars t Vars) "Should not fail",
-    if m true (if (Vars = []) true (
+    if (get-head-mode m true) true (if (Vars = []) true (
       print "WARNING: The variables" Vars "are is output position of the predicate\"" Head "\"and cannot be ensured to be ground" Loc))).
-check-head-output _ _ _ _ _.
+check-head-output _ _ _.
 
 mode (variadic-mode i).
 variadic-mode (const "halt").
@@ -450,7 +459,8 @@ get-str A _ :- halt "Error in get-str" A.
 
 pred check-args-mode i:D, o:A, i:B, i:C, i:prop, i:term.
 check-args-mode HD _ _ Loc Mode Arg :-
-  Mode, var Arg, !,
+  get-head-mode Mode ModeP,
+  ModeP, var Arg, !,
   std.assert!(get-str Arg Arg') "Should not fail",
   if (fatal-no-mode) (halt "WARNING: Flex arg" Arg' "passed to" HD Loc) (print "WARNING: Flex arg" Arg' "passed to" HD Loc).
 % TODO: following rule aims to go under lambda which are args of a predicate
@@ -459,85 +469,81 @@ check-args-mode HD _ _ Loc Mode Arg :-
 %   Mode, Arg = lam L, !,
 %   print ("Going under lambda") Arg,
 %   pi x\ std.assert!(check-well-moded-negative NoModes AllModes Loc (L x)) "Should not fail".
-check-args-mode _ _ _ _ Mode Arg :- Mode, !.
-check-args-mode _ _ _ _ Mode Arg :- 
-  not Mode, to-rigid-term Arg.
-
-mode (check-well-moded-negative o i i i).
-check-well-moded-negative _ _ _        N :- name N, !.
-% check-well-moded-negative _ _ _        V :- var V, !, to-constant V.
-check-well-moded-negative _ _ _        (cdata (uvar _ as V)) :- !, to-constant V.
-check-well-moded-negative _ _ _        (cdata _) :- !.
-check-well-moded-negative NoModes AllModes Loc (app [const "," | L]) :- !,
+check-args-mode _ _ _ _ Mode Arg :- get-head-mode Mode ModeP, ModeP, !.
+check-args-mode _ _ _ _ Mode Arg :- get-head-mode Mode ModeP, not ModeP, to-rigid-term Arg.
+
+mode (check-well-moded-negative i i).
+check-well-moded-negative _        N :- name N, !.
+% check-well-moded-negative _        V :- var V, !, to-constant V.
+check-well-moded-negative _        (cdata (uvar _ as V)) :- !, to-constant V.
+check-well-moded-negative _        (cdata _) :- !.
+check-well-moded-negative Loc (app [const "," | L]) :- !,
   std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) 
-  (check-well-moded-negative NoModes AllModes Loc x)).
-check-well-moded-negative NoModes AllModes Loc (app [const "pi", lam B]) :- !,
-  pi x\ check-well-moded-negative NoModes AllModes Loc (B x).
-check-well-moded-negative NoModes AllModes Loc (app [const "=>", Hyp, Body]) :- !,
-  check-well-moded-positive NoModes Hyp AllModes Loc [],
-  check-well-moded-negative NoModes AllModes Loc Body.
-check-well-moded-negative _ _ _ (app [HD|_]) :- variadic-mode HD, !.
-check-well-moded-negative NoModes AllModes Loc (app [HD|Args]) :- !,
+  (check-well-moded-negative Loc x)).
+check-well-moded-negative Loc (app [const "pi", lam B]) :- !,
+  pi x\ check-well-moded-negative Loc (B x).
+check-well-moded-negative Loc (app [const "=>", Hyp, Body]) :- !,
+  check-well-moded-positive Hyp Loc [],
+  check-well-moded-negative Loc Body.
+check-well-moded-negative _ (app [HD|_]) :- variadic-mode HD, !.
+check-well-moded-negative Loc (app [HD|Args]) :- !,
   % print "Checking mode of" HD Args,
   if (var HD) 
     (if (fatal-no-mode) (halt "WARNING: Flex head symbol" HD "at" Loc) (print "WARNING: Flex head symbol" HD "at" Loc))
     true,
-  find-mode AllModes NoModes HD Args Mode,
+  find-mode HD Args Mode,
   if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for" HD Loc),
   std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh").
-check-well-moded-negative NoModes AllModes Loc (lam F) :- !, 
-  pi x\ check-well-moded-negative NoModes AllModes Loc (F x).
-check-well-moded-negative _ _ _       (const _ as _) :- !.
+check-well-moded-negative Loc (lam F) :- !, 
+  pi x\ check-well-moded-negative Loc (F x).
+check-well-moded-negative _       (const _ as _) :- !.
 
-mode (check-well-moded-negative-list i o i i).
-check-well-moded-negative-list [] _ _ _ :- !.
-check-well-moded-negative-list [X | Xs] NoModes Modes Loc :-
-  check-well-moded-negative NoModes Modes Loc X,
-  check-well-moded-negative-list Xs NoModes Modes Loc.
+mode (check-well-moded-negative-list i i).
+check-well-moded-negative-list [] _ :- !.
+check-well-moded-negative-list [X | Xs] Loc :-
+  check-well-moded-negative Loc X,
+  check-well-moded-negative-list Xs Loc.
 
 mode (to-check i).
 to-check _ :- !, true.
 % to-check (const "a") :- !.
-% to-check (const "b") :- !.
+% to-check (const "p1") :- !.
 % to-check (const "c") :- !.
 % to-check (arg B) :- !, pi x\ to-check (B x).
 % to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
 %   to-check Head.
 
 % mode (check-well-moded-positive i i i i).
-pred check-well-moded-positive o:A, i:B, i:C, i:D, i:E.
-check-well-moded-positive _ X _ Loc _ :- var X, print "WARNING: Got uvar in check well-moded-positive" Loc.
-check-well-moded-positive NoModes (arg B) Modes Loc [N|Names] :- !,
+pred check-well-moded-positive i:C, i:D, i:E.
+check-well-moded-positive X Loc _ :- var X, print "WARNING: Got uvar in check well-moded-positive" Loc.
+check-well-moded-positive (arg B) Loc [N|Names] :- !,
   map-var X N P,
-  P => check-well-moded-positive NoModes (B X) Modes Loc Names.
-check-well-moded-positive _ (const _) _ _ _ :- !.
-check-well-moded-positive NoModes (app [(const ":-"), (app [Head | Args]) | Prem]) Modes Loc Names_ :-
+  P => check-well-moded-positive (B X) Loc Names.
+check-well-moded-positive (const _) _ _ :- !.
+check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem]) Loc Names_ :-
   % print "Checking mode positive of" Head Args ":-" Prem,
-  set-head-mode NoModes Head Args Modes, 
-  check-well-moded-negative-list Prem NoModes Modes Loc,
-  check-head-output NoModes Head Args Modes Loc.
-check-well-moded-positive NoModes (app [(const ":-"), (const _) | Prem]) Modes Loc Names_ :- !,
-   check-well-moded-negative-list Prem NoModes Modes Loc.
-check-well-moded-positive NoModes (app [(const "pi"), lam B]) Modes Loc Names :- !,
-  check-well-moded-positive NoModes (B X_) Modes Loc Names.
-check-well-moded-positive NoModes (app [(const ",") | L]) Modes Loc Names :- !,
-  std.forall L (x\ check-well-moded-positive NoModes x Modes Loc Names).
-check-well-moded-positive NoModes (app ([const "::", A, L])) Modes Loc Names :- !,
-  check-well-moded-positive NoModes A Modes Loc Names,
-  check-well-moded-positive NoModes L Modes Loc Names.
-check-well-moded-positive _ (app _) _ _ _ :- !. % print "TODO: for" T.
-check-well-moded-positive _ (@rigid-term) _ _ _ :- !.
-
-check-well-moded-positive _ A _ _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
-
-mode (check-well-moded-prog i o i).
-check-well-moded-prog [] _ _ :- !.
-check-well-moded-prog [clause Loc Vars Body | Tl] NoModes Modes :-
-  to-check Body, !,
-  % print "====================================================",
-  % print "Going to check" Loc Vars Body,
-  check-well-moded-positive NoModes Body Modes Loc Vars, !,
-  check-well-moded-prog Tl NoModes Modes.
+  set-head-mode Head Args, 
+  check-well-moded-negative-list Prem Loc,
+  check-head-output Head Args Loc.
+check-well-moded-positive (app [(const ":-"), (const _) | Prem]) Loc Names_ :- !,
+   check-well-moded-negative-list Prem Loc.
+check-well-moded-positive (app [(const "pi"), lam B]) Loc Names :- !,
+  check-well-moded-positive (B X_) Loc Names.
+check-well-moded-positive (app [(const ",") | L]) Loc Names :- !,
+  std.forall L (x\ check-well-moded-positive x Loc Names).
+check-well-moded-positive (app ([const "::", A, L])) Loc Names :- !,
+  check-well-moded-positive A Loc Names,
+  check-well-moded-positive L Loc Names.
+check-well-moded-positive (app _) _ _ :- !. % print "TODO: for" T.
+check-well-moded-positive (@rigid-term) _ _ :- !.
+check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
+
+mode (check-well-moded-prog i).
+check-well-moded-prog [] :- !.
+check-well-moded-prog [clause Loc Vars Body | Tl] :-
+  if (to-check Body)
+    (check-well-moded-positive Body Loc Vars) true,
+  check-well-moded-prog Tl.
 
 check-overlapping-prog [] _ :- !.
 
@@ -548,6 +554,6 @@ check P Q DeclaredTypes TypeAbbreviations Modes _FuncPred :-
   Abbrevs => typecheck-program P Q DeclaredTypes RC, !,
   warn-linear P, !,
   if (var RC) (true) (fail),
-  check-well-moded-prog P NoModes_ Modes.
+  (modes Modes, no-modes NoModes_) => check-well-moded-prog P.
 
 % vim: set ft=lprolog:

From e41b21b3b2f3012851c4191145a67ad02fdac1cd Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 24 Sep 2024 15:38:39 +0200
Subject: [PATCH 16/32] [mode-checking] add mode_checking_fo in tests/sources

---
 src/elpi-checker.elpi               |  2 +-
 tests/sources/mode_checking_fo.elpi | 10 ++++++++++
 tests/suite/correctness_FO.ml       | 24 +++++++++++++++++++++++-
 tests/suite/suite.ml                | 18 ++++++++++++++++++
 tests/suite/suite.mli               |  3 +++
 5 files changed, 55 insertions(+), 2 deletions(-)
 create mode 100644 tests/sources/mode_checking_fo.elpi

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 81afd9b17..28fb98859 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -435,7 +435,7 @@ check-head-output Head Args Loc :-
   std.forall2 Mode Args (m\t\ sigma Vars\
     std.assert! (get-vars t Vars) "Should not fail",
     if (get-head-mode m true) true (if (Vars = []) true (
-      print "WARNING: The variables" Vars "are is output position of the predicate\"" Head "\"and cannot be ensured to be ground" Loc))).
+      print "WARNING: The variables" Vars "are in output position of the predicate\"" Head "\"and cannot be ensured to be ground" Loc))).
 check-head-output _ _ _.
 
 mode (variadic-mode i).
diff --git a/tests/sources/mode_checking_fo.elpi b/tests/sources/mode_checking_fo.elpi
new file mode 100644
index 000000000..62a82c6a8
--- /dev/null
+++ b/tests/sources/mode_checking_fo.elpi
@@ -0,0 +1,10 @@
+pred p i:int, o:int.
+
+p 1 2.
+p X X. % OK for mode: the output is deduced from the input
+p X Y :- X = Y. % Similar to the test before, with explicit unification
+
+p X Y :- p Y X. % Mh, not good since the input of the premise is flex. 
+                % Moreover the output of the head is not ensured to be ground
+
+main.
\ No newline at end of file
diff --git a/tests/suite/correctness_FO.ml b/tests/suite/correctness_FO.ml
index 98ab55b64..a733b5ebf 100644
--- a/tests/suite/correctness_FO.ml
+++ b/tests/suite/correctness_FO.ml
@@ -192,7 +192,29 @@ let () = declare "is"
   ~description:"calc"
   ()
 
-  let () = declare "trie"
+let () = declare "trie"
   ~source_elpi:"trie.elpi"
   ~description:"discrimination_tree on trees"
   ()
+
+let () = declare "mode_checking_fo"
+  ~source_elpi:"mode_checking_fo.elpi"
+  ~description:"mode_checking_fo"
+  ~expectation:(SuccessOutputTxt (
+    let expected = [|
+      "WARNING: Flex arg cdata Y passed to const p "; 
+      "WARNING: The variables [cdata Y] are in output position of the predicate\" "; 
+      " const p \"and cannot be ensured to be ground "|] in
+    let is_in_file = Util.has_substring ~sub:"mode_checking_fo" in
+    let start_warning = String.starts_with ~prefix:"WARNING" in
+    let pos = ref 0 in
+    let rec f = function
+      | [] | [_] -> true
+      | x :: x' :: xs when start_warning x && is_in_file x' ->
+        expected.(!pos) = x && (incr pos; f xs)
+      | x :: x' :: x'' :: xs when start_warning x && is_in_file x'' ->
+        expected.(!pos) = x && (incr pos; expected.(!pos) = x') && (incr pos; f xs)
+      | _ :: xs -> f xs in
+      f
+    ))
+  ()
\ No newline at end of file
diff --git a/tests/suite/suite.ml b/tests/suite/suite.ml
index f8e3514a9..6e1b736ae 100644
--- a/tests/suite/suite.ml
+++ b/tests/suite/suite.ml
@@ -10,6 +10,7 @@ type expectation =
   | Failure
   | SuccessOutput of Str.regexp
   | FailureOutput of Str.regexp
+  | SuccessOutputTxt of (string list -> bool)
   | SuccessOutputFile of { sample : string; adjust : string -> string; reference : string }
 
 type trace = Off | On of string list
@@ -274,6 +275,20 @@ let with_log (_,log) f =
     x
   with e -> close_in cin; raise e
 
+let read_lines fname =
+  let cin = open_in fname in
+  let rec aux () =
+    try
+      let x = input_line cin in
+      x :: aux ()
+    with End_of_file -> close_in cin; []
+  in
+  aux ()
+
+let has_substring ~sub s = 
+  try Str.(search_forward (regexp sub)) s 0 |> ignore; true
+  with Not_found -> false
+
 let option_map f = function None -> None | Some x -> Some (f x)
 
 let strip_cwd file =
@@ -415,6 +430,7 @@ let () = Runner.declare
         | Test.SuccessOutputFile { sample; adjust; reference } when promote ->
             FileUtil.cp [adjust sample] (sources^"/"^reference);
             Runner.Promote { walltime; typechecking; execution; mem }
+        | Test.SuccessOutputTxt f when f (Util.read_lines (snd log)) -> Runner.Success { walltime; typechecking; execution; mem }
         | _ -> Runner.Failure { walltime; typechecking; execution; mem }
         end
 
@@ -479,6 +495,8 @@ module ElpiTraceElab = struct
       let execution = 0.0 in
       let rc =
         match outcome, outcomey, test.Test.expectation with
+        | Util.Exit(0,walltime,mem), Some(Util.Exit(0,_,_)), Test.SuccessOutputTxt f when f (Util.read_lines (snd log)) -> 
+            Runner.Success { walltime; typechecking; execution; mem }
         | Util.Exit(0,walltime,mem), Some(Util.Exit(0,_,_)), Test.SuccessOutputFile { sample; adjust; reference } when match_file ~log sample adjust (sources^"/"^reference) ->
             Runner.Success { walltime; typechecking; execution; mem }
         | Util.Exit(0,walltime,mem), Some(Util.Exit(0,_,_)), Test.SuccessOutputFile { sample; adjust; reference } when promote ->
diff --git a/tests/suite/suite.mli b/tests/suite/suite.mli
index 8a373dbd3..323636469 100644
--- a/tests/suite/suite.mli
+++ b/tests/suite/suite.mli
@@ -3,6 +3,8 @@ module Util : sig
 
   val strip_cwd : string -> string
 
+  val has_substring : sub:string -> string -> bool
+
 end
 
 module Test : sig
@@ -14,6 +16,7 @@ type expectation =
   | Failure
   | SuccessOutput of Str.regexp
   | FailureOutput of Str.regexp
+  | SuccessOutputTxt of (string list -> bool)
   | SuccessOutputFile of { sample : string; adjust : string -> string; reference : string }
 
 type trace = Off | On of string list

From cce8b5661a9252276ae51eef2aa22d60f4e6107d Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 24 Sep 2024 16:14:41 +0200
Subject: [PATCH 17/32] [mode-checking] tests for HO types

---
 src/elpi-checker.elpi               |  6 ++--
 tests/sources/mode_checking_ho.elpi | 27 ++++++++++++++++
 tests/suite/correctness_FO.ml       | 49 +++++++++++++++++++++--------
 3 files changed, 66 insertions(+), 16 deletions(-)
 create mode 100644 tests/sources/mode_checking_ho.elpi

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 28fb98859..d11092719 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -460,9 +460,9 @@ get-str A _ :- halt "Error in get-str" A.
 pred check-args-mode i:D, o:A, i:B, i:C, i:prop, i:term.
 check-args-mode HD _ _ Loc Mode Arg :-
   get-head-mode Mode ModeP,
-  ModeP, var Arg, !,
+  ModeP, get-vars Arg L, not (L = []), !,
   std.assert!(get-str Arg Arg') "Should not fail",
-  if (fatal-no-mode) (halt "WARNING: Flex arg" Arg' "passed to" HD Loc) (print "WARNING: Flex arg" Arg' "passed to" HD Loc).
+  if (fatal-no-mode) (halt "WARNING: Not ground" Arg' "passed to" HD Loc) (print "WARNING: Not ground" Arg' "passed to" HD Loc).
 % TODO: following rule aims to go under lambda which are args of a predicate
 %       however, this is gives a error if partial application is used
 % check-args-mode _ NoModes AllModes Loc Mode Arg :-
@@ -478,7 +478,7 @@ check-well-moded-negative _        N :- name N, !.
 check-well-moded-negative _        (cdata (uvar _ as V)) :- !, to-constant V.
 check-well-moded-negative _        (cdata _) :- !.
 check-well-moded-negative Loc (app [const "," | L]) :- !,
-  std.forall L (x\ if (var x) ((fatal-no-mode, halt "Passed flexible to ," Loc); print "Passed flexible to ," Loc) 
+  std.forall L (x\ if (var x) ((fatal-no-mode, halt "WARNING: Passed flexible to ," Loc); print "WARNING: Passed flexible to ," Loc) 
   (check-well-moded-negative Loc x)).
 check-well-moded-negative Loc (app [const "pi", lam B]) :- !,
   pi x\ check-well-moded-negative Loc (B x).
diff --git a/tests/sources/mode_checking_ho.elpi b/tests/sources/mode_checking_ho.elpi
new file mode 100644
index 000000000..f48c09ba9
--- /dev/null
+++ b/tests/sources/mode_checking_ho.elpi
@@ -0,0 +1,27 @@
+kind tm type.
+
+type abs (tm -> tm) -> tm.
+type con int -> tm.
+type app list tm -> tm.
+
+pred copy i:tm, o:tm.
+% The following rules are well moded
+copy (con N) (con N).
+copy (app L) (app M) :- std.map L copy M.
+copy (abs X) (abs Y) :- pi x\ copy x x => copy (X x) (Y x).
+
+% The following rules are semantically meaningless
+% They are however good tests for mode checking
+
+pred p i:tm.
+p X :- pi x\ (p x, (p x :- p Z)) => p X. % Here the premise (p Z) is not well-moded
+p X :- pi x\ (p x :- p (con Z)) => p X. % Again Z is passed not ground in (con Z)
+p X :- pi x\ (p x :- p x) => p (con 3). % Here the x in the premise (p x) is good
+p X :- pi x\ (pi y\ p x :- p y) => p x. % Here y is flex but in input pos
+p T :- (pi x\ p x :- p x) => p (app [T, abs x\x]). % Here x is deduced from the input
+
+pred q i:prop, o:prop.
+q A R :- A, R = A. % Everything goes moothly!
+q A R :- R, R = A. % Mh, R is output, ie supposed flex
+
+main.
\ No newline at end of file
diff --git a/tests/suite/correctness_FO.ml b/tests/suite/correctness_FO.ml
index a733b5ebf..7d4ceb6e8 100644
--- a/tests/suite/correctness_FO.ml
+++ b/tests/suite/correctness_FO.ml
@@ -197,24 +197,47 @@ let () = declare "trie"
   ~description:"discrimination_tree on trees"
   ()
 
+let mode_check expected fname =
+  let is_in_file = Util.has_substring ~sub:fname in
+  let start_warning = String.starts_with ~prefix:"WARNING" in
+  let pos = ref 0 in
+  let check_same x =
+    let res = try Str.(search_forward (regexp expected.(!pos))) x 0 |> ignore; true
+              with Not_found -> false in
+    if not res then Printf.eprintf "Expected [[%s]]; \nFound    [[%s]]\n" expected.(!pos) x;
+    incr pos; 
+    res in
+  let rec f = function
+    | [] | [_] -> true
+    | x :: x' :: xs when start_warning x && is_in_file x' ->
+      check_same x && f xs
+    | x :: x' :: x'' :: xs when start_warning x && is_in_file x'' ->
+      check_same x && check_same x' && f xs
+    | _ :: xs -> f xs in
+    f
+
 let () = declare "mode_checking_fo"
   ~source_elpi:"mode_checking_fo.elpi"
   ~description:"mode_checking_fo"
   ~expectation:(SuccessOutputTxt (
     let expected = [|
-      "WARNING: Flex arg cdata Y passed to const p "; 
-      "WARNING: The variables [cdata Y] are in output position of the predicate\" "; 
+      "WARNING: Not ground cdata Y passed to const p "; 
+      "WARNING: The variables \\[cdata Y\\] are in output position of the predicate\" "; 
       " const p \"and cannot be ensured to be ground "|] in
-    let is_in_file = Util.has_substring ~sub:"mode_checking_fo" in
-    let start_warning = String.starts_with ~prefix:"WARNING" in
-    let pos = ref 0 in
-    let rec f = function
-      | [] | [_] -> true
-      | x :: x' :: xs when start_warning x && is_in_file x' ->
-        expected.(!pos) = x && (incr pos; f xs)
-      | x :: x' :: x'' :: xs when start_warning x && is_in_file x'' ->
-        expected.(!pos) = x && (incr pos; expected.(!pos) = x') && (incr pos; f xs)
-      | _ :: xs -> f xs in
-      f
+    mode_check expected "mode_checking_fo"
+    ))
+  ()
+
+let () = declare "mode_checking_ho"
+  ~source_elpi:"mode_checking_ho.elpi"
+  ~description:"mode_checking_ho"
+  ~expectation:(SuccessOutputTxt (
+    let expected = [|
+      "WARNING: Not ground cdata Z passed to const p "; 
+      "WARNING: Not ground app \\[const con, cdata Z\\] passed to const p ";
+      "WARNING: Not ground X[0-9]+ c[0-9]+ passed to const p ";
+      "WARNING: Passed flexible to , "
+      |] in
+    mode_check expected "mode_checking_ho"
     ))
   ()
\ No newline at end of file

From 0e3e941aa0dece571939b851794207433a0cde8d Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Wed, 25 Sep 2024 12:47:49 +0200
Subject: [PATCH 18/32] [mode-checking] corrected parsing of HO modes

---
 src/elpi-checker.elpi               | 62 ++++++++++++++++++-----------
 src/parser/grammar.mly              |  4 +-
 tests/sources/mode_checking_ho.elpi |  6 +++
 tests/suite/correctness_FO.ml       | 17 ++++----
 4 files changed, 56 insertions(+), 33 deletions(-)

diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index d11092719..8f2d04b06 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -420,13 +420,13 @@ set-head-mode Head Args :-
   std.forall2 Mode Args (m\t\ if (get-head-mode m true) (to-rigid-term t) true).
 set-head-mode _ _.
 
-pred get-vars i:term, o:list term.
+pred get-vars i:term, o:list string.
 get-vars N [] :- name N, !.
 get-vars (cdata _ as X) [] :- !.
 get-vars (app L) L'' :- !, std.map L get-vars L', std.flatten L' L''.
 get-vars (lam F) L :- !, pi x\ get-vars (F x) L.
 get-vars (const T) [] :- !.
-get-vars A [B] :- var A, !, get-str A B.
+get-vars A [B] :- var A, !, pp A B.
 get-vars A _ :- halt "Error in get-vars" A.
 
 mode (check-head-output i i i).
@@ -446,23 +446,22 @@ mode (is-ho-predicate i).
 is-ho-predicate (@rigid-term).
 
 pred map-var o:A, i:string, o:prop.
-map-var V S R :- var V, !, R = (get-str X (cdata S) :- var V, same_term X V, !).
+map-var V S R :- var V, !, R = (pp X S :- var V, same_term X V, !).
 
-pred get-str i:term, o:term.
-get-str N N :- name N, !.
-get-str (cdata _ as X) X :- !.
-get-str (app L) (app L'):- !, std.map L get-str L'.
-get-str (lam F) (lam F') :- !, pi x\ get-str (F x) (F' x).
-get-str (const T) (const T) :- !.
-get-str A A :- var A, !.
-get-str A _ :- halt "Error in get-str" A.
+pred copy i:term, o:term.
+copy N N :- name N, !.
+copy (cdata _ as X) X :- !.
+copy (app L) (app L'):- !, std.map L copy L'.
+copy (lam F) (lam F') :- !, pi x\ copy (F x) (F' x).
+copy (const T) (const T) :- !.
+copy A A :- var A, !.
+copy A _ :- halt "Error in copy" A.
 
 pred check-args-mode i:D, o:A, i:B, i:C, i:prop, i:term.
 check-args-mode HD _ _ Loc Mode Arg :-
   get-head-mode Mode ModeP,
   ModeP, get-vars Arg L, not (L = []), !,
-  std.assert!(get-str Arg Arg') "Should not fail",
-  if (fatal-no-mode) (halt "WARNING: Not ground" Arg' "passed to" HD Loc) (print "WARNING: Not ground" Arg' "passed to" HD Loc).
+  if (fatal-no-mode) (halt "WARNING: Not ground" Arg' "passed to" HD Loc) (print "WARNING: Not ground" {pp Arg} "passed to" {pp HD} Loc).
 % TODO: following rule aims to go under lambda which are args of a predicate
 %       however, this is gives a error if partial application is used
 % check-args-mode _ NoModes AllModes Loc Mode Arg :-
@@ -487,11 +486,11 @@ check-well-moded-negative Loc (app [const "=>", Hyp, Body]) :- !,
   check-well-moded-negative Loc Body.
 check-well-moded-negative _ (app [HD|_]) :- variadic-mode HD, !.
 check-well-moded-negative Loc (app [HD|Args]) :- !,
-  % print "Checking mode of" HD Args,
   if (var HD) 
     (if (fatal-no-mode) (halt "WARNING: Flex head symbol" HD "at" Loc) (print "WARNING: Flex head symbol" HD "at" Loc))
     true,
   find-mode HD Args Mode,
+  % print "Mode is" Mode,
   if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for" HD Loc),
   std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh").
 check-well-moded-negative Loc (lam F) :- !, 
@@ -506,12 +505,19 @@ check-well-moded-negative-list [X | Xs] Loc :-
 
 mode (to-check i).
 to-check _ :- !, true.
-% to-check (const "a") :- !.
-% to-check (const "p1") :- !.
-% to-check (const "c") :- !.
-% to-check (arg B) :- !, pi x\ to-check (B x).
-% to-check (app [(const ":-"), (app [Head | _]) | _]) :- !,
-%   to-check Head.
+% to-check "r1" :- !.
+
+pred check-well-moded-positive-ho-mode i:list term, i:list A, i:list term, i:B.
+check-well-moded-positive-ho-mode [A|As] [mode-fo X|Ms] Prem Loc :- !,
+  if X (to-rigid-term A) true, 
+  check-well-moded-positive-ho-mode As Ms Prem Loc.
+check-well-moded-positive-ho-mode [A|As] [mode-ho true M|Ms] Prem Loc :- var A, !,
+  pi x\ (pi X\ copy X x :- same_term X A, !) => std.map Prem copy (Prem' x), !, 
+  modes Modes,
+  (modes [pr x M | Modes] :- !) => check-well-moded-positive-ho-mode As Ms (Prem' x) Loc.
+check-well-moded-positive-ho-mode [_|As] [_|Ms] Prem Loc :- !,
+  check-well-moded-positive-ho-mode As Ms Prem Loc.
+check-well-moded-positive-ho-mode [] [] Prem Loc :- check-well-moded-negative-list Prem Loc.
 
 % mode (check-well-moded-positive i i i i).
 pred check-well-moded-positive i:C, i:D, i:E.
@@ -522,8 +528,9 @@ check-well-moded-positive (arg B) Loc [N|Names] :- !,
 check-well-moded-positive (const _) _ _ :- !.
 check-well-moded-positive (app [(const ":-"), (app [Head | Args]) | Prem]) Loc Names_ :-
   % print "Checking mode positive of" Head Args ":-" Prem,
-  set-head-mode Head Args, 
-  check-well-moded-negative-list Prem Loc,
+  % set-head-mode Head Args,
+  find-mode Head Args Mode,
+  check-well-moded-positive-ho-mode Args Mode Prem Loc,
   check-head-output Head Args Loc.
 check-well-moded-positive (app [(const ":-"), (const _) | Prem]) Loc Names_ :- !,
    check-well-moded-negative-list Prem Loc.
@@ -534,14 +541,21 @@ check-well-moded-positive (app [(const ",") | L]) Loc Names :- !,
 check-well-moded-positive (app ([const "::", A, L])) Loc Names :- !,
   check-well-moded-positive A Loc Names,
   check-well-moded-positive L Loc Names.
-check-well-moded-positive (app _) _ _ :- !. % print "TODO: for" T.
+check-well-moded-positive (app _ as App) Loc Names :- !, 
+  check-well-moded-positive (app [(const ":-"), App]) Loc Names.
 check-well-moded-positive (@rigid-term) _ _ :- !.
 check-well-moded-positive A _ _ :- halt "check-well-moded-positive: Uncaught branch in" A.
 
+pred head-symbol i:term, o:string.
+head-symbol (arg Ag) S :- pi x\ head-symbol (Ag x) S.
+head-symbol (const C) C.
+head-symbol (app [const ":-", X | _]) S :- !, head-symbol X S.
+head-symbol (app [const C|L]) C.
+
 mode (check-well-moded-prog i).
 check-well-moded-prog [] :- !.
 check-well-moded-prog [clause Loc Vars Body | Tl] :-
-  if (to-check Body)
+  if (to-check {head-symbol Body})
     (check-well-moded-positive Body Loc Vars) true,
   check-well-moded-prog Tl.
 
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 0cd79c6fb..9a7dac753 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -191,7 +191,7 @@ pred_item:
           | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
         in
         (
-          Mode.Ho (mode_of_IO io, mode), 
+          Mode.Ho (mode_of_IO io, List.rev @@ List.tl @@ List.rev (fst hd :: mode)), 
           aux ty
         ) }
 | io = IO_COLON; hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO io), mkAppF (loc $loc(hd)) hd args) }
@@ -205,7 +205,7 @@ pred_item_opt:
           | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
         in
         (
-          Mode.Ho (mode_of_IO (Option.value ~default:'o' io), mode), 
+          Mode.Ho (mode_of_IO (Option.value ~default:'o' io), List.rev @@ List.tl @@ List.rev (fst hd :: mode)), 
           aux ty
         ) }
 | io = option(IO_COLON); hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO (Option.value ~default:'o' io)), mkAppF (loc $loc(hd)) hd args) }
diff --git a/tests/sources/mode_checking_ho.elpi b/tests/sources/mode_checking_ho.elpi
index f48c09ba9..52fc5fb94 100644
--- a/tests/sources/mode_checking_ho.elpi
+++ b/tests/sources/mode_checking_ho.elpi
@@ -24,4 +24,10 @@ pred q i:prop, o:prop.
 q A R :- A, R = A. % Everything goes moothly!
 q A R :- R, R = A. % Mh, R is output, ie supposed flex
 
+pred r0 i:(i:A -> i:B -> prop), i:A, i:B.
+r0 F A B :- F A B.
+
+pred r1 i:(i:A -> i:B -> i:C -> prop), i:A, i:B, o:C.
+r1 F A B C :- F A B C. % Not good: C is in output but used as input in F
+
 main.
\ No newline at end of file
diff --git a/tests/suite/correctness_FO.ml b/tests/suite/correctness_FO.ml
index 7d4ceb6e8..0ef77d993 100644
--- a/tests/suite/correctness_FO.ml
+++ b/tests/suite/correctness_FO.ml
@@ -221,9 +221,9 @@ let () = declare "mode_checking_fo"
   ~description:"mode_checking_fo"
   ~expectation:(SuccessOutputTxt (
     let expected = [|
-      "WARNING: Not ground cdata Y passed to const p "; 
-      "WARNING: The variables \\[cdata Y\\] are in output position of the predicate\" "; 
-      " const p \"and cannot be ensured to be ground "|] in
+      "WARNING: Not ground Y passed to p "; 
+      "WARNING: The variables \\[Y\\] are in output position of the predicate\" "; 
+      "\"and cannot be ensured to be ground "|] in
     mode_check expected "mode_checking_fo"
     ))
   ()
@@ -233,10 +233,13 @@ let () = declare "mode_checking_ho"
   ~description:"mode_checking_ho"
   ~expectation:(SuccessOutputTxt (
     let expected = [|
-      "WARNING: Not ground cdata Z passed to const p "; 
-      "WARNING: Not ground app \\[const con, cdata Z\\] passed to const p ";
-      "WARNING: Not ground X[0-9]+ c[0-9]+ passed to const p ";
-      "WARNING: Passed flexible to , "
+      "WARNING: Not ground Z passed to p "; 
+      "WARNING: Not ground (con Z) passed to p ";
+      "WARNING: Not ground X[0-9]+ c[0-9]+ passed to p ";
+      "WARNING: Passed flexible to , ";
+      "WARNING: Not ground C passed to c0 ";
+      "WARNING: The variables \\[C\\] are in output position of the predicate\" ";
+      "\"and cannot be ensured to be ground "
       |] in
     mode_check expected "mode_checking_ho"
     ))

From f08ba2790a7f287d399e5c46c8e97223e9a795dc Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Wed, 2 Oct 2024 16:26:41 +0200
Subject: [PATCH 19/32] [compiler] modes and types in a single data struct

---
 src/builtin.elpi                    |  52 ++++----
 src/builtin.ml                      |  38 ++----
 src/compiler.ml                     | 162 +++++++++++++++++++------
 src/data.ml                         |  14 ++-
 src/elpi-checker.elpi               | 107 ++++++++---------
 src/parser/ast.ml                   |  61 +++++++---
 src/parser/ast.mli                  |  56 ++++++---
 src/parser/grammar.mly              |  82 +++++--------
 tests/sources/chr.elpi              |   3 +-
 tests/sources/chrGCD.elpi           |   2 +-
 tests/sources/chrLEQ.elpi           |   4 +-
 tests/sources/hollight.elpi         |   4 +-
 tests/sources/llamchr.elpi          |   4 +-
 tests/sources/mode_checking_ho.elpi |   4 +-
 tests/sources/restriction3.elpi     |   3 +-
 tests/sources/trace_w.elab.json     | 180 ++++++++++++++--------------
 tests/sources/trace_w.json          | 132 ++++++++++----------
 tests/test.real.ml                  |  24 ++--
 18 files changed, 516 insertions(+), 416 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 722ec5e7c..126b0a2ce 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -170,52 +170,52 @@ external pred le_ i:A, i:A.
 % [ge_ X Y] checks if X >= Y. Works for string, int and float
 external pred ge_ i:A, i:A.
 
-type (<), (>), (=<), (>=) A -> A -> prop.
+pred (>) i:A, i:A.
+X > Y :- gt_ X Y.
 
-mode ((<) i i). mode ((>) i i). mode ((=<) i i). mode ((>=) i i). 
+pred (<) i:A, i:A.
+X < Y :- lt_ X Y.
 
-X  > Y  :- gt_ X Y.
+pred (=<) i:A, i:A.
+X =< Y :- le_ X Y.
 
-X  < Y  :- lt_ X Y.
+pred (>=) i:A, i:A.
+X >= Y :- ge_ X Y.
 
-X  =< Y :- le_ X Y.
+pred (i>) i:int, i:int.
+X i> Y :- gt_ X Y.
 
-X  >= Y :- ge_ X Y.
-
-type (i<), (i>), (i=<), (i>=) int -> int -> prop.
-
-mode ((i<) i i). mode ((i>) i i). mode ((i=<) i i). mode ((i>=) i i). 
-
-X i< Y  :- lt_ X Y.
-
-X i> Y  :- gt_ X Y.
+pred (i<) i:int, i:int.
+X i< Y :- lt_ X Y.
 
+pred (i=<) i:int, i:int.
 X i=< Y :- le_ X Y.
 
+pred (i>=) i:int, i:int.
 X i>= Y :- ge_ X Y.
 
-type (r<), (r>), (r=<), (r>=) float -> float -> prop.
+pred (r>) i:float, i:float.
+X r> Y :- gt_ X Y.
 
-mode ((r<) i i). mode ((r>) i i). mode ((r=<) i i). mode ((r>=) i i). 
-
-X r< Y  :- lt_ X Y.
-
-X r> Y  :- gt_ X Y.
+pred (r<) i:float, i:float.
+X r< Y :- lt_ X Y.
 
+pred (r=<) i:float, i:float.
 X r=< Y :- le_ X Y.
 
+pred (r>=) i:float, i:float.
 X r>= Y :- ge_ X Y.
 
-type (s<), (s>), (s=<), (s>=) string -> string -> prop.
-
-mode ((s<) i i). mode ((s>) i i). mode ((s=<) i i). mode ((s>=) i i). 
-
-X s< Y  :- lt_ X Y.
+pred (s>) i:string, i:string.
+X s> Y :- gt_ X Y.
 
-X s> Y  :- gt_ X Y.
+pred (s<) i:string, i:string.
+X s< Y :- lt_ X Y.
 
+pred (s=<) i:string, i:string.
 X s=< Y :- le_ X Y.
 
+pred (s>=) i:string, i:string.
 X s>= Y :- ge_ X Y.
 
 %  -- Standard data types (supported in the FFI) --
diff --git a/src/builtin.ml b/src/builtin.ml
index 01aad7f37..c0f8a2933 100644
--- a/src/builtin.ml
+++ b/src/builtin.ml
@@ -355,35 +355,15 @@ let core_builtins = let open BuiltIn in let open ContextualConversion in [
       { p = (<=); psym = "=<"; pname = "le_" } ;
       { p = (>=); psym = ">="; pname = "ge_" } ]
 
-  @ [
-
-  LPCode "type (<), (>), (=<), (>=) A -> A -> prop.";
-  LPCode "mode ((<) i i). mode ((>) i i). mode ((=<) i i). mode ((>=) i i). ";
-  LPCode "X  > Y  :- gt_ X Y.";
-  LPCode "X  < Y  :- lt_ X Y.";
-  LPCode "X  =< Y :- le_ X Y.";
-  LPCode "X  >= Y :- ge_ X Y.";
-
-  LPCode "type (i<), (i>), (i=<), (i>=) int -> int -> prop.";
-  LPCode "mode ((i<) i i). mode ((i>) i i). mode ((i=<) i i). mode ((i>=) i i). ";
-  LPCode "X i< Y  :- lt_ X Y.";
-  LPCode "X i> Y  :- gt_ X Y.";
-  LPCode "X i=< Y :- le_ X Y.";
-  LPCode "X i>= Y :- ge_ X Y.";
-
-  LPCode "type (r<), (r>), (r=<), (r>=) float -> float -> prop.";
-  LPCode "mode ((r<) i i). mode ((r>) i i). mode ((r=<) i i). mode ((r>=) i i). ";
-  LPCode "X r< Y  :- lt_ X Y.";
-  LPCode "X r> Y  :- gt_ X Y.";
-  LPCode "X r=< Y :- le_ X Y.";
-  LPCode "X r>= Y :- ge_ X Y.";
-
-  LPCode "type (s<), (s>), (s=<), (s>=) string -> string -> prop.";
-  LPCode "mode ((s<) i i). mode ((s>) i i). mode ((s=<) i i). mode ((s>=) i i). ";
-  LPCode "X s< Y  :- lt_ X Y.";
-  LPCode "X s> Y  :- gt_ X Y.";
-  LPCode "X s=< Y :- le_ X Y.";
-  LPCode "X s>= Y :- ge_ X Y.";
+  @ 
+  let build_symb (spref, ty) = 
+    let op_l = ["gt_";"lt_"; "le_"; "ge_"] in
+    let sym_l = List.map (fun x -> spref ^ x) [">";"<"; "=<"; ">="] in
+    let buildLPCode s op = LPCode (Printf.sprintf "pred (%s) i:%s, i:%s.\nX %s Y :- %s X Y." s ty ty s op) in
+    List.map2 buildLPCode sym_l op_l in
+  let symbs = ["", "A"; "i", "int"; "r", "float"; "s", "string"] in
+  List.flatten (List.map build_symb symbs) @
+  [
 
   LPDoc " -- Standard data types (supported in the FFI) --";
 
diff --git a/src/compiler.ml b/src/compiler.ml
index 9c6f3b6f9..de70b1fb7 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -822,19 +822,19 @@ end = struct (* {{{ *)
           aux_run ns blocks (c::clauses) macros types tabbrs modes functionality locals chr accs rest
       | Program.Macro m :: rest ->
           aux_run ns blocks clauses (m::macros) types tabbrs modes functionality locals chr accs rest
-      | Program.Pred (t,m) :: rest ->
+      | Program.Pred t :: rest ->
           aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
-            (Program.Mode [m] :: Program.Type [t] :: rest)
+            (Program.Mode [t] :: Program.Type [t] :: rest)
       | Program.Mode ms :: rest ->
-          aux_run ns blocks clauses macros types tabbrs (ms @ modes) functionality locals chr accs rest
-      | Program.Functionality f :: rest ->
-          assert (0 = 1);
-          aux_run ns blocks clauses macros types tabbrs modes (f @ functionality) locals chr accs rest
+          let t = List.map structure_type_attributes ms in
+          aux_run ns blocks clauses macros types tabbrs (t @ modes) functionality locals chr accs rest
       | Program.Type [] :: rest ->
           aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
-      | Program.Type (t::ts) :: rest ->
+      | Program.Type (t::ts) :: rest ->          
           let t = structure_type_attributes t in
-          let types = if List.mem t types then types else t :: types in
+          (* Format.sprintf "Going to rec call aux with %s" (Ast.Type.pp (fun f x -> Ast.Structured.pp_tattribute f (List.hd x))) t |> print_endline; *)
+          let types = if t.attributes <> Functional && List.mem t types then types else t :: types in
+          let functionality = if t.attributes = Functional then t.name :: functionality else functionality in
           aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
             (Program.Type ts :: rest)
       | Program.TypeAbbreviation abbr :: rest ->
@@ -1089,23 +1089,16 @@ let fresh_Arg =
 
 let get_Args s = StrMap.map fst (get_argmap s).n2t
 
-let preterm_of_ast ?(on_type=false) loc ~depth:arg_lvl macro state ast =
+let is_discard f = F.(equal f dummyname) || (F.show f).[0] = '_'
+let is_macro_name f = (F.show f).[0] = '@'
+
+
+let preterm_of_ast loc ~depth:arg_lvl macro state ast =
 
   let spilling = ref false in
   let spy_spill c =
     spilling := !spilling || c == D.Global_symbols.spillc in
 
-  let is_uvar_name f =  F.is_uvar_name f in
-    
-  let is_discard f =
-    F.(equal f dummyname) ||
-    let c = (F.show f).[0] in
-     c = '_' in
-
-  let is_macro_name f =
-     let c = (F.show f).[0] in
-     c = '@' in
-
   let rec hcons_alien_term state = function
     | Term.Const x ->
         Symbols.get_global_or_allocate_bound_symbol state x
@@ -1128,7 +1121,6 @@ let preterm_of_ast ?(on_type=false) loc ~depth:arg_lvl macro state ast =
   in
 
   let rec stack_macro_of_ast lvl state f =
-    if on_type then error ~loc ("Macros cannot occur in types. Use a typeabbrev declaration instead");
     try aux lvl state (fst (F.Map.find f macro))
     with Not_found -> error ~loc ("Undeclared macro " ^ F.show f)
 
@@ -1138,11 +1130,11 @@ let preterm_of_ast ?(on_type=false) loc ~depth:arg_lvl macro state ast =
     with Not_found ->
      if is_discard f then
        state, Discard
-     else if is_uvar_name f then
+     else if F.is_uvar_name f then
        mk_Arg state ~name:(F.show f) ~args:[]
      else if is_macro_name f then
        stack_macro_of_ast curlvl state f
-     else if not on_type && Builtins.is_declared_str state (F.show f) then
+     else if Builtins.is_declared_str state (F.show f) then
        state, Builtin(fst(Symbols.get_global_symbol state f),[])
      else if CustomFunctorCompilation.is_backtick f then
        CustomFunctorCompilation.compile_backtick state f
@@ -1234,6 +1226,94 @@ let preterm_of_ast ?(on_type=false) loc ~depth:arg_lvl macro state ast =
   state, t, !spilling
 ;;
 
+let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpression.t) =
+
+  let rec hcons_alien_term state = function
+    | Term.Const x ->
+        Symbols.get_global_or_allocate_bound_symbol state x
+    | Cons(x, y) ->
+       let state, x = hcons_alien_term state x in
+       let state, y = hcons_alien_term state y in
+       state, Term.mkCons x y
+    | UVar _ | AppUVar _ | Arg _ | AppArg _ -> assert false
+    | App(c,x,l) ->
+       let state, x = hcons_alien_term state x in
+       let state, l = map_acc hcons_alien_term state l in
+       state, Term.mkApp c x l
+    | Builtin(c,l) ->
+       let state, l = map_acc hcons_alien_term state l in
+       state, Term.mkBuiltin c l
+    | Lam x ->
+       let state, x = hcons_alien_term state x in
+       state, Term.mkLam x
+    | (Nil | CData _ | Discard) as x -> state, x
+  in
+
+  let stack_funct_of_ast curlvl state f  =
+    try state, F.Map.find f (get_varmap state)
+    with Not_found ->
+     if is_discard f then error ~loc "Discard operator cannot be used in type declaration"
+     else if F.is_uvar_name f then mk_Arg state ~name:(F.show f) ~args:[]
+     else if is_macro_name f then error ~loc "Macros cannot occur in types. Use a typeabbrev declaration instead"
+     else
+       let state, (_,t) = Symbols.allocate_global_symbol state f in
+       state, t in
+
+  let get_arrow_const lvl state = 
+    match stack_funct_of_ast lvl state (F.from_string "->") with 
+    | s, Const c -> s, c
+    | _ -> error ~loc "Unreachable branch" in
+
+  let rec aux lvl state = function
+    | Ast.TypeExpression.TConst f -> stack_funct_of_ast lvl state f
+    | TApp(f, hd, tl) ->
+      let tl = hd :: tl in
+      let state, rev_tl =
+        List.fold_left (fun (state, tl) t ->
+          let state, t = aux lvl state t in
+          (state, t::tl))
+        (state, []) tl in
+      let tl = List.rev rev_tl in
+      let state, c = stack_funct_of_ast lvl state f in
+      begin match c with
+      | Const c -> begin match tl with
+        | hd2::tl -> state, Term.App(c,hd2,tl)
+        | _ -> anomaly "Application node with no arguments" end
+      | App(c,hd1,tl1) -> state, Term.App(c,hd1,tl1@tl)
+      | Builtin(c,tl1) -> state, Term.Builtin(c,tl1@tl)
+      | Lam _ -> (* macro with args *)
+        hcons_alien_term state (R.deref_appuv ~from:lvl ~to_:lvl tl c)
+      | Discard -> error ~loc "Clause shape unsupported: _ cannot be applied"
+      | _ -> error ~loc "Clause shape unsupported" end
+    | TCData c -> state, CData (CData.hcons c)
+    | TArr (a,b) -> 
+      let state, a = aux lvl state a in
+      let state, b = aux lvl state b in
+      let state, c = get_arrow_const lvl state in
+      state, App(c, a, [b])
+    | TPred (_,l) -> 
+      let l = List.rev l in
+      let hd, tl = List.hd l, List.tl l in
+      List.fold_left (fun (state,t:  State.t * term) e ->
+        let state, t' = aux lvl state (snd e) in
+        let state, c = get_arrow_const lvl state in
+        state, App (c, t', [t])
+        ) (aux lvl state (snd hd)) tl
+  in
+  let a, b = aux arg_lvl state ast in a, b, false
+
+let typeabbrev_of_ast loc ~depth:depth macro state (ast: Ast.TypeAbbreviation.closedTypeexpression) =
+  let rec aux depth state = function
+    | Ast.TypeAbbreviation.Lam (x, t) ->
+       let orig_varmap = get_varmap state in
+       let state, c = Symbols.allocate_bound_symbol state depth in
+       let state = update_varmap state (F.Map.add x c) in
+       let state, t', _ = aux (depth+1) state t in
+       set_varmap state orig_varmap, Lam t', false
+    | Ty t -> type_expression_of_ast ~depth loc macro state t
+  in
+  aux depth state ast
+
 let lp ~depth state loc s =
   let module P = (val option_get ~err:"No parser" (State.get parser state)) in
   let loc, ast = P.goal ~loc ~text:s in
@@ -1265,15 +1345,15 @@ let prechr_rule_of_ast depth macros state r =
   { pto_match; pto_remove; pguard; pnew_goal; pamap; pname; pifexpr; pcloc }
   
 (* used below *)
-let preterms_of_ast ?on_type loc ~depth macros state f t =
+let of_ast transformer loc ~depth macros state f t =
   assert(is_empty_amap (get_argmap state));
-  let state, term, spilling = preterm_of_ast ?on_type loc ~depth macros state t in
+  let state, term, spilling = transformer loc ~depth macros state t in
   let state, terms = f ~depth state term in
   let amap = get_argmap state in
   let state = State.end_clause_compilation state in
   (* TODO: may have spurious entries in the amap *)
   state, List.map (fun (loc,term) -> { term; amap; loc; spilling }) terms
-;;
+;; 
 
 (* exported *)
 let query_preterm_of_function ~depth:_ macros state f =
@@ -1312,7 +1392,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
 
   let compile_type_abbrev geti lcs state { Ast.TypeAbbreviation.name; nparams; loc; value } =
     let state, (taname, _) = Symbols.allocate_global_symbol state name in
-    let state, tavalue = preterms_of_ast ~on_type:true loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) value in
+    let state, tavalue = of_ast typeabbrev_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) value in
     let tavalue = assert(List.length tavalue = 1); List.hd tavalue in
     if tavalue.amap.nargs != 0 then
       error ~loc ("type abbreviation for " ^ F.show name ^ " has unbound variables");
@@ -1332,7 +1412,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
   let compile_type lcs state { Ast.Type.attributes; loc; name; ty } =
     let state, (tname, _) = Symbols.allocate_global_symbol state name in
     let state, ttype =
-      preterms_of_ast ~on_type:true loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) ty in
+      of_ast type_expression_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) ty in
     let ttype = assert(List.length ttype = 1); List.hd ttype in
     state, { Types.tindex = attributes; decl = { tname; ttype; tloc = loc } }
 
@@ -1351,13 +1431,25 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
        ("Duplicate mode declaration for " ^ Symbols.show state name ^ " (also at "^
          Loc.show (snd (C.Map.find name map)) ^ ")")
 
-  let rec to_mode_rec = function
-    | [] -> []
-    | Ast.Mode.Fo fo :: tl -> Fo (bool2IO fo) :: to_mode_rec tl
-    | Ho (ho, xs) :: tl -> Ho (bool2IO ho, to_mode_rec xs) :: to_mode_rec tl
+  let to_mode = function Ast.Mode.Input -> Input | Output -> Output
 
-  let compile_mode (state, modes) { Ast.Mode.name; args; loc } =
-    let args = to_mode_rec args in
+  let rec to_mode_rec_aux = function
+  | [] -> []
+  | ((m: Ast.Mode.mode), Ast.TypeExpression.TPred (_,p)) :: l -> Ho (to_mode m, to_mode_rec_aux p) :: to_mode_rec_aux l 
+  | (m, _) :: l -> Fo (to_mode m) :: to_mode_rec_aux l
+  and to_mode_rec = function
+    | Ast.TypeExpression.TConst _ | TCData _ -> []
+    | TArr (a,b) -> []
+    | TPred (_, m) ->
+        let m = List.rev m |> List.tl |> List.rev in
+        to_mode_rec_aux m
+    | TApp (a,b,l) -> []
+
+  let compile_mode (state, modes) { Ast.Type.name; ty; loc } =
+    let o = open_out "/home/dfissore/Documents/github/ELPI_DEV/functionality/aa" in
+    Format.fprintf (Format.formatter_of_out_channel o) "Doing to mode of %s\n%!" (F.show name);
+    close_out o;
+    let args = to_mode_rec ty in
     let state, mname = funct_of_ast state name in
     check_duplicate_mode state mname (args,loc) modes;
     state, C.Map.add mname (args,loc) modes
@@ -1396,7 +1488,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     | [] -> lcs, state, []
     | { Ast.Clause.body; attributes; loc } :: rest ->
       let state, ts =
-        preterms_of_ast loc ~depth:lcs macros state (toplevel_clausify loc) body in
+        of_ast preterm_of_ast loc ~depth:lcs macros state (toplevel_clausify loc) body in
       let cl = List.map (fun body -> { Ast.Clause.loc; attributes; body}) ts in
       let lcs, state, rest = compile_clauses lcs state macros rest in
       lcs, state, cl :: rest
diff --git a/src/data.ml b/src/data.ml
index aa9160279..64c3a0384 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -84,6 +84,14 @@ let equal_stuck_goal_kind _ x y = x == y
 type 'unification_def stuck_goal_kind +=
   | Unification of 'unification_def
 
+type arg_mode = Util.arg_mode = Input | Output [@@deriving show, ord]
+
+type mode_aux = Util.mode_aux =
+  | Fo of arg_mode
+  | Ho of arg_mode * mode
+and mode = mode_aux list
+[@@ deriving show, ord]
+
 type term =
   (* Pure terms *)
   | Const of constant
@@ -116,8 +124,6 @@ let uvar_isnt_a_blocker { uid_private } = uid_private > 0 [@@inline];;
 let uvar_set_blocker r   = r.uid_private <- -(uvar_id r) [@@inline];;
 let uvar_unset_blocker r = r.uid_private <-  (uvar_id r) [@@inline];;
 
-type arg_mode = Util.arg_mode = Input | Output [@@deriving show, ord]
-
 type clause = {
     depth : int;
     args : term list;
@@ -127,10 +133,6 @@ type clause = {
     loc : Loc.t option; (* debug *)
     mutable timestamp : int list; (* for grafting *)
 }
-and mode_aux = Util.mode_aux =
-  | Fo of arg_mode
-  | Ho of arg_mode * mode
-and mode = mode_aux list
 [@@deriving show, ord]
 
 let bool2IO = function true -> Input | false -> Output
diff --git a/src/elpi-checker.elpi b/src/elpi-checker.elpi
index 8f2d04b06..93301985e 100644
--- a/src/elpi-checker.elpi
+++ b/src/elpi-checker.elpi
@@ -25,20 +25,18 @@ type wrong-arity term -> typ -> list term -> err.
 type unknown term -> err.
 type assert prop -> err -> prop.
 
-type error list (pair (ctype "Loc.t") string) -> bool -> prop.
-mode (error i o).
+pred error i:list (pair (ctype "Loc.t") string), o:bool.
 
 :name "default-typechecking-error"
 error Msg tt :- std.forall Msg (x\ sigma L M\ fst x L, snd x M, print L "Error:" M).
 
-mode (warning i i).
-type warning (ctype "Loc.t") -> string -> prop.
+pred warning i:(ctype "Loc.t"), o:string.
 :name "default-typechecking-warning"
 warning Loc Msg :- print Loc "Warning:" Msg.
 
-mode (assert i i).
+pred assert i:prop, i:err.
 assert P _ :- P, !.
-assert _ (type-err T Ty ETy) :- !,
+assert P (type-err T Ty ETy) :- !,
   checking LOC,
   ppt Ty TyPP, ppt ETy ETyPP,
   if (TyPP = ETyPP) (term_to_string Ty TyS, term_to_string ETy ETyS) (TyS = TyPP, ETyS = ETyPP),
@@ -51,7 +49,7 @@ assert _ (wrong-arity T Ty A) :- !,
           " but is applied to " ^ {pp-list A},
   error [pr LOC MSG] _.
 
-mode (stash-new i i).
+pred stash-new i:A, i:B.
 stash-new E S :- open_safe E L, ( std.mem! L S ; stash_in_safe E S ), !.
 
 report-all-failures-if-no-success P RC :-
@@ -65,8 +63,7 @@ report-all-failures-and-fail-if-no-success P RC :-
    ;
    (error {open_safe E} RC, fail)).
 
-mode (pp i o).
-type pp term -> string -> prop.
+pred pp i:term, o:string.
 pp (app L) T1 :- !, pp-list L T, T1 is "(" ^ T ^ ")".
 pp (lam F) T :- !, pi x\ term_to_string x XS, (pp x XS :- !) => pp (F x) T.
 pp (const "discard") "_" :- !.
@@ -74,19 +71,19 @@ pp (const S) S :- !.
 pp (cdata X) S :- !, term_to_string X S.
 pp X XS :- term_to_string X XS.
 
-mode (pp-list i o).
+pred pp-list i:list term, o:string.
 pp-list [X] Y :- !, pp X Y.
 pp-list [X|XS] Y :- pp-list XS XSS, pp X XT, Y is XT ^ " " ^ XSS.
 pp-list [] "".
 
-mode (ppt i o).
+pred ppt i:typ, o:string.
 ppt (ctype S) X :- !, X is "(ctype " ^ S ^ ")".
 ppt (tconst X) X :- !.
 ppt (tapp L) X :- !, ppt-list L T, X is "(" ^ T ^ ")".
 ppt (arrow A B) S :- !, ppt A AS, ppt B BS, S is "(" ^ AS ^ " -> " ^ BS ^ ")".
 ppt X Y :- term_to_string X Y.
 
-mode (ppt-list i o).
+pred ppt-list i:list typ, o:string.
 ppt-list [X] Y :- !, ppt X Y.
 ppt-list [X|XS] Y :- ppt-list XS XSS, ppt X XT, Y is XT ^ " " ^ XSS.
 ppt-list [] "".
@@ -105,7 +102,7 @@ rm-any-variadic prop prop.
 rm-any-variadic (arrow A1 B1) (arrow A2 B2) :- rm-any-variadic A1 A2, rm-any-variadic B1 B2.
 rm-any-variadic (uvar as X) X.
 
-mode (rm-any-variadic-list i o).
+pred rm-any-variadic-list i:list typ, o:list typ.
 rm-any-variadic-list [] [].
 rm-any-variadic-list [X|XS] [Y|YS] :- rm-any-variadic X Y, rm-any-variadic-list XS YS.
 
@@ -122,7 +119,7 @@ of (app [HD|ARGS]) TY :- !,
 of (lam F) (arrow T B) :- !, pi x\
   (of x T :- !) => of (F x) B.
 
-mode (of-app i i o o o).
+pred of-app i:typ i:list term, o:typ, o:term, o:A.
 
 :if "DEBUG:CHECKER"
 of-app Ty Args Tgt Hd _ :-
@@ -144,7 +141,7 @@ of-app (uvar as Ty)  [] TGT HD (D - []) :- !,
 of-app Ty Args _ HD (D - []) :- !,
   assert false (wrong-arity (app [HD|D]) Ty Args).
 
-mode (of-clause i i).
+pred of-clause i:list string, i:term.
 of-clause [N|NS] (arg C) :- !, pi x\ 
  (pp x N :- !) => (pi Tf\ of x Tf :- !, assert (unif T Tf) (type-err x T Tf)) =>
  of-clause NS (C x).
@@ -159,7 +156,7 @@ type checking (ctype "Loc.t") -> prop.
 log-tc-clause Loc Query :- !, print {trace.counter "run"} "typecheck" Loc Query.
 log-tc-clause _ _.
 
-mode (typecheck i i i i i).
+pred typecheck i:list term, i:term, i:float, i:A, i:B.
 typecheck P _ T0 NP _RC :- D is {gettimeofday} - T0, D > 10.0, !,
   print "[skipping" {std.length P} "clauses out of" NP "due to time limit]".
 
@@ -174,7 +171,8 @@ typecheck [ (clause Loc Names Clause) | Rest] Q T0 NP RC :-
     report-all-failures-if-no-success (of-clause Names Clause) RC, !,
   typecheck Rest Q T0 NP RC.
 
-mode (refresh i o).
+% mode (refresh i o).
+pred refresh i:typ, o:typ.
 refresh (forall F) T :- !, refresh (F FRESH_) T.
 refresh (tconst "any") FRESH_ :- !.
 refresh X X.
@@ -205,16 +203,16 @@ collect-symbols-program [ C | P ] Acc Res :-
   collect-symbols-program P Acc1 Res.
 collect-symbols-program [] X X.
 
-mode (under-env i i).
+pred under-env i:A, i:B.
 
 type known term -> prop.
 
-mode (similar i i).
+pred similar i:A, i:B.
 similar S1 S2 :-
   R is ".*\\." ^ {rex_replace "[\\+\\*]" "." S2},
   rex_match R S1.
 
-mode (filter-similar i i o).
+pred filter-similar i:A, i:B, o:C.
 filter-similar [] _ [].
 filter-similar [const K `: _ |KS] S [K|R] :- similar K S, !, filter-similar KS S R.
 filter-similar [_|KS] S R :- filter-similar KS S R.
@@ -223,7 +221,7 @@ pred str_concat i:list string, o:string.
 str_concat [] "".
 str_concat [S|SS] R :- str_concat SS RR, R is S ^ " " ^ RR.
 
-mode (warn-undeclared i i o).
+pred warn-undeclared i:A, i:B, o:C.
 warn-undeclared _Known (pr ( "main") _) ff :- !.
 warn-undeclared _ (pr ( S) _) ff :- rex_match ".*\\.aux" S, !.
 warn-undeclared _ (pr ( S) _) ff :- rex_match ".*\\.aux\\." S, !.
@@ -233,7 +231,7 @@ warn-undeclared Known (pr ( S) LOC) tt :-
   MSG is "constant " ^ S ^ " has no declared type." ^ H,
   warning LOC MSG.
 
-mode (forall_uto10 i i i).
+pred forall_uto10 i:A, i:B, i:C.
 forall_uto10 [] _ _ :- !.
 forall_uto10 [X|XS] N P :- N < 10, !,
   P X Done, !,
@@ -243,7 +241,7 @@ forall_uto10 ([pr _ LOC|_] as L) _ _ :-
   Msg is "[suppressing " ^ {term_to_string {std.length L}} ^ " warnings]",
   warning LOC Msg.
   
-mode (under-decl-env i i).
+pred under-decl-env i:A, i:B.
 under-decl-env [] P :- P.
 under-decl-env [ X `: PT | XS ] P :-
   %print "Assume" X PT,
@@ -254,7 +252,7 @@ under-undecl-env [ pr X _ | XS ] P :-
   %print "Assume" X PT,
   (of (const X) Ty_ :- !) => under-undecl-env XS P.
 
-mode (rm-known i i o).
+pred rm-known i:A, i:B, o:C.
 rm-known (const N `: _) S S1 :- std.string.map.remove N S S1.
 
 :if "TIME:CHECKER"
@@ -265,7 +263,7 @@ pred check-all-symbols i:std.string.map loc.
 :name "check-all-symbols:main"
 check-all-symbols _.
 
-mode (typecheck-program i i i o).
+pred typecheck-program i:A, i:B, i:C, o:D.
 :name "typecheck-program:main"
 typecheck-program P Q DeclaredTypes RC :-
   KnownTypes = [
@@ -293,7 +291,7 @@ type variable term -> prop.
 pred silence-linear-warning i:string.
 silence-linear-warning VN :- rex_match "^_.*" VN ; rex_match ".*_$" VN.
 
-mode (report-linear i).
+pred report-linear i:A.
 report-linear [].
 report-linear [(V >>> 1 + uvar) |NS] :- !,
   pp V VN,
@@ -312,23 +310,22 @@ report-linear [(V >>> uvar) |NS] :-
   report-linear NS.
 report-linear [(_ >>> _) | NS] :- report-linear NS.
 
-type count A -> list B -> prop.
-mode (count i i).
+pred count i:A, i:list B.
 count (lam F) E :- pi x\ count (F x) E.
 count (app [X|XS]) E :- !, count X E, count (app XS) E.
 count (app []) _ :- !.
 count X E :- variable X, !, incr X E.
 count _ _.
 
-mode (incr i i).
+pred incr i:A, i:B.
 incr X [(X >>> K) | _] :- add1 K.
 incr X [_ | XS] :- incr X XS.
 
-mode (add1 i).
+pred add1 i:A.
 add1 (uvar as K) :- K = 1 + FRESH_.
 add1 (1 + K) :- add1 K.
 
-mode (check-non-linear i i i).
+pred check-non-linear i:A, i:B, i:C.
 check-non-linear [N|NS] (arg C) L :- pi x\
  (pp x N :- !) => (variable x) => check-non-linear NS (C x) [(x >>> FRESH_) | L].
 check-non-linear [] (arg C) L :- pi x\
@@ -336,7 +333,7 @@ check-non-linear [] (arg C) L :- pi x\
 check-non-linear _ C L :-
   count C L, report-linear L.
 
-mode (warn-linear i).
+pred warn-linear i:A.
 :name "warn-linear:main"
 warn-linear [].
 warn-linear [ (clause Loc Names Clause) |CS] :-
@@ -349,13 +346,13 @@ main.
 
 % ------- entry ---------------------------------------
 
-mode (type->ppt-clause i i i o).
+pred type->ppt-clause i:A, i:B, i:C, o:D.
 type->ppt-clause S ACC (forall F) (pi C) :- !,
   pi x\ type->ppt-clause S [x|ACC] (F x) (C x).
 type->ppt-clause S [] T (pi Str\ ppt T Str :- !, ppt (tconst S) Str).
 type->ppt-clause S ACC T (pi Str\ ppt T Str :- !, ppt (tapp [tconst S|Args]) Str) :- std.rev ACC Args.
 
-mode (compile-type-abbreviations i o).
+pred compile-type-abbreviations i:A, o:B.
 compile-type-abbreviations [] [].
 compile-type-abbreviations [(_ `:= tconst _)|TS] Clauses :- !,
   % we don't refold immediate aliases
@@ -371,7 +368,7 @@ macro @rigid-term :- (cdata "rigid-term").
 
 to-constant V :- V = @rigid-term.
 
-mode (to-rigid-term i).
+pred to-rigid-term i:term.
 to-rigid-term N :- name N, !.
 to-rigid-term V :- var V, !, to-constant V.
 to-rigid-term (cdata (uvar _ as V)) :- !, to-constant V.
@@ -381,7 +378,7 @@ to-rigid-term (lam F) :- !, pi x\ to-rigid-term (F x).
 to-rigid-term (const _) :- !.
 to-rigid-term A :- halt "Error in to-rigid-term" A.
 
-mode (is-rigid-term i).
+pred is-rigid-term i:term.
 is-rigid-term N :- name N, !.
 is-rigid-term V :- var V, !, fail.
 is-rigid-term (cdata (uvar _ as V)) :- !, to-constant V.
@@ -391,7 +388,7 @@ is-rigid-term (lam F) :- !, pi x\ is-rigid-term (F x).
 is-rigid-term (const _) :- !.
 is-rigid-term A :- halt "Error in is-rigid-term" A.
 
-mode (build-mode i o).
+pred build-mode i:list A, o:list bool.
 build-mode L R :- std.map L (x\r\ r = mode-fo false) R.
 
 pred add-no-modes o:list A, i:A.
@@ -400,24 +397,25 @@ add-no-modes [X|_] Y :- not (var X), X = Y, !.
 add-no-modes [X|Xs] T :- var Xs, !, print "No mode for" X, Xs = [T|Y_].
 add-no-modes [_|Xs] T :- !, add-no-modes Xs T.
 
-mode (find-mode.aux i i i i o).
+pred find-mode.aux i:A, i:B, i:C, i:D, o:E.
 find-mode.aux [] NoModes_ X _ _ :- fatal-no-mode, halt "Check-well-modes-negative: no mode for" X.
 find-mode.aux [] NoModes X Args R :- !, add-no-modes NoModes X, build-mode Args R .
 find-mode.aux [pr X R|_] _ X _ R :- !.
 find-mode.aux [_ | Xs] NoModes X Args R :- !, find-mode.aux Xs NoModes X Args R.
 
-mode (find-mode i i o).
+pred find-mode i:A, i:B, o:C.
 find-mode X Args R :- modes Modes, no-modes NoModes, find-mode.aux Modes NoModes X Args R. 
 
-mode (get-head-mode i o).
+pred get-head-mode i:A, o:B.
 get-head-mode (mode-fo M) M :- !.
 get-head-mode (mode-ho M _) M :- !.
 
-mode (set-head-mode i i).
+pred set-head-mode i:A, i:B.
 set-head-mode Head Args :-
   find-mode Head Args Mode, !,
-  if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for (2)" Head Loc),
-  std.forall2 Mode Args (m\t\ if (get-head-mode m true) (to-rigid-term t) true).
+  if ({std.length Mode} = {std.length Args}) 
+    (std.forall2 Mode Args (m\t\ if (get-head-mode m true) (to-rigid-term t) true)) 
+    (print "Invalid mode length for (2)" Head Loc).
 set-head-mode _ _.
 
 pred get-vars i:term, o:list string.
@@ -429,7 +427,7 @@ get-vars (const T) [] :- !.
 get-vars A [B] :- var A, !, pp A B.
 get-vars A _ :- halt "Error in get-vars" A.
 
-mode (check-head-output i i i).
+pred check-head-output i:A, i:B, i:C.
 check-head-output Head Args Loc :-
   find-mode Head Args Mode, !, 
   std.forall2 Mode Args (m\t\ sigma Vars\
@@ -438,11 +436,11 @@ check-head-output Head Args Loc :-
       print "WARNING: The variables" Vars "are in output position of the predicate\"" Head "\"and cannot be ensured to be ground" Loc))).
 check-head-output _ _ _.
 
-mode (variadic-mode i).
+pred variadic-mode i:A.
 variadic-mode (const "halt").
 variadic-mode (const "print").
 
-mode (is-ho-predicate i).
+pred is-ho-predicate i:A.
 is-ho-predicate (@rigid-term).
 
 pred map-var o:A, i:string, o:prop.
@@ -471,7 +469,7 @@ check-args-mode HD _ _ Loc Mode Arg :-
 check-args-mode _ _ _ _ Mode Arg :- get-head-mode Mode ModeP, ModeP, !.
 check-args-mode _ _ _ _ Mode Arg :- get-head-mode Mode ModeP, not ModeP, to-rigid-term Arg.
 
-mode (check-well-moded-negative i i).
+pred check-well-moded-negative i:A, i:B.
 check-well-moded-negative _        N :- name N, !.
 % check-well-moded-negative _        V :- var V, !, to-constant V.
 check-well-moded-negative _        (cdata (uvar _ as V)) :- !, to-constant V.
@@ -491,20 +489,21 @@ check-well-moded-negative Loc (app [HD|Args]) :- !,
     true,
   find-mode HD Args Mode,
   % print "Mode is" Mode,
-  if ({std.length Mode} = {std.length Args}) true (halt "Invalid mode length for" HD Loc),
-  std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh").
+  if ({std.length Mode} = {std.length Args}) 
+    (std.forall2 Mode Args (x\y\std.assert!(check-args-mode HD NoModes AllModes Loc x y) "Mh")) 
+    (print "Invalid mode length for" HD Loc).
 check-well-moded-negative Loc (lam F) :- !, 
   pi x\ check-well-moded-negative Loc (F x).
 check-well-moded-negative _       (const _ as _) :- !.
 
-mode (check-well-moded-negative-list i i).
+pred check-well-moded-negative-list i:A, i:B.
 check-well-moded-negative-list [] _ :- !.
 check-well-moded-negative-list [X | Xs] Loc :-
   check-well-moded-negative Loc X,
   check-well-moded-negative-list Xs Loc.
 
-mode (to-check i).
-to-check _ :- !, true.
+pred to-check i:A.
+to-check _ :- fail, !, true.
 % to-check "r1" :- !.
 
 pred check-well-moded-positive-ho-mode i:list term, i:list A, i:list term, i:B.
@@ -552,7 +551,7 @@ head-symbol (const C) C.
 head-symbol (app [const ":-", X | _]) S :- !, head-symbol X S.
 head-symbol (app [const C|L]) C.
 
-mode (check-well-moded-prog i).
+pred check-well-moded-prog i:A.
 check-well-moded-prog [] :- !.
 check-well-moded-prog [clause Loc Vars Body | Tl] :-
   if (to-check {head-symbol Body})
@@ -561,7 +560,7 @@ check-well-moded-prog [clause Loc Vars Body | Tl] :-
 
 check-overlapping-prog [] _ :- !.
 
-mode (check i i i i i i).
+pred check i:A, i:B, i:C, i:D, i:E, i:F.
 :name "check:main"
 check P Q DeclaredTypes TypeAbbreviations Modes _FuncPred :-
   compile-type-abbreviations TypeAbbreviations Abbrevs,
diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index ff9895946..f0c288c10 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -59,6 +59,37 @@ module Func = struct
 
 end
 
+module Mode = struct
+
+  type mode = Util.arg_mode = Input | Output
+  [@@deriving show, ord]
+
+end
+
+type raw_attribute =
+  | If of string
+  | Name of string
+  | After of string
+  | Before of string
+  | Replace of string
+  | Remove of string
+  | External
+  | Index of int list * string option
+  | Functional
+[@@deriving show, ord]
+
+module TypeExpression = struct
+
+  type t =
+   | TConst of Func.t
+   | TApp of Func.t * t * t list
+   | TPred of raw_attribute list * ((Mode.mode * t) list)
+   | TArr of t * t
+   | TCData of CData.t
+  [@@ deriving show, ord]
+
+end
+
 module Term = struct
   
   type t_ =
@@ -212,28 +243,22 @@ module Type = struct
     loc : Loc.t;
     attributes : 'attribute;
     name : Func.t;
-    ty : Term.t;
+    ty : TypeExpression.t;
   }
   [@@deriving show, ord]
 
 end
 
-module Mode = struct
-
-  type mode = Fo of bool | Ho of bool * (mode list)
-  [@@deriving show, ord]
-
-  type 'name t =
-    { name : 'name; args : mode list; loc : Loc.t }
-  [@@deriving show, ord]
-
-end
-
 module TypeAbbreviation = struct
 
+  type closedTypeexpression = 
+    | Lam of Func.t * closedTypeexpression 
+    | Ty of TypeExpression.t
+  [@@ deriving show, ord]
+
   type ('name) t =
-    { name : 'name; value : Term.t; nparams : int; loc : Loc.t }
-  [@@deriving show, ord]
+    { name : 'name; value : closedTypeexpression; nparams : int; loc : Loc.t }
+  [@@ deriving show, ord]
 
 end
 
@@ -253,12 +278,12 @@ module Program = struct
     (* data *)
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
-    | Mode of Func.t Mode.t list
-    | Functionality of Func.t list
+    (* TODO: to remove *)
+    | Mode of raw_attribute list Type.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list
-    | Pred of raw_attribute list Type.t * Func.t Mode.t
+    | Pred of raw_attribute list Type.t
     | TypeAbbreviation of Func.t TypeAbbreviation.t
     | Ignored of Loc.t
   [@@deriving show]
@@ -319,7 +344,7 @@ type program = {
   macros : (Func.t, Term.t) Macro.t list;
   types : tattribute Type.t list;
   type_abbrevs : Func.t TypeAbbreviation.t list;
-  modes : Func.t Mode.t list;
+  modes : tattribute Type.t list;
   functionality : Func.t list;
   body : block list;
 }
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index e0d39e19e..66843f80e 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -39,6 +39,35 @@ module Func : sig
   module Map : Map.S with type key = t
 end
 
+module Mode : sig
+
+  type mode = Input | Output
+  [@@deriving show, ord]
+
+end
+
+type raw_attribute =
+  | If of string
+  | Name of string
+  | After of string
+  | Before of string
+  | Replace of string
+  | Remove of string
+  | External
+  | Index of int list * string option
+  | Functional
+[@@ deriving show]
+
+module TypeExpression : sig
+  type t =
+   | TConst of Func.t
+   | TApp of Func.t * t * t list
+   | TPred of raw_attribute list * ((Mode.mode * t) list)
+   | TArr of t * t
+   | TCData of CData.t
+  [@@ deriving show, ord]
+end
+
 module Term : sig
 
   type t_ =
@@ -138,28 +167,22 @@ module Type : sig
     loc : Loc.t;
     attributes : 'attribute;
     name : Func.t;
-    ty : Term.t;
+    ty : TypeExpression.t;
   }
   [@@ deriving show]
 
 end
 
-module Mode : sig
-
-  type mode = Fo of bool | Ho of bool * (mode list)
-  [@@deriving show, ord]
+module TypeAbbreviation : sig
 
-  type 'name t =
-    { name : 'name; args : mode list; loc : Loc.t }
+  type closedTypeexpression = 
+    | Lam of Func.t * closedTypeexpression 
+    | Ty of TypeExpression.t
   [@@ deriving show, ord]
 
-end
-
-module TypeAbbreviation : sig
-
   type ('name) t =
-    { name : 'name; value : Term.t; nparams : int; loc : Loc.t }
-  [@@ deriving show]
+    { name : 'name; value : closedTypeexpression; nparams : int; loc : Loc.t }
+  [@@ deriving show, ord]
 
 end
 
@@ -178,12 +201,11 @@ module Program : sig
     (* data *)
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
-    | Mode of Func.t Mode.t list
-    | Functionality of Func.t list
+    | Mode of raw_attribute list Type.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list
-    | Pred of raw_attribute list Type.t * Func.t Mode.t
+    | Pred of raw_attribute list Type.t
     | TypeAbbreviation of Func.t TypeAbbreviation.t
     | Ignored of Loc.t
   [@@ deriving show]
@@ -217,7 +239,7 @@ type program = {
   macros : (Func.t, Term.t) Macro.t list;
   types : tattribute Type.t list;
   type_abbrevs : Func.t TypeAbbreviation.t list;
-  modes : Func.t Mode.t list;
+  modes : tattribute Type.t list;
   functionality : Func.t list;
   body : block list;
 }
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 9a7dac753..a43f5531c 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -13,6 +13,8 @@ open Parser_config
 open Ast
 open Term
 
+open TypeExpression
+
 
 let loc (startpos, endpos) = {
   Util.Loc.source_name = startpos.Lexing.pos_fname;
@@ -92,8 +94,8 @@ let prop = Func.from_string "prop"
 let fix_church x = if Func.show x = "o" then prop else x
 
 let mode_of_IO io =
-  if io = 'i' then true
-  else if io = 'o' then false
+  if io = 'i' then Mode.Input
+  else if io = 'o' then Mode.Output
   else assert false
 
 %}
@@ -130,10 +132,10 @@ program:
 decl:
 | c = clause; FULLSTOP { Program.Clause c }
 | r = chr_rule; FULLSTOP { Program.Chr r }
-| p = pred; FULLSTOP { Program.Pred (snd p, fst p) }
+| p = pred; FULLSTOP { Program.Pred p }
 | t = type_; FULLSTOP { Program.Type t }
 | t = kind; FULLSTOP { Program.Type t }
-| m = mode; FULLSTOP { Program.Mode [m] }
+| m = mode; FULLSTOP { Util.error ~loc:(loc $sloc) "mode is no more accepted as a valid token" }
 | m = macro; FULLSTOP { Program.Macro m }
 | CONSTRAINT; hyps = list(constant); QDASH; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, hyps, cl) }
 | CONSTRAINT; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, [], cl) }
@@ -174,41 +176,21 @@ chr_rule:
 
 pred:
 | attributes = attributes; PRED;
-  c = constant; args = separated_list(option(CONJ),pred_item) {
-   let name = c in
-   { Mode.loc=loc $sloc; name; args = List.map fst args },
-   { Type.loc=loc $sloc; attributes; name;
-     ty = List.fold_right (fun (_,t) ty ->
-       mkApp (loc $loc(c)) [mkCon (t.loc)(* BUG *)"->";t;ty]) args (mkCon (loc $sloc) (* BUG *) "prop") }
+  name = constant; args = separated_list(option(CONJ),pred_item) {
+   { Type.loc=loc $sloc; name; attributes; ty = TPred ([], args @ [mode_of_IO 'o', TConst (Func.from_string "prop")]) }
  }
 pred_item:
-// | io = IO_COLON; ty = type_term { (Mode.Fo (mode_of_IO io),ty) }
-| io = IO_COLON; c = constant { (Mode.Fo (mode_of_IO io), Const (fix_church c)) }
-| io = IO_COLON; LPAREN; hd = pred_item_opt; ARROW; l=separated_nonempty_list(ARROW, pred_item_opt); RPAREN 
-      { let mode, ty = List.split l in
-        let ty = snd hd :: ty in
-        let rec aux = function [] | [_] -> failwith "Error" 
-          | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
-        in
-        (
-          Mode.Ho (mode_of_IO io, List.rev @@ List.tl @@ List.rev (fst hd :: mode)), 
-          aux ty
-        ) }
-| io = IO_COLON; hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO io), mkAppF (loc $loc(hd)) hd args) }
-
-pred_item_opt:
-| io = option(IO_COLON); c = constant { (Mode.Fo (mode_of_IO (Option.value ~default:'o' io)), Const (fix_church c)) }
-| io = option(IO_COLON); LPAREN; hd = pred_item_opt; ARROW; l=separated_nonempty_list(ARROW, pred_item_opt); RPAREN 
-      { let mode, ty = List.split l in
-        let ty = snd hd :: ty in
-        let rec aux = function [] | [_] -> failwith "Error" 
-          | [a;b] -> mkApp (loc $loc(hd)) [mkCon "->"; a; b] | a :: tl -> mkApp (loc $loc(hd)) [mkCon "->"; a; aux tl]
-        in
-        (
-          Mode.Ho (mode_of_IO (Option.value ~default:'o' io), List.rev @@ List.tl @@ List.rev (fst hd :: mode)), 
-          aux ty
-        ) }
-| io = option(IO_COLON); hd = constant; args = nonempty_list(atype_term) { (Mode.Fo (mode_of_IO (Option.value ~default:'o' io)), mkAppF (loc $loc(hd)) hd args) }
+| io = IO_COLON; ty = type_term { (mode_of_IO io,ty) }
+
+anonymous_pred:
+| attributes = attributes; PRED;
+  args = separated_list(option(CONJ),pred_item) { TPred (attributes, args @ [mode_of_IO 'o', TConst (Func.from_string "prop")]) }
+
+// Still parsing the mode string, but then an error is raised
+mode:
+| MODE; LPAREN; c = constant; l = nonempty_list(i_o); RPAREN { Util.error ~loc:(loc $sloc) "mode is no more accepted as a valid token" }
+i_o:
+| io = IO { mode_of_IO io }
 
 
 kind:
@@ -224,25 +206,20 @@ type_:
   }
 
 atype_term:
-| c = STRING { mkC (loc $loc) (cstring.Util.CData.cin c) }
-| c = constant { mkConst (loc $loc(c)) (fix_church c) }
+| c = STRING { TCData (cstring.Util.CData.cin c) }
+| c = constant { TConst (fix_church c) }
 | LPAREN; t = type_term; RPAREN { t }
+| LPAREN; t = anonymous_pred; RPAREN { t }
 type_term:
-| c = constant { mkConst (loc $loc(c)) (fix_church c) }
-| hd = constant; args = nonempty_list(atype_term) { mkAppF (loc $loc) (loc $loc(hd),hd) args }
-| hd = type_term; a = ARROW; t = type_term { mkApp (loc $loc) [mkCon (loc $loc(a)) "->"; hd; t] }
+| c = constant { TConst (fix_church c) }
+| hd = constant; args = nonempty_list(atype_term) { TApp (hd, List.hd args, List.tl args) }
+| hd = type_term; ARROW; t = type_term { TArr (hd, t) }
+| LPAREN; t = anonymous_pred; RPAREN { t }
 | LPAREN; t = type_term; RPAREN { t }
 
 kind_term:
-| TYPE { mkCon (loc $loc) "type" }
-| hd = TYPE; ARROW; t = kind_term { mkApp (loc $loc(hd)) [mkCon (loc $loc) "->"; mkCon (loc $loc) "type"; t] }
-
-mode:
-| MODE; LPAREN; c = constant; l = nonempty_list(i_o); RPAREN {
-    { Mode.name = c; args = l; loc = loc $sloc } 
-}
-i_o:
-| io = IO { Mode.Fo (mode_of_IO io) }
+| TYPE { TConst (Func.from_string "type") }
+| TYPE; ARROW; t = kind_term { TArr (TConst (Func.from_string "type"), t) }
 
 macro:
 | MACRO; m = term; VDASH; b = term {
@@ -254,7 +231,8 @@ typeabbrev:
 | TYPEABBREV; a = abbrevform; t = type_term {
     let name, args = a in
     let nparams = List.length args in
-    let value = List.fold_right (fun (n,loc) -> mkLam loc (Func.show n)) args t in
+    let mkLam n body =  TypeAbbreviation.Lam (n, body) in
+    let value = List.fold_right mkLam args (Ty t) in
     { TypeAbbreviation.name = name;
       nparams = nparams;
       value = value;
diff --git a/tests/sources/chr.elpi b/tests/sources/chr.elpi
index 8be33882d..7d077c547 100644
--- a/tests/sources/chr.elpi
+++ b/tests/sources/chr.elpi
@@ -3,7 +3,8 @@ type lam (term -> term) -> term.
 type arr ty -> ty -> ty.
 type nat ty.
 type bool ty.
-mode (term i o).
+
+pred term i:term, o:ty.
 term (app HD ARG) TGT :- term HD (arr SRC TGT), term ARG SRC.
 term (lam F) (arr SRC TGT) :- pi x\ term x SRC => term (F x) TGT.
 term (uvar as X) T :- declare_constraint (term X T) [X].
diff --git a/tests/sources/chrGCD.elpi b/tests/sources/chrGCD.elpi
index c0c7e98da..4734a4c47 100644
--- a/tests/sources/chrGCD.elpi
+++ b/tests/sources/chrGCD.elpi
@@ -1,4 +1,4 @@
-mode (gcd i i).
+pred gcd i:int, i:group.
 kind group type.
 type group-1 group.
 type group-2 group.
diff --git a/tests/sources/chrLEQ.elpi b/tests/sources/chrLEQ.elpi
index 0634b8b40..1fb34dd94 100644
--- a/tests/sources/chrLEQ.elpi
+++ b/tests/sources/chrLEQ.elpi
@@ -1,9 +1,9 @@
-mode (leq i i).
+pred leq i:int, i:int.
 leq (uvar as A) (uvar as B) :- !,  declare_constraint (leq A B) [A,B].
 leq A         (uvar as B) :- !,  declare_constraint (leq A B) [B].
 leq (uvar as A) B         :- !,  declare_constraint (leq A B) [A].
 
-mode (ltn i i).
+pred ltn i:int, i:int.
 ltn (uvar as A) (uvar as B) :- !,  declare_constraint (ltn A B) [A,B].
 ltn A         (uvar as B) :- !,  declare_constraint (ltn A B) [B].
 ltn (uvar as A) B         :- !,  declare_constraint (ltn A B) [A].
diff --git a/tests/sources/hollight.elpi b/tests/sources/hollight.elpi
index 968a1a72c..c1fdbc175 100644
--- a/tests/sources/hollight.elpi
+++ b/tests/sources/hollight.elpi
@@ -62,14 +62,14 @@ typ' (univ ## A ## B) :- typ A, typ B.
 typ' (A --> B) :- typ A, typ B.
 typ' (disj_union ## A ## B) :- typ A, typ B.
 
-mode (term i o).
+pred term i:A, o:B.
 term (lam A F) (A --> B) :- typ A, pi x\ term x A => term (F x) B.
 term (F # T) B :- term F (A --> B), term T A.
 term (eq ## A) (A --> A --> prop) :- typ A.
 term (uvar as T) TY :- declare_constraint (term T TY) T.
 
 /* like term, but on terms that are already known to be well-typed */
-mode (reterm i o).
+pred reterm i:A, o:B.
 reterm (lam A F) (A --> B) :- pi x\ reterm x A => reterm (F x) B.
 reterm (F # T) B :- reterm F (A --> B).
 reterm (eq ## A) (A --> A --> prop).
diff --git a/tests/sources/llamchr.elpi b/tests/sources/llamchr.elpi
index ff7faa706..60f259de1 100644
--- a/tests/sources/llamchr.elpi
+++ b/tests/sources/llamchr.elpi
@@ -1,4 +1,4 @@
-mode (term i o).
+pred term i:A, o:B.
 
 term (app X Y) B :- term X (arr A B), term Y A.
 term (lam A F) (arr A B) :- pi x\ term x A => term (F x) B.
@@ -29,7 +29,7 @@ compatible _ _ _ _ [false].
 spy P :- print "[" P, P, print "]ok", !.
 spy P :- print "]fail", fail.
 
-mode (watch i).
+pred watch i:A.
 watch (uvar as X) :- declare_constraint (print "watch" X) [X], !.
 watch X :- print "watch" X.
 
diff --git a/tests/sources/mode_checking_ho.elpi b/tests/sources/mode_checking_ho.elpi
index 52fc5fb94..3b4b148a1 100644
--- a/tests/sources/mode_checking_ho.elpi
+++ b/tests/sources/mode_checking_ho.elpi
@@ -24,10 +24,10 @@ pred q i:prop, o:prop.
 q A R :- A, R = A. % Everything goes moothly!
 q A R :- R, R = A. % Mh, R is output, ie supposed flex
 
-pred r0 i:(i:A -> i:B -> prop), i:A, i:B.
+pred r0 i:(pred i:A, i:B), i:A, i:B.
 r0 F A B :- F A B.
 
-pred r1 i:(i:A -> i:B -> i:C -> prop), i:A, i:B, o:C.
+pred r1 i:(pred i:A, i:B, i:C), i:A, i:B, o:C.
 r1 F A B C :- F A B C. % Not good: C is in output but used as input in F
 
 main.
\ No newline at end of file
diff --git a/tests/sources/restriction3.elpi b/tests/sources/restriction3.elpi
index c7cba89c2..5798a2f2a 100644
--- a/tests/sources/restriction3.elpi
+++ b/tests/sources/restriction3.elpi
@@ -1,5 +1,4 @@
-type  if prop -> prop -> prop -> prop.
-mode (if i i i).
+pred  if i:prop, i:prop, i:prop.
 if B T _ :- B, !, T.
 if _ _ E :- E.
 
diff --git a/tests/sources/trace_w.elab.json b/tests/sources/trace_w.elab.json
index 1dc1c3b8b..2d87872ba 100644
--- a/tests/sources/trace_w.elab.json
+++ b/tests/sources/trace_w.elab.json
@@ -1988,7 +1988,7 @@
                   "step": [
                     "Init",
                     {
-                      "goal_text": "generalize [] [] (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) X3",
+                      "goal_text": "generalize [] [] (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) X3",
                       "goal_id": 26
                     }
                   ],
@@ -2001,7 +2001,7 @@
                     "Inference",
                     {
                       "current_goal_id": 26,
-                      "current_goal_text": "generalize [] [] (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) X3",
+                      "current_goal_text": "generalize [] [] (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) X3",
                       "current_goal_predicate": "generalize",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2027,14 +2027,14 @@
                               [ "Assign", "A1 := []" ],
                               [
                                 "Assign",
-                                "A2 := uvar frozen--539 [] ==> uvar frozen--539 []"
+                                "A2 := uvar frozen--541 [] ==> uvar frozen--541 []"
                               ],
                               [ "Assign", "A3 := X3" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "free-ty (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) [] X4",
+                              "goal_text": "free-ty (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) [] X4",
                               "goal_id": 27
                             },
                             {
@@ -2046,7 +2046,7 @@
                               "goal_id": 29
                             },
                             {
-                              "goal_text": "bind X6 [] (uvar frozen--539 [] ==> uvar frozen--539 []) X3",
+                              "goal_text": "bind X6 [] (uvar frozen--541 [] ==> uvar frozen--541 []) X3",
                               "goal_id": 30
                             }
                           ],
@@ -2086,7 +2086,7 @@
                     "Inference",
                     {
                       "current_goal_id": 27,
-                      "current_goal_text": "free-ty (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) [] X4",
+                      "current_goal_text": "free-ty (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) [] X4",
                       "current_goal_predicate": "free-ty",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2110,7 +2110,7 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := uvar frozen--539 [] ==> uvar frozen--539 []"
+                                "A0 := uvar frozen--541 [] ==> uvar frozen--541 []"
                               ],
                               [ "Assign", "A1 := []" ],
                               [ "Assign", "A2 := X4" ]
@@ -2118,7 +2118,7 @@
                           },
                           "siblings": [
                             {
-                              "goal_text": "free (uvar frozen--539 [] ==> uvar frozen--539 []) [] X4",
+                              "goal_text": "free (uvar frozen--541 [] ==> uvar frozen--541 []) [] X4",
                               "goal_id": 31
                             }
                           ],
@@ -2177,7 +2177,7 @@
                     "Inference",
                     {
                       "current_goal_id": 31,
-                      "current_goal_text": "free (uvar frozen--539 [] ==> uvar frozen--539 []) [] X4",
+                      "current_goal_text": "free (uvar frozen--541 [] ==> uvar frozen--541 []) [] X4",
                       "current_goal_predicate": "free",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2199,19 +2199,19 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
-                              [ "Assign", "A1 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
+                              [ "Assign", "A1 := uvar frozen--541 []" ],
                               [ "Assign", "A2 := []" ],
                               [ "Assign", "A3 := X4" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "free (uvar frozen--539 []) [] X7",
+                              "goal_text": "free (uvar frozen--541 []) [] X7",
                               "goal_id": 32
                             },
                             {
-                              "goal_text": "free (uvar frozen--539 []) X7 X4",
+                              "goal_text": "free (uvar frozen--541 []) X7 X4",
                               "goal_id": 33
                             }
                           ],
@@ -2289,7 +2289,7 @@
                     "Inference",
                     {
                       "current_goal_id": 32,
-                      "current_goal_text": "free (uvar frozen--539 []) [] X7",
+                      "current_goal_text": "free (uvar frozen--541 []) [] X7",
                       "current_goal_predicate": "free",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2311,14 +2311,14 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
                               [ "Assign", "A1 := []" ],
                               [ "Assign", "A2 := X7" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])",
+                              "goal_text": "if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])",
                               "goal_id": 34
                             }
                           ],
@@ -2415,7 +2415,7 @@
                     "Inference",
                     {
                       "current_goal_id": 34,
-                      "current_goal_text": "if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])",
+                      "current_goal_text": "if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])",
                       "current_goal_predicate": "if",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2439,14 +2439,14 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := mem [] (uvar frozen--539 [])"
+                                "A0 := mem [] (uvar frozen--541 [])"
                               ],
                               [ "Assign", "A1 := X7 = []" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem [] (uvar frozen--539 [])",
+                              "goal_text": "mem [] (uvar frozen--541 [])",
                               "goal_id": 35
                             },
                             { "goal_text": "!", "goal_id": 36 },
@@ -2564,7 +2564,7 @@
                     "Inference",
                     {
                       "current_goal_id": 35,
-                      "current_goal_text": "mem [] (uvar frozen--539 [])",
+                      "current_goal_text": "mem [] (uvar frozen--541 [])",
                       "current_goal_predicate": "mem",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2587,12 +2587,12 @@
                             ],
                             "events": [
                               [ "Assign", "A0 := []" ],
-                              [ "Assign", "A1 := frozen--539" ]
+                              [ "Assign", "A1 := frozen--541" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem! [] (uvar frozen--539 X8)",
+                              "goal_text": "mem! [] (uvar frozen--541 X8)",
                               "goal_id": 38
                             }
                           ],
@@ -2727,7 +2727,7 @@
                     "Inference",
                     {
                       "current_goal_id": 38,
-                      "current_goal_text": "mem! [] (uvar frozen--539 X8)",
+                      "current_goal_text": "mem! [] (uvar frozen--541 X8)",
                       "current_goal_predicate": "mem!",
                       "failed_attempts": [],
                       "successful_attempts": [],
@@ -2859,7 +2859,7 @@
                     "Inference",
                     {
                       "current_goal_id": 34,
-                      "current_goal_text": "if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])",
+                      "current_goal_text": "if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])",
                       "current_goal_predicate": "if",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -2882,13 +2882,13 @@
                             ],
                             "events": [
                               [
-                                "Assign", "A0 := X7 = [uvar frozen--539 []]"
+                                "Assign", "A0 := X7 = [uvar frozen--541 []]"
                               ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "X7 = [uvar frozen--539 []]",
+                              "goal_text": "X7 = [uvar frozen--541 []]",
                               "goal_id": 39
                             }
                           ],
@@ -3004,7 +3004,7 @@
                     "Inference",
                     {
                       "current_goal_id": 39,
-                      "current_goal_text": "X7 = [uvar frozen--539 []]",
+                      "current_goal_text": "X7 = [uvar frozen--541 []]",
                       "current_goal_predicate": "=",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3012,7 +3012,7 @@
                           "attempt": {
                             "rule": [ "BuiltinRule", [ "Logic", "eq" ] ],
                             "events": [
-                              [ "Assign", "X7 := [uvar frozen--539 []]" ]
+                              [ "Assign", "X7 := [uvar frozen--541 []]" ]
                             ]
                           },
                           "siblings": [],
@@ -3133,7 +3133,7 @@
                     "Inference",
                     {
                       "current_goal_id": 33,
-                      "current_goal_text": "free (uvar frozen--539 []) [uvar frozen--539 []] X4",
+                      "current_goal_text": "free (uvar frozen--541 []) [uvar frozen--541 []] X4",
                       "current_goal_predicate": "free",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3155,14 +3155,14 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
-                              [ "Assign", "A1 := [uvar frozen--539 []]" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
+                              [ "Assign", "A1 := [uvar frozen--541 []]" ],
                               [ "Assign", "A2 := X4" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "if (mem [uvar frozen--539 []] (uvar frozen--539 [])) \n (X4 = [uvar frozen--539 []]) \n (X4 = [uvar frozen--539 [], uvar frozen--539 []])",
+                              "goal_text": "if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])",
                               "goal_id": 40
                             }
                           ],
@@ -3259,7 +3259,7 @@
                     "Inference",
                     {
                       "current_goal_id": 40,
-                      "current_goal_text": "if (mem [uvar frozen--539 []] (uvar frozen--539 [])) \n (X4 = [uvar frozen--539 []]) \n (X4 = [uvar frozen--539 [], uvar frozen--539 []])",
+                      "current_goal_text": "if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])",
                       "current_goal_predicate": "if",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3283,21 +3283,21 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := mem [uvar frozen--539 []] (uvar frozen--539 [])"
+                                "A0 := mem [uvar frozen--541 []] (uvar frozen--541 [])"
                               ],
                               [
-                                "Assign", "A1 := X4 = [uvar frozen--539 []]"
+                                "Assign", "A1 := X4 = [uvar frozen--541 []]"
                               ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem [uvar frozen--539 []] (uvar frozen--539 [])",
+                              "goal_text": "mem [uvar frozen--541 []] (uvar frozen--541 [])",
                               "goal_id": 41
                             },
                             { "goal_text": "!", "goal_id": 42 },
                             {
-                              "goal_text": "X4 = [uvar frozen--539 []]",
+                              "goal_text": "X4 = [uvar frozen--541 []]",
                               "goal_id": 43
                             }
                           ],
@@ -3413,7 +3413,7 @@
                     "Inference",
                     {
                       "current_goal_id": 41,
-                      "current_goal_text": "mem [uvar frozen--539 []] (uvar frozen--539 [])",
+                      "current_goal_text": "mem [uvar frozen--541 []] (uvar frozen--541 [])",
                       "current_goal_predicate": "mem",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3435,13 +3435,13 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := [uvar frozen--539 []]" ],
-                              [ "Assign", "A1 := frozen--539" ]
+                              [ "Assign", "A0 := [uvar frozen--541 []]" ],
+                              [ "Assign", "A1 := frozen--541" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem! [uvar frozen--539 []] (uvar frozen--539 X9)",
+                              "goal_text": "mem! [uvar frozen--541 []] (uvar frozen--541 X9)",
                               "goal_id": 44
                             }
                           ],
@@ -3576,7 +3576,7 @@
                     "Inference",
                     {
                       "current_goal_id": 44,
-                      "current_goal_text": "mem! [uvar frozen--539 []] (uvar frozen--539 X9)",
+                      "current_goal_text": "mem! [uvar frozen--541 []] (uvar frozen--541 X9)",
                       "current_goal_predicate": "mem!",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3598,7 +3598,7 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
                               [ "Assign", "X9 := []" ]
                             ]
                           },
@@ -3756,7 +3756,7 @@
                       "cut_victims": [
                         {
                           "cut_branch_for_goal": {
-                            "goal_text": "mem! [uvar frozen--539 []] (uvar frozen--539 X9)",
+                            "goal_text": "mem! [uvar frozen--541 []] (uvar frozen--541 X9)",
                             "goal_id": 44
                           },
                           "cut_branch": {
@@ -3787,7 +3787,7 @@
                       "cut_victims": [
                         {
                           "cut_branch_for_goal": {
-                            "goal_text": "if (mem [uvar frozen--539 []] (uvar frozen--539 [])) \n (X4 = [uvar frozen--539 []]) \n (X4 = [uvar frozen--539 [], uvar frozen--539 []])",
+                            "goal_text": "if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])",
                             "goal_id": 40
                           },
                           "cut_branch": {
@@ -3815,7 +3815,7 @@
                     "Inference",
                     {
                       "current_goal_id": 43,
-                      "current_goal_text": "X4 = [uvar frozen--539 []]",
+                      "current_goal_text": "X4 = [uvar frozen--541 []]",
                       "current_goal_predicate": "=",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -3823,7 +3823,7 @@
                           "attempt": {
                             "rule": [ "BuiltinRule", [ "Logic", "eq" ] ],
                             "events": [
-                              [ "Assign", "X4 := [uvar frozen--539 []]" ]
+                              [ "Assign", "X4 := [uvar frozen--541 []]" ]
                             ]
                           },
                           "siblings": [],
@@ -4026,7 +4026,7 @@
                     "Inference",
                     {
                       "current_goal_id": 29,
-                      "current_goal_text": "filter [uvar frozen--539 []] (c0 \\ not (mem [] c0)) X6",
+                      "current_goal_text": "filter [uvar frozen--541 []] (c0 \\ not (mem [] c0)) X6",
                       "current_goal_predicate": "filter",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4048,17 +4048,17 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
                               [ "Assign", "A1 := []" ],
                               [ "Assign", "A2 := c0 \\\nnot (mem [] c0)" ],
                               [
-                                "Assign", "X6 := [uvar frozen--539 [] | X10]"
+                                "Assign", "X6 := [uvar frozen--541 [] | X10]"
                               ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "not (mem [] (uvar frozen--539 []))",
+                              "goal_text": "not (mem [] (uvar frozen--541 []))",
                               "goal_id": 46
                             },
                             { "goal_text": "!", "goal_id": 47 },
@@ -4122,7 +4122,7 @@
                     "Inference",
                     {
                       "current_goal_id": 46,
-                      "current_goal_text": "not (mem [] (uvar frozen--539 []))",
+                      "current_goal_text": "not (mem [] (uvar frozen--541 []))",
                       "current_goal_predicate": "not",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4146,13 +4146,13 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := mem [] (uvar frozen--539 [])"
+                                "A0 := mem [] (uvar frozen--541 [])"
                               ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem [] (uvar frozen--539 [])",
+                              "goal_text": "mem [] (uvar frozen--541 [])",
                               "goal_id": 49
                             },
                             { "goal_text": "!", "goal_id": 50 },
@@ -4232,7 +4232,7 @@
                     "Inference",
                     {
                       "current_goal_id": 49,
-                      "current_goal_text": "mem [] (uvar frozen--539 [])",
+                      "current_goal_text": "mem [] (uvar frozen--541 [])",
                       "current_goal_predicate": "mem",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4255,12 +4255,12 @@
                             ],
                             "events": [
                               [ "Assign", "A0 := []" ],
-                              [ "Assign", "A1 := frozen--539" ]
+                              [ "Assign", "A1 := frozen--541" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem! [] (uvar frozen--539 X11)",
+                              "goal_text": "mem! [] (uvar frozen--541 X11)",
                               "goal_id": 52
                             }
                           ],
@@ -4357,7 +4357,7 @@
                     "Inference",
                     {
                       "current_goal_id": 52,
-                      "current_goal_text": "mem! [] (uvar frozen--539 X11)",
+                      "current_goal_text": "mem! [] (uvar frozen--541 X11)",
                       "current_goal_predicate": "mem!",
                       "failed_attempts": [],
                       "successful_attempts": [],
@@ -4451,7 +4451,7 @@
                     "Inference",
                     {
                       "current_goal_id": 46,
-                      "current_goal_text": "not (mem [] (uvar frozen--539 []))",
+                      "current_goal_text": "not (mem [] (uvar frozen--541 []))",
                       "current_goal_predicate": "not",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4678,7 +4678,7 @@
                     "Inference",
                     {
                       "current_goal_id": 30,
-                      "current_goal_text": "bind [uvar frozen--539 []] [] (uvar frozen--539 [] ==> uvar frozen--539 []) \n X3",
+                      "current_goal_text": "bind [uvar frozen--541 []] [] (uvar frozen--541 [] ==> uvar frozen--541 []) \n X3",
                       "current_goal_predicate": "bind",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4700,23 +4700,23 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
                               [ "Assign", "A1 := []" ],
                               [ "Assign", "A2 := []" ],
                               [
                                 "Assign",
-                                "A3 := uvar frozen--539 [] ==> uvar frozen--539 []"
+                                "A3 := uvar frozen--541 [] ==> uvar frozen--541 []"
                               ],
                               [ "Assign", "X3 := all X12 c0 \\ X13 c0" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)",
+                              "goal_text": "if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)",
                               "goal_id": 53
                             },
                             {
-                              "goal_text": "pi c0 \\\n copy (uvar frozen--539 []) c0 =>\n  bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                              "goal_text": "pi c0 \\\n copy (uvar frozen--541 []) c0 =>\n  bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                               "goal_id": 54
                             }
                           ],
@@ -4775,7 +4775,7 @@
                     "Inference",
                     {
                       "current_goal_id": 53,
-                      "current_goal_text": "if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)",
+                      "current_goal_text": "if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)",
                       "current_goal_predicate": "if",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4799,14 +4799,14 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := mem [] (uvar frozen--539 [])"
+                                "A0 := mem [] (uvar frozen--541 [])"
                               ],
                               [ "Assign", "A1 := X12 = eqt" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem [] (uvar frozen--539 [])",
+                              "goal_text": "mem [] (uvar frozen--541 [])",
                               "goal_id": 55
                             },
                             { "goal_text": "!", "goal_id": 56 },
@@ -4886,7 +4886,7 @@
                     "Inference",
                     {
                       "current_goal_id": 55,
-                      "current_goal_text": "mem [] (uvar frozen--539 [])",
+                      "current_goal_text": "mem [] (uvar frozen--541 [])",
                       "current_goal_predicate": "mem",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -4909,12 +4909,12 @@
                             ],
                             "events": [
                               [ "Assign", "A0 := []" ],
-                              [ "Assign", "A1 := frozen--539" ]
+                              [ "Assign", "A1 := frozen--541" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "mem! [] (uvar frozen--539 X14)",
+                              "goal_text": "mem! [] (uvar frozen--541 X14)",
                               "goal_id": 58
                             }
                           ],
@@ -5011,7 +5011,7 @@
                     "Inference",
                     {
                       "current_goal_id": 58,
-                      "current_goal_text": "mem! [] (uvar frozen--539 X14)",
+                      "current_goal_text": "mem! [] (uvar frozen--541 X14)",
                       "current_goal_predicate": "mem!",
                       "failed_attempts": [],
                       "successful_attempts": [],
@@ -5105,7 +5105,7 @@
                     "Inference",
                     {
                       "current_goal_id": 53,
-                      "current_goal_text": "if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)",
+                      "current_goal_text": "if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)",
                       "current_goal_predicate": "if",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5294,7 +5294,7 @@
                     "Inference",
                     {
                       "current_goal_id": 54,
-                      "current_goal_text": "pi c0 \\\n copy (uvar frozen--539 []) c0 =>\n  bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                      "current_goal_text": "pi c0 \\\n copy (uvar frozen--541 []) c0 =>\n  bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                       "current_goal_predicate": "pi",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5305,7 +5305,7 @@
                           },
                           "siblings": [
                             {
-                              "goal_text": "copy (uvar frozen--539 []) c0 =>\n bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                              "goal_text": "copy (uvar frozen--541 []) c0 =>\n bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                               "goal_id": 60
                             }
                           ],
@@ -5369,7 +5369,7 @@
                     "Inference",
                     {
                       "current_goal_id": 60,
-                      "current_goal_text": "copy (uvar frozen--539 []) c0 =>\n bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                      "current_goal_text": "copy (uvar frozen--541 []) c0 =>\n bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                       "current_goal_predicate": "=>",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5382,7 +5382,7 @@
                           },
                           "siblings": [
                             {
-                              "goal_text": "bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                              "goal_text": "bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                               "goal_id": 61
                             }
                           ],
@@ -5453,7 +5453,7 @@
                     "Inference",
                     {
                       "current_goal_id": 61,
-                      "current_goal_text": "bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)",
+                      "current_goal_text": "bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)",
                       "current_goal_predicate": "bind",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5477,7 +5477,7 @@
                             "events": [
                               [
                                 "Assign",
-                                "A0 := uvar frozen--539 [] ==> uvar frozen--539 []"
+                                "A0 := uvar frozen--541 [] ==> uvar frozen--541 []"
                               ],
                               [ "Assign", "X13 := c0 \\\nX15 c0" ],
                               [ "Assign", "X15^1 := mono X16^1" ]
@@ -5485,7 +5485,7 @@
                           },
                           "siblings": [
                             {
-                              "goal_text": "copy (uvar frozen--539 [] ==> uvar frozen--539 []) X16^1",
+                              "goal_text": "copy (uvar frozen--541 [] ==> uvar frozen--541 []) X16^1",
                               "goal_id": 62
                             }
                           ],
@@ -5575,7 +5575,7 @@
                     "Inference",
                     {
                       "current_goal_id": 62,
-                      "current_goal_text": "copy (uvar frozen--539 [] ==> uvar frozen--539 []) X16^1",
+                      "current_goal_text": "copy (uvar frozen--541 [] ==> uvar frozen--541 []) X16^1",
                       "current_goal_predicate": "copy",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5597,18 +5597,18 @@
                               }
                             ],
                             "events": [
-                              [ "Assign", "A0 := uvar frozen--539 []" ],
-                              [ "Assign", "A1 := uvar frozen--539 []" ],
+                              [ "Assign", "A0 := uvar frozen--541 []" ],
+                              [ "Assign", "A1 := uvar frozen--541 []" ],
                               [ "Assign", "X16^1 := X17^1 ==> X18^1" ]
                             ]
                           },
                           "siblings": [
                             {
-                              "goal_text": "copy (uvar frozen--539 []) X17^1",
+                              "goal_text": "copy (uvar frozen--541 []) X17^1",
                               "goal_id": 63
                             },
                             {
-                              "goal_text": "copy (uvar frozen--539 []) X18^1",
+                              "goal_text": "copy (uvar frozen--541 []) X18^1",
                               "goal_id": 64
                             }
                           ],
@@ -5717,7 +5717,7 @@
                     "Inference",
                     {
                       "current_goal_id": 63,
-                      "current_goal_text": "copy (uvar frozen--539 []) X17^1",
+                      "current_goal_text": "copy (uvar frozen--541 []) X17^1",
                       "current_goal_predicate": "copy",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5726,7 +5726,7 @@
                             "rule": [
                               "UserRule",
                               {
-                                "rule_text": "(copy (uvar frozen--539 []) c0) :- .",
+                                "rule_text": "(copy (uvar frozen--541 []) c0) :- .",
                                 "rule_loc": [ "Context", 32 ]
                               }
                             ],
@@ -5742,7 +5742,7 @@
                           "rule": [
                             "UserRule",
                             {
-                              "rule_text": "(copy (uvar frozen--539 []) c0) :- .",
+                              "rule_text": "(copy (uvar frozen--541 []) c0) :- .",
                               "rule_loc": [ "Context", 32 ]
                             }
                           ],
@@ -5849,7 +5849,7 @@
                     "Inference",
                     {
                       "current_goal_id": 64,
-                      "current_goal_text": "copy (uvar frozen--539 []) X18^1",
+                      "current_goal_text": "copy (uvar frozen--541 []) X18^1",
                       "current_goal_predicate": "copy",
                       "failed_attempts": [],
                       "successful_attempts": [
@@ -5858,7 +5858,7 @@
                             "rule": [
                               "UserRule",
                               {
-                                "rule_text": "(copy (uvar frozen--539 []) c0) :- .",
+                                "rule_text": "(copy (uvar frozen--541 []) c0) :- .",
                                 "rule_loc": [ "Context", 32 ]
                               }
                             ],
@@ -5874,7 +5874,7 @@
                           "rule": [
                             "UserRule",
                             {
-                              "rule_text": "(copy (uvar frozen--539 []) c0) :- .",
+                              "rule_text": "(copy (uvar frozen--541 []) c0) :- .",
                               "rule_loc": [ "Context", 32 ]
                             }
                           ],
diff --git a/tests/sources/trace_w.json b/tests/sources/trace_w.json
index 122fa8280..611a454c1 100644
--- a/tests/sources/trace_w.json
+++ b/tests/sources/trace_w.json
@@ -133,28 +133,28 @@
 {"step" : 16,"kind" : ["Info"],"goal_id" : 24,"runtime_id" : 0,"name" : "user:rule:builtin","payload" : ["success"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 25,"runtime_id" : 0,"name" : "user:CHR:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 85, column 36, characters 1999-2171:","(theta A0) \\ (A1 ?- gammabar A2 A3) | (generalize A0 A1 A2 A4) <=> (A3 = A4)"]}
 {"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X0 := []"]}
-{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X1 := mono (uvar frozen--539 [] ==> uvar frozen--539 [])"]}
-{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := uvar frozen--540 []"]}
+{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X1 := mono (uvar frozen--541 [] ==> uvar frozen--541 [])"]}
+{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := uvar frozen--542 []"]}
 {"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X2 := []"]}
-{"step" : 0,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["generalize [] [] (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) X3"]}
-{"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["generalize","generalize [] [] (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) X3"]}
+{"step" : 0,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["generalize [] [] (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) X3"]}
+{"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["generalize","generalize [] [] (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) X3"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 97, column 0, characters 2318-2493:"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 97, column 0, characters 2318-2493:","(generalize A0 A1 (mono A2) A3) :- (free-ty (mono A2) [] A4), \n (free-gamma A1 [] A5), (filter A4 (c0 \\ (not (mem A5 c0))) A6), \n (bind A6 A0 A2 A3)."]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := []"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
-{"step" : 1,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := uvar frozen--539 [] ==> uvar frozen--539 []"]}
+{"step" : 1,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := uvar frozen--541 [] ==> uvar frozen--541 []"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := X3"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 26,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["27"]}
-{"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free-ty (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) [] X4"]}
+{"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free-ty (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) [] X4"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["28"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 28,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free-gamma [] [] X5"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["29"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["filter X4 (c0 \\ not (mem X5 c0)) X6"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["30"]}
-{"step" : 1,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["bind X6 [] (uvar frozen--539 [] ==> uvar frozen--539 []) X3"]}
+{"step" : 1,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["bind X6 [] (uvar frozen--541 [] ==> uvar frozen--541 []) X3"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free-ty","free-ty (mono (uvar frozen--539 [] ==> uvar frozen--539 [])) [] X4"]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free-ty","free-ty (mono (uvar frozen--541 [] ==> uvar frozen--541 [])) [] X4"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 105, column 0, characters 2609-2645:"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 105, column 0, characters 2609-2645:","(free-ty (mono A0) A1 A2) :- (free A0 A1 A2)."]}
@@ -162,9 +162,9 @@
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X4"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["31"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--539 [] ==> uvar frozen--539 []) [] X4"]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--541 [] ==> uvar frozen--541 []) [] X4"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--539 [] ==> uvar frozen--539 []) [] X4"]}
+{"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--541 [] ==> uvar frozen--541 []) [] X4"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 117, column 0, characters 2995-3043:"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 117, column 0, characters 2995-3043:","(free (A0 ==> A1) A2 A3) :- (free A0 A2 A4), (free A1 A4 A3)."]}
@@ -173,11 +173,11 @@
 {"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := []"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := X4"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["32"]}
-{"step" : 3,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--539 []) [] X7"]}
+{"step" : 3,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--541 []) [] X7"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["33"]}
-{"step" : 3,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--539 []) X7 X4"]}
+{"step" : 3,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["free (uvar frozen--541 []) X7 X4"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--539 []) [] X7"]}
+{"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--541 []) [] X7"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:","(free (as (uvar _ _) A0) A1 A2) :- (if (mem A1 A0) (A2 = A1) (A2 = [A0 | A1]))."]}
@@ -185,48 +185,48 @@
 {"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X7"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["34"]}
-{"step" : 4,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])"]}
+{"step" : 4,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])"]}
+{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X7 = []"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["35"]}
-{"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--539 [])"]}
+{"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["36"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 36,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["37"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 37,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X7 = []"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--539 [])"]}
+{"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--541 [])"]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:"]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:","(mem A0 (uvar A1 _)) :- (mem! A0 (uvar A1 A2))."]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := []"]}
-{"step" : 6,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--539"]}
+{"step" : 6,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--541"]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["38"]}
-{"step" : 6,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--539 X8)"]}
+{"step" : 6,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--541 X8)"]}
 {"step" : 6,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--539 X8)"]}
+{"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--541 X8)"]}
 {"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : []}
 {"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
-{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--539 [])) (X7 = []) (X7 = [uvar frozen--539 []])"]}
+{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := X7 = [uvar frozen--539 []]"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["39"]}
-{"step" : 8,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X7 = [uvar frozen--539 []]"]}
+{"step" : 8,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X7 = [uvar frozen--541 []]"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 9,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=","X7 = [uvar frozen--539 []]"]}
+{"step" : 9,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=","X7 = [uvar frozen--541 []]"]}
 {"step" : 9,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:rule","payload" : ["eq"]}
 {"step" : 9,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:rule:builtin:name","payload" : ["="]}
-{"step" : 9,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X7 := [uvar frozen--539 []]"]}
+{"step" : 9,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X7 := [uvar frozen--541 []]"]}
 {"step" : 9,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:rule:eq","payload" : ["success"]}
-{"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--539 []) [uvar frozen--539 []] X4"]}
+{"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free","free (uvar frozen--541 []) [uvar frozen--541 []] X4"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:","(free (as (uvar _ _) A0) A1 A2) :- (if (mem A1 A0) (A2 = A1) (A2 = [A0 | A1]))."]}
@@ -234,31 +234,31 @@
 {"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := [uvar frozen--539 []]"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X4"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["40"]}
-{"step" : 10,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [uvar frozen--539 []] (uvar frozen--539 [])) \n (X4 = [uvar frozen--539 []]) \n (X4 = [uvar frozen--539 [], uvar frozen--539 []])"]}
+{"step" : 10,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [uvar frozen--539 []] (uvar frozen--539 [])) \n (X4 = [uvar frozen--539 []]) \n (X4 = [uvar frozen--539 [], uvar frozen--539 []])"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [uvar frozen--539 []] (uvar frozen--539 [])"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X4 = [uvar frozen--539 []]"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["41"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [uvar frozen--539 []] (uvar frozen--539 [])"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [uvar frozen--541 []] (uvar frozen--541 [])"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["42"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["43"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X4 = [uvar frozen--539 []]"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X4 = [uvar frozen--541 []]"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [uvar frozen--539 []] (uvar frozen--539 [])"]}
+{"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [uvar frozen--541 []] (uvar frozen--541 [])"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:","(mem A0 (uvar A1 _)) :- (mem! A0 (uvar A1 A2))."]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := [uvar frozen--539 []]"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--539"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["44"]}
-{"step" : 12,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [uvar frozen--539 []] (uvar frozen--539 X9)"]}
+{"step" : 12,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [uvar frozen--541 []] (uvar frozen--541 X9)"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [uvar frozen--539 []] (uvar frozen--539 X9)"]}
+{"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [uvar frozen--541 []] (uvar frozen--541 X9)"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 143, column 0, characters 3872-3889:","File \"tests/sources/trace-w/main.elpi\", line 144, column 0, characters 3891-3916:"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 143, column 0, characters 3872-3889:","(mem! [A0 | _] A0) :- (!)."]}
@@ -275,10 +275,10 @@
 {"step" : 15,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:rule","payload" : ["cut"]}
 {"step" : 15,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:rule:cut:branch","payload" : ["40","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
 {"step" : 15,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:rule:cut","payload" : ["success"]}
-{"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=","X4 = [uvar frozen--539 []]"]}
+{"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=","X4 = [uvar frozen--541 []]"]}
 {"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:rule","payload" : ["eq"]}
 {"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:rule:builtin:name","payload" : ["="]}
-{"step" : 16,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X4 := [uvar frozen--539 []]"]}
+{"step" : 16,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X4 := [uvar frozen--541 []]"]}
 {"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:rule:eq","payload" : ["success"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 28,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["free-gamma","free-gamma [] [] X5"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 28,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
@@ -287,47 +287,47 @@
 {"step" : 17,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := []"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X5 := []"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 28,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["filter","filter [uvar frozen--539 []] (c0 \\ not (mem [] c0)) X6"]}
+{"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["filter","filter [uvar frozen--541 []] (c0 \\ not (mem [] c0)) X6"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 139, column 0, characters 3758-3806:","File \"tests/sources/trace-w/main.elpi\", line 140, column 0, characters 3808-3844:"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 139, column 0, characters 3758-3806:","(filter [A0 | A1] A2 [A0 | A3]) :- (A2 A0), (!), (filter A1 A2 A3)."]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := c0 \\\nnot (mem [] c0)"]}
-{"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X6 := [uvar frozen--539 [] | X10]"]}
+{"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X6 := [uvar frozen--541 [] | X10]"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["46"]}
-{"step" : 18,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["not (mem [] (uvar frozen--539 []))"]}
+{"step" : 18,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["not (mem [] (uvar frozen--541 []))"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["47"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 47,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["48"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 48,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["filter [] (c0 \\ not (mem [] c0)) X10"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["not","not (mem [] (uvar frozen--539 []))"]}
+{"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["not","not (mem [] (uvar frozen--541 []))"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 54, column 0, characters 667-686:","File \"builtin.elpi\", line 56, column 0, characters 689-694:"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 54, column 0, characters 667-686:","(not A0) :- A0, (!), fail."]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["49"]}
-{"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--539 [])"]}
+{"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["50"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 50,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["51"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 51,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["fail"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--539 [])"]}
+{"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--541 [])"]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:"]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:","(mem A0 (uvar A1 _)) :- (mem! A0 (uvar A1 A2))."]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := []"]}
-{"step" : 20,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--539"]}
+{"step" : 20,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--541"]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["52"]}
-{"step" : 20,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--539 X11)"]}
+{"step" : 20,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--541 X11)"]}
 {"step" : 20,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 21,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--539 X11)"]}
+{"step" : 21,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--541 X11)"]}
 {"step" : 21,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 21,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : []}
 {"step" : 21,"kind" : ["Info"],"goal_id" : 52,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
-{"step" : 22,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["not","not (mem [] (uvar frozen--539 []))"]}
+{"step" : 22,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["not","not (mem [] (uvar frozen--541 []))"]}
 {"step" : 22,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 22,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 56, column 0, characters 689-694:"]}
 {"step" : 22,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 56, column 0, characters 689-694:","(not _) :- ."]}
@@ -342,47 +342,47 @@
 {"step" : 24,"kind" : ["Info"],"goal_id" : 48,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 138, column 0, characters 3742-3756:","(filter [] _ []) :- ."]}
 {"step" : 24,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X10 := []"]}
 {"step" : 24,"kind" : ["Info"],"goal_id" : 48,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["bind","bind [uvar frozen--539 []] [] (uvar frozen--539 [] ==> uvar frozen--539 []) \n X3"]}
+{"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["bind","bind [uvar frozen--541 []] [] (uvar frozen--541 [] ==> uvar frozen--541 []) \n X3"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 123, column 0, characters 3268-3389:"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 123, column 0, characters 3268-3389:","(bind [A0 | A1] A2 A3 (all A4 (c0 \\ (A5 c0)))) :- (if (mem A2 A0) (A4 = eqt) \n                                                    (A4 = any)), \n (pi (c0 \\ (copy A0 c0 => bind A1 A2 A3 (A5 c0))))."]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := []"]}
-{"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := uvar frozen--539 [] ==> uvar frozen--539 []"]}
+{"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := uvar frozen--541 [] ==> uvar frozen--541 []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X3 := all X12 c0 \\ X13 c0"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["53"]}
-{"step" : 25,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)"]}
+{"step" : 25,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["54"]}
-{"step" : 25,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["pi c0 \\\n copy (uvar frozen--539 []) c0 =>\n  bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 25,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["pi c0 \\\n copy (uvar frozen--541 []) c0 =>\n  bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)"]}
+{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X12 = eqt"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["55"]}
-{"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--539 [])"]}
+{"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["56"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 56,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["57"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 57,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X12 = eqt"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--539 [])"]}
+{"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem","mem [] (uvar frozen--541 [])"]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:"]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:","(mem A0 (uvar A1 _)) :- (mem! A0 (uvar A1 A2))."]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := []"]}
-{"step" : 27,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--539"]}
+{"step" : 27,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--541"]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["58"]}
-{"step" : 27,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--539 X14)"]}
+{"step" : 27,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [] (uvar frozen--541 X14)"]}
 {"step" : 27,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--539 X14)"]}
+{"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["mem!","mem! [] (uvar frozen--541 X14)"]}
 {"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : []}
 {"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
-{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--539 [])) (X12 = eqt) (X12 = any)"]}
+{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
@@ -395,17 +395,17 @@
 {"step" : 30,"kind" : ["Info"],"goal_id" : 59,"runtime_id" : 1,"name" : "user:rule:builtin:name","payload" : ["="]}
 {"step" : 30,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X12 := any"]}
 {"step" : 30,"kind" : ["Info"],"goal_id" : 59,"runtime_id" : 1,"name" : "user:rule:eq","payload" : ["success"]}
-{"step" : 31,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["pi","pi c0 \\\n copy (uvar frozen--539 []) c0 =>\n  bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 31,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["pi","pi c0 \\\n copy (uvar frozen--541 []) c0 =>\n  bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 31,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:rule","payload" : ["pi"]}
 {"step" : 31,"kind" : ["Info"],"goal_id" : 54,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["60"]}
-{"step" : 31,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--539 []) c0 =>\n bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 31,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--541 []) c0 =>\n bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 31,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:rule:pi","payload" : ["success"]}
-{"step" : 32,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=>","copy (uvar frozen--539 []) c0 =>\n bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 32,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=>","copy (uvar frozen--541 []) c0 =>\n bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 32,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:rule","payload" : ["implication"]}
 {"step" : 32,"kind" : ["Info"],"goal_id" : 60,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["61"]}
-{"step" : 32,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 32,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 32,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule:implication","payload" : ["success"]}
-{"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["bind","bind [] [] (uvar frozen--539 [] ==> uvar frozen--539 []) (X13 c0)"]}
+{"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["bind","bind [] [] (uvar frozen--541 [] ==> uvar frozen--541 []) (X13 c0)"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 122, column 0, characters 3232-3266:"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 122, column 0, characters 3232-3266:","(bind [] _ A0 (mono A1)) :- (copy A0 A1)."]}
@@ -413,9 +413,9 @@
 {"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign:simplify:heap","payload" : ["X13 := c0 \\\nX15 c0"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X15^1 := mono X16^1"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["62"]}
-{"step" : 33,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--539 [] ==> uvar frozen--539 []) X16^1"]}
+{"step" : 33,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--541 [] ==> uvar frozen--541 []) X16^1"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--539 [] ==> uvar frozen--539 []) X16^1"]}
+{"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--541 [] ==> uvar frozen--541 []) X16^1"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 130, column 0, characters 3446-3496:"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 130, column 0, characters 3446-3496:","(copy (A0 ==> A1) (A2 ==> A3)) :- (copy A0 A2), (copy A1 A3)."]}
@@ -423,17 +423,17 @@
 {"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := uvar frozen--539 []"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X16^1 := X17^1 ==> X18^1"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["63"]}
-{"step" : 34,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--539 []) X17^1"]}
+{"step" : 34,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--541 []) X17^1"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["64"]}
-{"step" : 34,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--539 []) X18^1"]}
+{"step" : 34,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--541 []) X18^1"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--539 []) X17^1"]}
+{"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--541 []) X17^1"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","File \"tests/sources/trace-w/main.elpi\", line 133, column 0, characters 3590-3616:"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--539 []) c0) :- ."]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X17^1 := c0"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
-{"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--539 []) X18^1"]}
+{"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--541 []) X18^1"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","File \"tests/sources/trace-w/main.elpi\", line 133, column 0, characters 3590-3616:"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--539 []) c0) :- ."]}
diff --git a/tests/test.real.ml b/tests/test.real.ml
index 83d9bd64a..e63e8f065 100644
--- a/tests/test.real.ml
+++ b/tests/test.real.ml
@@ -14,7 +14,7 @@ module Printer : sig
     executables:string list -> seed:int -> timeout:float -> unit
     
   val print_summary :
-    total:int -> ok:int -> ko:int -> skipped:int -> unit
+    total:int -> ok:int -> ko:int -> skipped:int -> timeout:int -> unit
 
   val print_log :
     fname:string -> unit
@@ -46,12 +46,13 @@ let print_header ~executables ~seed ~timeout =
   printf [blue] "------------------------------------------------------------------\n";
 ;;
 
-let print_summary ~total ~ok ~ko ~skipped =
+let print_summary ~total ~ok ~ko ~skipped ~timeout =
   printf [blue] "------------------------------------------------------------------\n";
   printf [blue] "Tests: "; printf [] "%d\n" total;
   printf [blue] "Passed: "; printf [] "%d\n" ok;
   printf [blue] "Failed: "; printf [] "%d\n" ko;
   printf [blue] "Skipped: "; printf [] "%d\n" skipped;
+  printf [blue] "Timeout:"; printf [] "%d\n" timeout
 ;;
 
 let print_file fname =
@@ -150,15 +151,16 @@ let main sources plot timeout promote executables namef catskip timetool seed =
           |> List.concat in
   let results =
     List.map (run timeout seed sources promote env) jobs in
-  let total, ok, ko, skipped =
-    let skip, rest =
-      List.partition (function None -> true | _ -> false) results in
-    let ok, ko =
-      List.partition (function
-        | Some { Runner.rc = Runner.Success _; _ } -> true
-        | _ -> false) rest in
-    List.(length jobs, length ok, length ko, length skip) in
-  Printer.print_summary ~total ~ok ~ko ~skipped;
+  let total, ok, ko, skipped, timeout =
+    let rec part total ok ko skipped timeout = function
+      | [] -> (total, ok, ko, skipped, timeout)
+      | Some {Runner.rc = Success _; _} :: l -> part (total+1) (ok+1) ko skipped timeout l
+      | Some {rc = Promote _; _} :: l ->        part (total+1) (ok+1) ko skipped timeout l
+      | Some {rc = Failure _; _} :: l ->        part (total+1) ok (ko+1) skipped timeout l
+      | None :: l ->                            part (total+1) ok ko (skipped+1) timeout l
+      | Some {rc = Timeout _; _} :: l ->        part (total+1) ok ko skipped (timeout+1) l
+    in part 0 0 0 0 0 results in
+  Printer.print_summary ~total ~ok ~ko ~skipped ~timeout;
   begin try
     let log_first_failure =
       results |> find_map (function

From 11c84315ed61bf9193739573399e0ff1765772cc Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 3 Oct 2024 10:12:41 +0200
Subject: [PATCH 20/32] [lexer] mode keyword raises an error in the lexer

---
 src/data.ml                   |  1 -
 src/parser/error_messages.txt |  9 ---------
 src/parser/grammar.mly        |  8 --------
 src/parser/lexer.mll.in       |  2 +-
 src/parser/test_lexer.ml      |  1 -
 src/parser/tokens.mly         |  1 -
 tests/suite/elpi_specific.ml  |  2 +-
 tests/test.real.ml            | 13 ++++++++-----
 8 files changed, 10 insertions(+), 27 deletions(-)

diff --git a/src/data.ml b/src/data.ml
index 64c3a0384..0a922d597 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -135,7 +135,6 @@ type clause = {
 }
 [@@deriving show, ord]
 
-let bool2IO = function true -> Input | false -> Output
 let get_arg_mode = function Fo a -> a | Ho (a,_) -> a 
 let to_mode = function true -> Fo Input | false -> Fo Output
 
diff --git a/src/parser/error_messages.txt b/src/parser/error_messages.txt
index 4a030e0ab..09ff0570c 100644
--- a/src/parser/error_messages.txt
+++ b/src/parser/error_messages.txt
@@ -254,15 +254,6 @@ prefix_SYMB: VDASH
 
 Prefix symbol expected.
 
-program: MODE VDASH
-program: MODE LPAREN VDASH
-program: MODE LPAREN AFTER VDASH
-program: MODE LPAREN AFTER IO VDASH
-program: MODE LPAREN AFTER IO RPAREN VDASH
-
-Malformed mode declaration. Example:
-mode (foo i i o).
-
 program: MACRO VDASH
 program: MACRO FLOAT USE_SIG
 program: MACRO AFTER VDASH VDASH
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index a43f5531c..aceb4c34f 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -135,7 +135,6 @@ decl:
 | p = pred; FULLSTOP { Program.Pred p }
 | t = type_; FULLSTOP { Program.Type t }
 | t = kind; FULLSTOP { Program.Type t }
-| m = mode; FULLSTOP { Util.error ~loc:(loc $sloc) "mode is no more accepted as a valid token" }
 | m = macro; FULLSTOP { Program.Macro m }
 | CONSTRAINT; hyps = list(constant); QDASH; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, hyps, cl) }
 | CONSTRAINT; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, [], cl) }
@@ -186,13 +185,6 @@ anonymous_pred:
 | attributes = attributes; PRED;
   args = separated_list(option(CONJ),pred_item) { TPred (attributes, args @ [mode_of_IO 'o', TConst (Func.from_string "prop")]) }
 
-// Still parsing the mode string, but then an error is raised
-mode:
-| MODE; LPAREN; c = constant; l = nonempty_list(i_o); RPAREN { Util.error ~loc:(loc $sloc) "mode is no more accepted as a valid token" }
-i_o:
-| io = IO { mode_of_IO io }
-
-
 kind:
 | KIND; names = separated_nonempty_list(CONJ,constant); k = kind_term {
     names |> List.map (fun n->
diff --git a/src/parser/lexer.mll.in b/src/parser/lexer.mll.in
index 5aadb5b5c..f1898a343 100644
--- a/src/parser/lexer.mll.in
+++ b/src/parser/lexer.mll.in
@@ -145,7 +145,7 @@ and token = parse
 | "accumulate" { ACCUMULATE }
 | "local" { LOCAL }
 | "pred" { PRED }
-| "mode" { MODE }
+| "mode" { failwith "Mode is a no more maintained keyword" }
 | "macro" { MACRO }
 | "rule" { RULE }
 | "namespace" { NAMESPACE }
diff --git a/src/parser/test_lexer.ml b/src/parser/test_lexer.ml
index 742473e51..aad498a09 100644
--- a/src/parser/test_lexer.ml
+++ b/src/parser/test_lexer.ml
@@ -28,7 +28,6 @@ type t = Tokens.token =
   | NAMESPACE
   | NAME
   | MODULE
-  | MODE
   | MOD
   | MINUSs
   | MINUSr
diff --git a/src/parser/tokens.mly b/src/parser/tokens.mly
index 1ba23ff4b..77f98fc8f 100644
--- a/src/parser/tokens.mly
+++ b/src/parser/tokens.mly
@@ -33,7 +33,6 @@
 %token MINUSr
 %token MINUSi
 %token MINUSs
-%token MODE
 %token MACRO
 %token RULE
 %token NAMESPACE
diff --git a/tests/suite/elpi_specific.ml b/tests/suite/elpi_specific.ml
index 6c8ba6ac2..927d1925b 100644
--- a/tests/suite/elpi_specific.ml
+++ b/tests/suite/elpi_specific.ml
@@ -160,7 +160,7 @@ let () = declare "elpi_only_llam"
 let () = declare "hollight"
   ~source_elpi:"hollight.elpi"
   ~description:"hollight implementation"
-  ~expectation:Test.(FailureOutput (Str.regexp "line 231")) (* needs advanced modes *)
+  ~expectation:Test.(FailureOutput (Str.regexp "Mode is a no more maintained keyword")) (* needs advanced modes *)
   ()
 let () = declare "hollight_legacy"
   ~source_elpi:"hollight_legacy.elpi"
diff --git a/tests/test.real.ml b/tests/test.real.ml
index e63e8f065..ce3854b01 100644
--- a/tests/test.real.ml
+++ b/tests/test.real.ml
@@ -48,11 +48,14 @@ let print_header ~executables ~seed ~timeout =
 
 let print_summary ~total ~ok ~ko ~skipped ~timeout =
   printf [blue] "------------------------------------------------------------------\n";
-  printf [blue] "Tests: "; printf [] "%d\n" total;
-  printf [blue] "Passed: "; printf [] "%d\n" ok;
-  printf [blue] "Failed: "; printf [] "%d\n" ko;
-  printf [blue] "Skipped: "; printf [] "%d\n" skipped;
-  printf [blue] "Timeout:"; printf [] "%d\n" timeout
+  let print_stat ?(to_print=false) k v =
+    if to_print || v <> 0 then (printf [blue] "%s: " k; printf [] "%d\n" v)
+  in
+  print_stat ~to_print:true "Tests" total;
+  print_stat ~to_print:true "Passed" ok;
+  print_stat ~to_print:true "Failed" ko;
+  print_stat "Skipped" skipped;
+  print_stat "Timeout" timeout
 ;;
 
 let print_file fname =

From d569f08157bee82493876da4d19c0b05a4216c83 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Thu, 3 Oct 2024 10:34:57 +0200
Subject: [PATCH 21/32] [compiler] cleanup

---
 src/builtin.elpi | 42 +++++++++++++++++++++---------------------
 src/compiler.ml  |  3 ---
 src/data.ml      |  6 +-----
 src/runtime.ml   |  1 -
 4 files changed, 22 insertions(+), 30 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 126b0a2ce..371c0fc23 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -862,17 +862,17 @@ external pred std.string.map.bindings i:std.string.map A,
 
 % [std.string.map.filter M F M1] Filter M w.r.t. the predicate F
 external pred std.string.map.filter i:std.string.map A, 
-                                    i:(string -> A -> prop), 
+                                    i:string -> A -> prop, 
                                     o:std.string.map A.
 
 % [std.string.map.map M F M1] Map M w.r.t. the predicate F
 external pred std.string.map.map i:std.string.map A, 
-                                 i:(string -> A -> B -> prop), 
+                                 i:string -> A -> B -> prop, 
                                  o:std.string.map B.
 
 % [std.string.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.string.map.fold i:std.string.map A, i:C, 
-                                  i:(string -> A -> C -> C -> prop), o:C.
+                                  i:string -> A -> C -> C -> prop, o:C.
 
 % CAVEAT: the type parameter of std.int.map must be a closed term
 
@@ -898,16 +898,16 @@ external pred std.int.map.find i:int, i:std.int.map A, o:A.
 external pred std.int.map.bindings i:std.int.map A, o:list (pair int A).
 
 % [std.int.map.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.int.map.filter i:std.int.map A, i:(int -> A -> prop), 
+external pred std.int.map.filter i:std.int.map A, i:int -> A -> prop, 
                                  o:std.int.map A.
 
 % [std.int.map.map M F M1] Map M w.r.t. the predicate F
-external pred std.int.map.map i:std.int.map A, i:(int -> A -> B -> prop), 
+external pred std.int.map.map i:std.int.map A, i:int -> A -> B -> prop, 
                               o:std.int.map B.
 
 % [std.int.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.int.map.fold i:std.int.map A, i:C, 
-                               i:(int -> A -> C -> C -> prop), o:C.
+                               i:int -> A -> C -> C -> prop, o:C.
 
 % CAVEAT: the type parameter of std.loc.map must be a closed term
 
@@ -933,16 +933,16 @@ external pred std.loc.map.find i:loc, i:std.loc.map A, o:A.
 external pred std.loc.map.bindings i:std.loc.map A, o:list (pair loc A).
 
 % [std.loc.map.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.loc.map.filter i:std.loc.map A, i:(loc -> A -> prop), 
+external pred std.loc.map.filter i:std.loc.map A, i:loc -> A -> prop, 
                                  o:std.loc.map A.
 
 % [std.loc.map.map M F M1] Map M w.r.t. the predicate F
-external pred std.loc.map.map i:std.loc.map A, i:(loc -> A -> B -> prop), 
+external pred std.loc.map.map i:std.loc.map A, i:loc -> A -> B -> prop, 
                               o:std.loc.map B.
 
 % [std.loc.map.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.loc.map.fold i:std.loc.map A, i:C, 
-                               i:(loc -> A -> C -> C -> prop), o:C.
+                               i:loc -> A -> C -> C -> prop, o:C.
 
 kind std.string.set type.
 
@@ -994,22 +994,22 @@ external pred std.string.set.max i:std.string.set, o:string.
 external pred std.string.set.cardinal i:std.string.set, o:int.
 
 % [std.string.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.string.set.filter i:std.string.set, i:(string -> prop), 
+external pred std.string.set.filter i:std.string.set, i:string -> prop, 
                                     o:std.string.set.
 
 % [std.string.set.map M F M1] Map M w.r.t. the predicate F
 external pred std.string.set.map i:std.string.set, 
-                                 i:(string -> string -> prop), 
+                                 i:string -> string -> prop, 
                                  o:std.string.set.
 
 % [std.string.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.string.set.fold i:std.string.set, i:A, 
-                                  i:(string -> A -> A -> prop), o:A.
+                                  i:string -> A -> A -> prop, o:A.
 
 % [std.string.set.partition M F M1 M2] Partitions M w.r.t. the predicate F,
 % M1 is where F holds
 external pred std.string.set.partition i:std.string.set, 
-                                       i:(string -> prop), 
+                                       i:string -> prop, 
                                        o:std.string.set, o:std.string.set.
 
 kind std.int.set type.
@@ -1060,20 +1060,20 @@ external pred std.int.set.max i:std.int.set, o:int.
 external pred std.int.set.cardinal i:std.int.set, o:int.
 
 % [std.int.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.int.set.filter i:std.int.set, i:(int -> prop), 
+external pred std.int.set.filter i:std.int.set, i:int -> prop, 
                                  o:std.int.set.
 
 % [std.int.set.map M F M1] Map M w.r.t. the predicate F
-external pred std.int.set.map i:std.int.set, i:(int -> int -> prop), 
+external pred std.int.set.map i:std.int.set, i:int -> int -> prop, 
                               o:std.int.set.
 
 % [std.int.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.int.set.fold i:std.int.set, i:A, 
-                               i:(int -> A -> A -> prop), o:A.
+                               i:int -> A -> A -> prop, o:A.
 
 % [std.int.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1
 % is where F holds
-external pred std.int.set.partition i:std.int.set, i:(int -> prop), 
+external pred std.int.set.partition i:std.int.set, i:int -> prop, 
                                     o:std.int.set, o:std.int.set.
 
 kind std.loc.set type.
@@ -1124,20 +1124,20 @@ external pred std.loc.set.max i:std.loc.set, o:loc.
 external pred std.loc.set.cardinal i:std.loc.set, o:int.
 
 % [std.loc.set.filter M F M1] Filter M w.r.t. the predicate F
-external pred std.loc.set.filter i:std.loc.set, i:(loc -> prop), 
+external pred std.loc.set.filter i:std.loc.set, i:loc -> prop, 
                                  o:std.loc.set.
 
 % [std.loc.set.map M F M1] Map M w.r.t. the predicate F
-external pred std.loc.set.map i:std.loc.set, i:(loc -> loc -> prop), 
+external pred std.loc.set.map i:std.loc.set, i:loc -> loc -> prop, 
                               o:std.loc.set.
 
 % [std.loc.set.fold M Acc F Acc1] fold M w.r.t. the predicate F
 external pred std.loc.set.fold i:std.loc.set, i:A, 
-                               i:(loc -> A -> A -> prop), o:A.
+                               i:loc -> A -> A -> prop, o:A.
 
 % [std.loc.set.partition M F M1 M2] Partitions M w.r.t. the predicate F, M1
 % is where F holds
-external pred std.loc.set.partition i:std.loc.set, i:(loc -> prop), 
+external pred std.loc.set.partition i:std.loc.set, i:loc -> prop, 
                                     o:std.loc.set, o:std.loc.set.
 
 #line 0 "builtin_map.elpi"
diff --git a/src/compiler.ml b/src/compiler.ml
index de70b1fb7..7e0ef72ed 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1446,9 +1446,6 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     | TApp (a,b,l) -> []
 
   let compile_mode (state, modes) { Ast.Type.name; ty; loc } =
-    let o = open_out "/home/dfissore/Documents/github/ELPI_DEV/functionality/aa" in
-    Format.fprintf (Format.formatter_of_out_channel o) "Doing to mode of %s\n%!" (F.show name);
-    close_out o;
     let args = to_mode_rec ty in
     let state, mname = funct_of_ast state name in
     check_duplicate_mode state mname (args,loc) modes;
diff --git a/src/data.ml b/src/data.ml
index 0a922d597..ca4092c67 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -1300,11 +1300,7 @@ let pp_tab_args fmt l =
 
 let pp_arg sep fmt (dir,ty,doc) =
   let dir = if dir then "i" else "o" in
-  try 
-    (Re.Str.search_forward (Re.Str.regexp "->") ty 0 |> ignore);
-    Fmt.fprintf fmt "%s:(%s)%s" dir ty sep
-  with Not_found ->
-    Fmt.fprintf fmt "%s:%s%s" dir ty sep
+  Fmt.fprintf fmt "%s:%s%s" dir ty sep
 ;;
 
 let pp_args = pplist (pp_arg "") ", " ~pplastelem:(pp_arg "")
diff --git a/src/runtime.ml b/src/runtime.ml
index e597a9330..f55295cfc 100644
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -2380,7 +2380,6 @@ let tail_opt = function
   | [] -> []
   | _ :: xs -> xs
 
-(** [hd_opt L] returns false if L = [[]] otherwise L.(0)  *)
 let hd_opt = function
   | x :: _ -> get_arg_mode x
   | _ -> Output

From d6f98cd4681a647fa1bcc7639c2901a6d75923b5 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 11:35:03 +0200
Subject: [PATCH 22/32] [compiler] term -> ttype (warning typeabbrv tests not
 working...)

---
 src/compiler.ml | 317 +++++++++++++++++++++++++++++-------------------
 src/data.ml     |  11 ++
 2 files changed, 204 insertions(+), 124 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index 7e0ef72ed..5aa2f9076 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -418,16 +418,23 @@ type preterm = {
 }
 [@@ deriving show, ord]
 
+type pretype = {
+  ttype : D.ttype; (* Args are still constants *)
+  tamap : argmap;
+  tloc : Loc.t;
+}
+[@@ deriving show, ord]
+
 type type_declaration = {
   tname : D.constant;
-  ttype : preterm;
+  ttype : pretype;
   tloc : Loc.t;
 }
 [@@ deriving show, ord]
 
 type type_abbrev_declaration = {
   taname : D.constant;
-  tavalue : preterm;
+  tavalue : pretype;
   taparams : int;
   taloc : Loc.t;
   timestamp:int
@@ -1226,45 +1233,23 @@ let preterm_of_ast loc ~depth:arg_lvl macro state ast =
   state, t, !spilling
 ;;
 
-let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpression.t) =
+let to_mode = function Ast.Mode.Input -> Input | Output -> Output
 
-  let rec hcons_alien_term state = function
-    | Term.Const x ->
-        Symbols.get_global_or_allocate_bound_symbol state x
-    | Cons(x, y) ->
-       let state, x = hcons_alien_term state x in
-       let state, y = hcons_alien_term state y in
-       state, Term.mkCons x y
-    | UVar _ | AppUVar _ | Arg _ | AppArg _ -> assert false
-    | App(c,x,l) ->
-       let state, x = hcons_alien_term state x in
-       let state, l = map_acc hcons_alien_term state l in
-       state, Term.mkApp c x l
-    | Builtin(c,l) ->
-       let state, l = map_acc hcons_alien_term state l in
-       state, Term.mkBuiltin c l
-    | Lam x ->
-       let state, x = hcons_alien_term state x in
-       state, Term.mkLam x
-    | (Nil | CData _ | Discard) as x -> state, x
-  in
+let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpression.t) : State.t * ttype * bool =
 
-  let stack_funct_of_ast curlvl state f  =
-    try state, F.Map.find f (get_varmap state)
+  let stack_funct_of_ast curlvl state f : State.t * ttype =
+    try state, cons2tcons ~loc @@ F.Map.find f (get_varmap state)
     with Not_found ->
      if is_discard f then error ~loc "Discard operator cannot be used in type declaration"
-     else if F.is_uvar_name f then mk_Arg state ~name:(F.show f) ~args:[]
+     else if F.is_uvar_name f then 
+        let state, t = mk_Arg state ~name:(F.show f) ~args:[] in
+        state, cons2tcons ~loc t
      else if is_macro_name f then error ~loc "Macros cannot occur in types. Use a typeabbrev declaration instead"
      else
-       let state, (_,t) = Symbols.allocate_global_symbol state f in
-       state, t in
+       let state, (c,_) = Symbols.allocate_global_symbol state f in
+       state, TConst c in
 
-  let get_arrow_const lvl state = 
-    match stack_funct_of_ast lvl state (F.from_string "->") with 
-    | s, Const c -> s, c
-    | _ -> error ~loc "Unreachable branch" in
-
-  let rec aux lvl state = function
+  let rec aux lvl state : Ast.TypeExpression.t -> State.t * ttype = function
     | Ast.TypeExpression.TConst f -> stack_funct_of_ast lvl state f
     | TApp(f, hd, tl) ->
       let tl = hd :: tl in
@@ -1276,40 +1261,40 @@ let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpressi
       let tl = List.rev rev_tl in
       let state, c = stack_funct_of_ast lvl state f in
       begin match c with
-      | Const c -> begin match tl with
-        | hd2::tl -> state, Term.App(c,hd2,tl)
+      | TConst c -> begin match tl with
+        | hd2::tl -> state, TApp(c,hd2,tl)
         | _ -> anomaly "Application node with no arguments" end
-      | App(c,hd1,tl1) -> state, Term.App(c,hd1,tl1@tl)
-      | Builtin(c,tl1) -> state, Term.Builtin(c,tl1@tl)
-      | Lam _ -> (* macro with args *)
-        hcons_alien_term state (R.deref_appuv ~from:lvl ~to_:lvl tl c)
-      | Discard -> error ~loc "Clause shape unsupported: _ cannot be applied"
+      | TApp(c,hd1,tl1) -> state, TApp(c,hd1,tl1@tl)
+      | TLam _ -> error ~loc "Should be unreachable"
       | _ -> error ~loc "Clause shape unsupported" end
-    | TCData c -> state, CData (CData.hcons c)
+    | TCData c -> state, TCData (CData.hcons c)
     | TArr (a,b) -> 
       let state, a = aux lvl state a in
       let state, b = aux lvl state b in
-      let state, c = get_arrow_const lvl state in
-      state, App(c, a, [b])
-    | TPred (_,l) -> 
-      let l = List.rev l in
-      let hd, tl = List.hd l, List.tl l in
-      List.fold_left (fun (state,t:  State.t * term) e ->
-        let state, t' = aux lvl state (snd e) in
-        let state, c = get_arrow_const lvl state in
-        state, App (c, t', [t])
-        ) (aux lvl state (snd hd)) tl
+      state, TArr(a, b)
+    | TPred (_,l) -> (* TODO: Check if function is in the _ *) 
+      (* let _ =
+        let x = List.map snd l in
+        Format.printf "AAA %a %a\n%!" Loc.pp loc (Format.pp_print_list Ast.TypeExpression.pp) x;
+      in *)
+      let state, mode_type = List.fold_right (fun (m, t) (state, acc) -> 
+        let state, t = aux lvl state t in state, ((to_mode m, t)::acc)) l (state, []) in
+      (* let _ =
+        let x = List.map snd mode_type in
+        Format.printf "BBB %a %a\n%!" Loc.pp loc (Format.pp_print_list pp_ttype) x;
+      in *)
+      state, TPred (false, mode_type) (* TODO: the bool depends on if the functionality is passed to the pred *)
   in
   let a, b = aux arg_lvl state ast in a, b, false
 
-let typeabbrev_of_ast loc ~depth:depth macro state (ast: Ast.TypeAbbreviation.closedTypeexpression) =
+let typeabbrev_of_ast loc ~depth:depth macro state (ast: Ast.TypeAbbreviation.closedTypeexpression) : State.t * ttype * bool =
   let rec aux depth state = function
     | Ast.TypeAbbreviation.Lam (x, t) ->
        let orig_varmap = get_varmap state in
        let state, c = Symbols.allocate_bound_symbol state depth in
        let state = update_varmap state (F.Map.add x c) in
        let state, t', _ = aux (depth+1) state t in
-       set_varmap state orig_varmap, Lam t', false
+       set_varmap state orig_varmap, TLam t', false
     | Ty t -> type_expression_of_ast ~depth loc macro state t
   in
   aux depth state ast
@@ -1345,9 +1330,9 @@ let prechr_rule_of_ast depth macros state r =
   { pto_match; pto_remove; pguard; pnew_goal; pamap; pname; pifexpr; pcloc }
   
 (* used below *)
-let of_ast transformer loc ~depth macros state f t =
+let preterms_of_ast loc ~depth macros state f t =
   assert(is_empty_amap (get_argmap state));
-  let state, term, spilling = transformer loc ~depth macros state t in
+  let state, term, spilling = preterm_of_ast loc ~depth macros state t in
   let state, terms = f ~depth state term in
   let amap = get_argmap state in
   let state = State.end_clause_compilation state in
@@ -1355,6 +1340,26 @@ let of_ast transformer loc ~depth macros state f t =
   state, List.map (fun (loc,term) -> { term; amap; loc; spilling }) terms
 ;; 
 
+let type_expression_of_ast loc ~depth macros state f (t: Ast.TypeExpression.t) : State.t * pretype list =
+  assert(is_empty_amap (get_argmap state));
+  let state, term, spilling = type_expression_of_ast loc ~depth macros state t in
+  let state, terms = f ~depth state term in
+  let tamap = get_argmap state in
+  let state = State.end_clause_compilation state in
+  (* TODO: may have spurious entries in the amap *)
+  state, List.map (fun (tloc,ttype) -> { ttype; tamap; tloc }) terms
+;; 
+
+let type_abbrev_of_ast loc ~depth macros state f t : State.t * pretype list =
+  assert(is_empty_amap (get_argmap state));
+  let state, term, spilling = typeabbrev_of_ast loc ~depth macros state t in
+  let state, terms = f ~depth state term in
+  let tamap = get_argmap state in
+  let state = State.end_clause_compilation state in
+  (* TODO: may have spurious entries in the amap *)
+  state, List.map (fun (tloc,ttype) -> { ttype; tamap; tloc }) terms
+;; 
+
 (* exported *)
 let query_preterm_of_function ~depth:_ macros state f =
   assert(is_empty_amap (get_argmap state));
@@ -1392,9 +1397,9 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
 
   let compile_type_abbrev geti lcs state { Ast.TypeAbbreviation.name; nparams; loc; value } =
     let state, (taname, _) = Symbols.allocate_global_symbol state name in
-    let state, tavalue = of_ast typeabbrev_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) value in
+    let state, tavalue = type_abbrev_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) value in
     let tavalue = assert(List.length tavalue = 1); List.hd tavalue in
-    if tavalue.amap.nargs != 0 then
+    if tavalue.tamap.nargs != 0 then
       error ~loc ("type abbreviation for " ^ F.show name ^ " has unbound variables");
     state, { taname; tavalue; taparams = nparams; taloc = loc; timestamp = geti () }
 
@@ -1402,7 +1407,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     if C.Map.mem taname m then begin
       let { taloc = otherloc; tavalue = othervalue; taparams = otherparams } =
         C.Map.find taname m in
-      if taparams != otherparams || othervalue.term != tavalue.term then
+      if taparams != otherparams || othervalue.ttype != tavalue.ttype then
       error ~loc:taloc
         ("duplicate type abbreviation for " ^ Symbols.show state taname ^
           ". Previous declaration: " ^ Loc.show otherloc)
@@ -1411,8 +1416,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
 
   let compile_type lcs state { Ast.Type.attributes; loc; name; ty } =
     let state, (tname, _) = Symbols.allocate_global_symbol state name in
-    let state, ttype =
-      of_ast type_expression_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) ty in
+    let state, ttype = type_expression_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) ty in
     let ttype = assert(List.length ttype = 1); List.hd ttype in
     state, { Types.tindex = attributes; decl = { tname; ttype; tloc = loc } }
 
@@ -1431,8 +1435,6 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
        ("Duplicate mode declaration for " ^ Symbols.show state name ^ " (also at "^
          Loc.show (snd (C.Map.find name map)) ^ ")")
 
-  let to_mode = function Ast.Mode.Input -> Input | Output -> Output
-
   let rec to_mode_rec_aux = function
   | [] -> []
   | ((m: Ast.Mode.mode), Ast.TypeExpression.TPred (_,p)) :: l -> Ho (to_mode m, to_mode_rec_aux p) :: to_mode_rec_aux l 
@@ -1485,7 +1487,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     | [] -> lcs, state, []
     | { Ast.Clause.body; attributes; loc } :: rest ->
       let state, ts =
-        of_ast preterm_of_ast loc ~depth:lcs macros state (toplevel_clausify loc) body in
+        preterms_of_ast loc ~depth:lcs macros state (toplevel_clausify loc) body in
       let cl = List.map (fun body -> { Ast.Clause.loc; attributes; body}) ts in
       let lcs, state, rest = compile_clauses lcs state macros rest in
       lcs, state, cl :: rest
@@ -1664,11 +1666,11 @@ end = struct (* {{{ *)
   (* This function *must* re-hashcons all leaves (Const) and recognize
      builtins since it is (also) used to apply a compilation unit relocation *)
 
-  let smart_map_term ?(on_type=false) state f t =
+  let smart_map_term state f t =
     let rec aux_sm = function
       | Const c ->
           let c1 = f c in
-          if not on_type && Builtins.is_declared state c1 then Builtin(c1,[])
+          if Builtins.is_declared state c1 then Builtin(c1,[])
           else Symbols.get_canonical state c1
       | Lam t as x ->
           let t1 = aux_sm t in
@@ -1683,13 +1685,13 @@ end = struct (* {{{ *)
       | Builtin(c,ts) ->
           let c1 = f c in
           let ts1 = smart_map aux_sm ts in
-          if not on_type && Builtins.is_declared state c1 then Builtin(c,ts1)
+          if Builtins.is_declared state c1 then Builtin(c,ts1)
           else if ts1 = [] then Symbols.get_canonical state c1 else App(c,List.hd ts1,List.tl ts1)
       | App(c,t,ts) ->
           let c1 = f c in
           let t1 = aux_sm t in
           let ts1 = smart_map aux_sm ts in
-          if not on_type && Builtins.is_declared state c1 then Builtin (c1,t1 :: ts1)
+          if Builtins.is_declared state c1 then Builtin (c1,t1 :: ts1)
           else App(c1,t1,ts1)
       | Cons(hd,tl) as x ->
           let hd1 = aux_sm hd in
@@ -1702,6 +1704,23 @@ end = struct (* {{{ *)
     in
       aux_sm t
 
+  let smart_map_ttype state f t =
+    let rec aux_sm = function
+      | TConst c -> cons2tcons @@ Symbols.get_canonical state (f c)
+      | TLam t as x ->
+          let t1 = aux_sm t in
+          if t == t1 then x else TLam t1
+      | TApp(c,t,ts) ->
+          let c1 = f c in
+          let t1 = aux_sm t in
+          let ts1 = smart_map aux_sm ts in
+          TApp(c1,t1,ts1)
+      | TCData _ as x -> x
+      | TArr (a,b) -> TArr (aux_sm a, aux_sm b)
+      | TPred (f, l) -> TPred (f, List.map (fun (m, t) -> m, aux_sm t) l)
+    in
+      aux_sm t
+
 let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
   let c2i = Constants.Map.fold (fun k v m -> Constants.Map.add (f k) v m) c2i Constants.Map.empty in
   let n2t = StrMap.map (fun (t,c) ->
@@ -1714,10 +1733,10 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
 
   let smart_map_type state f ({ Types.tindex; decl = { tname; ttype; tloc }} as tdecl) =
     let tname1 = f tname in
-    let ttype1 = smart_map_term ~on_type:true state f ttype.term in
-    let tamap1 =subst_amap state f ttype.amap in
-    if tname1 == tname && ttype1 == ttype.term && ttype.amap = tamap1 then tdecl
-    else { Types.tindex; decl = { tname = tname1; tloc; ttype = { term = ttype1; amap = tamap1; loc = ttype.loc; spilling = ttype.spilling } } }
+    let ttype1 = smart_map_ttype state f ttype.ttype in
+    let tamap1 =subst_amap state f ttype.tamap in
+    if tname1 == tname && ttype1 == ttype.ttype && ttype.tamap = tamap1 then tdecl
+    else { Types.tindex; decl = { tname = tname1; tloc; ttype = { ttype = ttype1; tamap = tamap1; tloc = ttype.tloc; } } }
 
 
   let map_sequent state f { peigen; pcontext; pconclusion } =
@@ -1739,12 +1758,18 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
       pifexpr; pname; pcloc;
     }
 
-  let smart_map_preterm ?on_type state f ({ term; amap; loc; spilling } as x) =
-    let term1 = smart_map_term ?on_type state f term in
+  let smart_map_preterm state f ({ term; amap; loc; spilling } as x) =
+    let term1 = smart_map_term state f term in
     let amap1 = subst_amap state f amap in
     if term1 == term && amap1 == amap then x
     else { term = term1; amap = amap1; loc; spilling }
 
+  let smart_map_pretype state f ({ ttype; tamap; tloc } as x) =
+    let term1 = smart_map_ttype state f ttype in
+    let amap1 = subst_amap state f tamap in
+    if term1 == ttype && amap1 == tamap then x
+    else { ttype = term1; tamap = amap1; tloc }
+
   let map_clause state f ({ Ast.Clause.body } as x) =
     let body1 = smart_map_preterm state f body in
     if body1 == body then x else { x with Ast.Clause.body = body1 }
@@ -1761,7 +1786,7 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
     C.Map.fold (fun _ { taname; tavalue; taparams; taloc; timestamp } m ->
       (* TODO: check for collisions *)
       let taname = f taname in
-      let tavalue = smart_map_preterm ~on_type:true state f tavalue in
+      let tavalue = smart_map_pretype state f tavalue in
       C.Map.add taname { taname; tavalue; taparams; taloc; timestamp } m
       ) m C.Map.empty
 
@@ -1911,19 +1936,19 @@ module Spill : sig
 end = struct (* {{{ *)
 
   let rec read_ty = function
-    | App(c,x,[y]) when c == D.Global_symbols.variadic -> `Variadic (read_ty x,read_ty y)
-    | App(c,x,[y]) when c == D.Global_symbols.arrowc -> 
+    | TApp(c,x,[y]) when c == D.Global_symbols.variadic -> `Variadic (read_ty x,read_ty y)
+    | TApp(c,x,[y]) when c == D.Global_symbols.arrowc -> 
         let ty_x = read_ty x in
         begin match read_ty y with
         | `Arrow(tys,ty) -> `Arrow (ty_x :: tys, ty)
         | ty -> `Arrow([ty_x], ty) end
-    | Const x when x == D.Global_symbols.propc -> `Prop
+    | TConst x when x == D.Global_symbols.propc -> `Prop
     | _ -> `Unknown
 
   let type_of_const types c =
     try
       let { Types.decl = { ttype } } = (C.Map.find c types).Types.def in
-      read_ty ttype.term
+      read_ty ttype.ttype
     with
       Not_found -> `Unknown
 
@@ -2781,20 +2806,14 @@ let mkQCon time ~compiler_state new_state ~on_type ?(amap=empty_amap) c =
     if c < 0 then new_state, App(a,D.C.of_string (Symbols.show compiler_state c),[])
     else allocate_bound_symbol new_state (c + amap.nargs)
 
-let quote_preterm time ~compiler_state new_state ?(on_type=false) { term; amap } =
+let quote_preterm time ~compiler_state new_state { term; amap } =
   let new_state = ref new_state in
-  let mkQApp = mkQApp ~on_type in
+  let mkQApp = mkQApp ~on_type:false in
   let mkQCon c =
-    let n, x = mkQCon time ~compiler_state !new_state ~on_type ~amap c in
+    let n, x = mkQCon time ~compiler_state !new_state ~on_type:false ~amap c in
     new_state := n;
     x in
   let rec aux_quote depth term = match term with
-    | App(c,CData s,[])
-      when on_type && c == D.Global_symbols.ctypec && D.C.is_string s -> term
-    | App(c,s,[t]) when on_type && c == D.Global_symbols.arrowc ->
-        App(arrowc,aux_quote depth s,[aux_quote depth t])
-    | Const n when on_type && Symbols.show compiler_state n = "prop" -> term
-
     | Const n -> mkQCon n
     | Builtin(c,[]) -> mkQCon c
     | Lam x -> App(lamc,Lam (aux_quote (depth+1) x),[])
@@ -2825,6 +2844,32 @@ let quote_preterm time ~compiler_state new_state ?(on_type=false) { term; amap }
   let term = aux_quote amap.nargs term in
   !new_state, term
 
+let quote_pretype time ~compiler_state new_state { tloc; ttype; tamap } =
+  let new_state = ref new_state in
+  let mkQApp = mkQApp ~on_type:true in
+  let mkQCon c =
+    let n, x = mkQCon time ~compiler_state !new_state ~on_type:true ~amap:tamap c in
+    new_state := n;
+    x in
+  let rec aux depth term : term = match term with
+    | TApp(c,TCData s,[]) when c == D.Global_symbols.ctypec && D.C.is_string s -> App(c, CData s, [])
+    | TArr (s, t) -> App(arrowc,aux depth s,[aux depth t])
+    | TConst n when D.Global_symbols.propc = n -> Const n
+    | TConst n -> mkQCon n
+    | TLam x -> App(lamc,Lam (aux (depth+1) x),[])
+    | TApp(c,x,xs) -> mkQApp (mkQCon c :: List.(map (aux depth) (x :: xs)))
+    | TCData x -> App(cdatac, CData x,[])
+    | TPred (f, l) -> 
+      (* TODO: (flemma) for compatibility modes are ignored. Consider them! *)
+        (* Format.eprintf "LOC %s %a\n%!" (Loc.show tloc) (Format.pp_print_list pp_ttype) (List.map snd l); *)
+        let l = List.rev_map snd l in
+        let t = List.fold_left (fun acc e -> TArr (e, acc)) (List.hd l) (List.tl l) in
+        (* Format.eprintf "The arrow type is %a\n%!" pp_ttype t; *)
+        aux depth t
+  in
+  let term = aux tamap.nargs ttype in
+  !new_state, term
+
 (* FIXME : close_with_pis already exists but unused *)
 let close_w_binder binder t { nargs } =
   let rec close = function
@@ -2866,39 +2911,52 @@ let quote_syntax time new_state { WithMain.clauses; query; compiler_state } =
   let names = sorted_names_of_argmap query.amap in
   let clauses = handle_clause_graftin clauses in
   let new_state, clist = map_acc (quote_clause time ~compiler_state) new_state clauses in
-  let new_state, queryt = quote_preterm time ~on_type:false ~compiler_state new_state query in
+  let new_state, queryt = quote_preterm time ~compiler_state new_state query in
   let q =
     App(clausec,CData (quote_loc ~id:"query" query.loc),
       [R.list_to_lp_list names;
        close_w_binder argc queryt query.amap]) in
   new_state, clist, q
 
-let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { term; loc; amap } ttime =
-  let error_undefined ~t1 ~t2 c tavalue =
+let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype; tloc; tamap } ttime =
+  let loc = tloc in
+  let rec subst lvl (args: ttype array) = function
+    | TConst c when c >= 0 -> args.(c-lvl)
+    | TConst _ | TCData _ as t -> t
+    | TLam t -> subst (lvl+1) args t
+    | TArr (a, b) -> TArr (subst lvl args a, subst lvl args b)
+    | TPred (f, l) -> TPred (f, List.map (fun (a,b) -> a, subst lvl args b) l)
+    | TApp (a, b, c) -> TApp (a, subst lvl args b, List.map (subst lvl args) c)
+  in
+  let rec beta lvl (eaten: ttype list) t args =
+    match t, args with
+    | TLam t', x::xs -> beta (lvl+1) (x::eaten) t' xs
+    | t, [] -> 
+      (* Format.eprintf "Calling subst on %a\n%!" pp_ttype t; 
+      Format.eprintf "with args on %a\n%!" (Format.pp_print_list pp_ttype) eaten; 
+      Format.eprintf "depth is %d\n%!" lvl; *)
+      subst 0 (Array.of_list eaten) t
+    | _, _::_ -> error ~loc "higher-order types do not exist"
+  in
+  (* Format.eprintf "Going to unfold %a\n%!" (pp_ttype) ttype;  *)
+  let error_undefined ~t1 ~t2 c (tavalue: pretype) =
     if is_typeabbrev && t1 <= t2 then
-      error (Format.asprintf "typeabbrev %a uses the undefined %s constant at %a" (R.Pp.ppterm 0 [] ~argsdepth:0 [||]) tavalue.term (Symbols.show compiler_state c) Util.Loc.pp tavalue.loc);
+      error (Format.asprintf "typeabbrev %a uses the undefined %s constant at %a" pp_ttype tavalue.ttype (Symbols.show compiler_state c) Util.Loc.pp tavalue.tloc);
   in
   let find_opt c = C.Map.find_opt c type_abbrevs in
-  (* DEBUG HELPER: Prints the type_abrev dictionary sorted by timestamp *)
-  (* let _ = 
-    let x = C.Map.bindings type_abbrevs in
-    let y = List.sort (fun (_, (x: type_abbrev_declaration)) (_, y) -> x.timestamp - y.timestamp) x in
-    print_endline "---------------------------------------------";
-    List.iter (fun (k,(v:type_abbrev_declaration)) -> 
-      Format.printf "TIME AND KEY %s -- %d\n%!" (Symbols.show compiler_state k) (v.timestamp)) y;
-  in *)
-  let rec aux_tabbrv ttime = function
-    | Const c as x ->
+  let rec aux seen = function
+    | TConst c as x ->
         begin match find_opt c with
         | Some { tavalue; taparams; timestamp=time } ->
+          (* Format.printf "Found a match %a\n" pp_ttype tavalue.ttype; *)
           if taparams > 0 then
             error ~loc ("type abbreviation " ^ Symbols.show compiler_state c ^ " needs " ^
               string_of_int taparams ^ " arguments");
           error_undefined ttime time c tavalue;
-          aux_tabbrv time tavalue.term
+          aux time tavalue.ttype
         | None -> x
         end
-    | App(c,t,ts) as x ->
+    | TApp(c,t,ts) as x ->
         begin match find_opt c with
         | Some { tavalue; taparams; timestamp=time } ->
           let nargs = 1 + List.length ts in
@@ -2906,18 +2964,28 @@ let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { term;
             error ~loc ("type abbreviation " ^ Symbols.show compiler_state c ^ " needs " ^
               string_of_int taparams ^ " arguments, only " ^
               string_of_int nargs ^ " are provided");
+          (* Format.eprintf "Seen is [%a]\n%!" (Format.pp_print_list Format.pp_print_int) (C.Set.elements seen);
+          Format.eprintf "Current is %d\n%!" c;
+          Format.eprintf "Result is %a\n%!" pp_ttype tavalue.ttype;
+          Format.eprintf "lcs is %d\n%!" lcs;
+          Format.eprintf "Args are [%a]\n%!" (Format.pp_print_list pp_ttype) (t::ts); *)
           error_undefined ttime time c tavalue;
-          aux_tabbrv time (R.deref_appuv ~from:lcs ~to_:lcs (t::ts) tavalue.term)
+          aux time (beta 0 [] tavalue.ttype (t::ts))
+          (* aux (C.Set.add c seen) (R.deref_appuv ~from:lcs ~to_:lcs (t::ts) tavalue.term) *)
         | None ->
-          let t1 = aux_tabbrv ttime t in
-          let ts1 = smart_map (aux_tabbrv ttime) ts in
+          let t1 = aux seen t in
+          let ts1 = smart_map (aux seen) ts in
           if t1 == t && ts1 == ts then x
-          else App(c,t1,ts1)
+          else TApp(c,t1,ts1)
         end
-    | Lam x -> Lam (aux_tabbrv ttime x)
-    | x -> x
+    | TPred (f, l) -> TPred (f, List.map (fun (a, b) -> a, aux seen b) l)
+    | TArr (a, b) -> TArr (aux seen a, aux seen b)
+    | TCData _ as a -> a
+    | TLam a -> TLam (aux seen a)
   in
-    { term = aux_tabbrv ttime term; loc; amap; spilling = false }
+    (* Format.eprintf "Unfold result is %a\n%!" pp_ttype (aux C.Set.empty ttype); *)
+    { ttype = aux ttime ttype; tloc; tamap }
+
 
 let term_of_ast ~depth state text =
  if State.get D.while_compiling state then
@@ -2940,32 +3008,33 @@ let static_check ~exec ~checker:(state,program)
   let time = `Compiletime in
   let state, p,q = quote_syntax time state q in
 
-  (* C.Map.iter (fun k ((v:type_abbrev_declaration),t) -> Format.printf "H %s %a %d\n%!" (Symbols.show state k) 
-    pp_term v.tavalue.term t) type_abbrevs; *)
-
+    (* Building type abbrev list *)
   let state, talist =
     C.Map.bindings type_abbrevs |>
-    map_acc (fun state (name, { tavalue; timestamp=ttime }) ->
+    map_acc (fun state (name, { tavalue; timestamp=ttime } ) ->
+      (* Printf.eprintf "Unfolding %d %s\n" name (Symbols.show compiler_state name);  *)
       let tavaluet = unfold_type_abbrevs ~is_typeabbrev:true ~compiler_state initial_depth type_abbrevs tavalue ttime in
-      let state, tavaluet = quote_preterm time ~compiler_state state ~on_type:true tavaluet in
+      let state, tavaluet = quote_pretype time ~compiler_state state tavaluet in
       state, App(colonec, D.C.of_string (Symbols.show compiler_state name), [lam2forall tavaluet])) state
-    in
-
+  in
 
+  (* Building types *)
   let state, tlist = C.Map.fold (fun tname l (state,tl) ->
     let l = l.Types.lst in
     let state, l =
-      List.rev l |> map_acc (fun state { Types.decl = { ttype } } ->
+      List.rev l |> map_acc (fun state { Types.decl = { ttype; tname } } ->
         let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
+        (* Printf.eprintf "Working with the type %s\n" (Symbols.show compiler_state tname); *)
         let ttypet = unfold_type_abbrevs ~is_typeabbrev:false ~compiler_state initial_depth type_abbrevs ttype 0 in
-        let state, ttypet = quote_preterm time ~compiler_state state ~on_type:true ttypet in
-        state, App(colonc,c, [close_w_binder forallc ttypet ttype.amap])) state
+        (* Format.eprintf "Going to quote_pretype %a\n%!" pp_ttype ttypet.ttype; *)
+        let state, ttypet = quote_pretype time ~compiler_state state ttypet in
+        (* Format.eprintf "Going to close_w_binder %a\n%!" pp_term ttypet; *)
+        state, App(colonc,c, [close_w_binder forallc ttypet ttype.tamap])) state
       in
         state, l :: tl)
       types (state,[]) in
-  let tlist = List.concat (List.rev tlist) in
-
-    (* Building functionality *)
+  let tlist = List.concat (List.rev tlist) in  
+  (* Building functionality *)
   let state, functionality = C.Set.fold (fun tname (state,tl) ->
     let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
     state, c :: tl) functionality (state,[]) in
diff --git a/src/data.ml b/src/data.ml
index ca4092c67..13a580ed9 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -92,6 +92,15 @@ type mode_aux = Util.mode_aux =
 and mode = mode_aux list
 [@@ deriving show, ord]
 
+type ttype =
+  | TConst of constant
+  | TApp of constant * ttype * ttype list
+  | TPred of bool * ((arg_mode * ttype) list) (* The bool is for functionality *)
+  | TArr of ttype * ttype
+  | TCData of CData.t
+  | TLam of ttype (* this is for parametrized typeabbrevs *)
+  [@@ deriving show, ord]
+
 type term =
   (* Pure terms *)
   | Const of constant
@@ -116,6 +125,8 @@ and uvar_body = {
 }
 [@@deriving show, ord]
 
+let cons2tcons ?(loc=Loc.initial"") = function Const t -> TConst t | _ -> anomaly ~loc "Unreachable branch"
+
 (* we use this projection to be sure we ignore the sign *)
 let uvar_id { uid_private } = abs uid_private [@@inline];;
 let uvar_is_a_blocker   { uid_private } = uid_private < 0 [@@inline];;

From 814b3625ba0d4c91bfb7d8d5ccf53c2eebb44c34 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Fri, 4 Oct 2024 16:30:27 +0200
Subject: [PATCH 23/32] [compiler] small update (still error in typeabbrv
 tests)

---
 src/compiler.ml | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index 5aa2f9076..b0132cef5 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1275,13 +1275,19 @@ let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpressi
     | TPred (_,l) -> (* TODO: Check if function is in the _ *) 
       (* let _ =
         let x = List.map snd l in
-        Format.printf "AAA %a %a\n%!" Loc.pp loc (Format.pp_print_list Ast.TypeExpression.pp) x;
+        Format.eprintf "AAA %a %a\n%!" Loc.pp loc (Format.pp_print_list Ast.TypeExpression.pp) x;
       in *)
-      let state, mode_type = List.fold_right (fun (m, t) (state, acc) -> 
-        let state, t = aux lvl state t in state, ((to_mode m, t)::acc)) l (state, []) in
+      let rec aux' state = function
+      | [] -> state, []
+      | (m,t) :: xs -> 
+          let state, t = aux lvl state t in
+          let state, l = aux' state xs in
+          state, ((to_mode m,t)::l) in
+      let state, mode_type = aux' state l in
+        (* set_spaghetti_printer pp_const (fun fmt e -> Format.fprintf fmt "%s" (Symbols.show state e)); *)
       (* let _ =
         let x = List.map snd mode_type in
-        Format.printf "BBB %a %a\n%!" Loc.pp loc (Format.pp_print_list pp_ttype) x;
+        Format.eprintf "BBB %a %a\n%!" Loc.pp loc (Format.pp_print_list pp_ttype) x;
       in *)
       state, TPred (false, mode_type) (* TODO: the bool depends on if the functionality is passed to the pred *)
   in

From ecb7093d3d4f417b8bb4cbd8c3fa4ab5e5e13f07 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Sat, 5 Oct 2024 10:40:22 +0200
Subject: [PATCH 24/32] [add-test] spilling with disjunction

---
 tests/sources/spill_or.elpi  | 6 ++++++
 tests/suite/elpi_specific.ml | 5 +++++
 2 files changed, 11 insertions(+)
 create mode 100644 tests/sources/spill_or.elpi

diff --git a/tests/sources/spill_or.elpi b/tests/sources/spill_or.elpi
new file mode 100644
index 000000000..0761dc157
--- /dev/null
+++ b/tests/sources/spill_or.elpi
@@ -0,0 +1,6 @@
+pred p o:int.
+pred q  o:int,o:int.
+q 2 3.
+p X :- print X.
+
+main :- (true ;  (p {q X})), !, var X.
\ No newline at end of file
diff --git a/tests/suite/elpi_specific.ml b/tests/suite/elpi_specific.ml
index 927d1925b..a8657ad32 100644
--- a/tests/suite/elpi_specific.ml
+++ b/tests/suite/elpi_specific.ml
@@ -145,6 +145,11 @@ let () = declare "spilling_and"
   ~description:"spilling anonymous compound goal"
   ()
 
+let () = declare "spilling_or"
+  ~source_elpi:"spill_or.elpi"
+  ~description:"spilling prem order"
+  ()
+
 let () = declare "block"
   ~source_elpi:"block.elpi"
   ~description:"blocks are closed"

From 6d16cd2038f726757ab587bdde9c8327e8d8ff71 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 11:43:04 +0200
Subject: [PATCH 25/32] [compiler] corrected bug of previous two commits

---
 src/compiler.ml | 84 +++++++++++++++++++------------------------------
 1 file changed, 32 insertions(+), 52 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index b0132cef5..9163c08b7 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1235,7 +1235,7 @@ let preterm_of_ast loc ~depth:arg_lvl macro state ast =
 
 let to_mode = function Ast.Mode.Input -> Input | Output -> Output
 
-let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpression.t) : State.t * ttype * bool =
+let type_expression_of_ast loc ~depth:arg_lvl macro state ast =
 
   let stack_funct_of_ast curlvl state f : State.t * ttype =
     try state, cons2tcons ~loc @@ F.Map.find f (get_varmap state)
@@ -1272,11 +1272,7 @@ let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpressi
       let state, a = aux lvl state a in
       let state, b = aux lvl state b in
       state, TArr(a, b)
-    | TPred (_,l) -> (* TODO: Check if function is in the _ *) 
-      (* let _ =
-        let x = List.map snd l in
-        Format.eprintf "AAA %a %a\n%!" Loc.pp loc (Format.pp_print_list Ast.TypeExpression.pp) x;
-      in *)
+    | TPred (_functional,l) -> (* TODO: @FissoreD _functionanlity should be taken into account *) 
       let rec aux' state = function
       | [] -> state, []
       | (m,t) :: xs -> 
@@ -1284,23 +1280,18 @@ let type_expression_of_ast loc ~depth:arg_lvl macro state (ast: Ast.TypeExpressi
           let state, l = aux' state xs in
           state, ((to_mode m,t)::l) in
       let state, mode_type = aux' state l in
-        (* set_spaghetti_printer pp_const (fun fmt e -> Format.fprintf fmt "%s" (Symbols.show state e)); *)
-      (* let _ =
-        let x = List.map snd mode_type in
-        Format.eprintf "BBB %a %a\n%!" Loc.pp loc (Format.pp_print_list pp_ttype) x;
-      in *)
-      state, TPred (false, mode_type) (* TODO: the bool depends on if the functionality is passed to the pred *)
+      state, TPred (false, mode_type) (* TODO: @FissoreD false should be replaced wrt _functional  *)
   in
-  let a, b = aux arg_lvl state ast in a, b, false
+  aux arg_lvl state ast
 
-let typeabbrev_of_ast loc ~depth:depth macro state (ast: Ast.TypeAbbreviation.closedTypeexpression) : State.t * ttype * bool =
+let typeabbrev_of_ast loc ~depth:depth macro state ast =
   let rec aux depth state = function
     | Ast.TypeAbbreviation.Lam (x, t) ->
        let orig_varmap = get_varmap state in
        let state, c = Symbols.allocate_bound_symbol state depth in
        let state = update_varmap state (F.Map.add x c) in
-       let state, t', _ = aux (depth+1) state t in
-       set_varmap state orig_varmap, TLam t', false
+       let state, t = aux (depth+1) state t in
+       set_varmap state orig_varmap, TLam t
     | Ty t -> type_expression_of_ast ~depth loc macro state t
   in
   aux depth state ast
@@ -1346,25 +1337,16 @@ let preterms_of_ast loc ~depth macros state f t =
   state, List.map (fun (loc,term) -> { term; amap; loc; spilling }) terms
 ;; 
 
-let type_expression_of_ast loc ~depth macros state f (t: Ast.TypeExpression.t) : State.t * pretype list =
+let pretype_of_ast ~of_ast loc ~depth macros state t : State.t * pretype list =
   assert(is_empty_amap (get_argmap state));
-  let state, term, spilling = type_expression_of_ast loc ~depth macros state t in
-  let state, terms = f ~depth state term in
+  let state, term = of_ast loc ~depth macros state t in
   let tamap = get_argmap state in
   let state = State.end_clause_compilation state in
-  (* TODO: may have spurious entries in the amap *)
-  state, List.map (fun (tloc,ttype) -> { ttype; tamap; tloc }) terms
+  state, List.map (fun (tloc,ttype) -> { ttype; tamap; tloc }) [loc,term]
 ;; 
 
-let type_abbrev_of_ast loc ~depth macros state f t : State.t * pretype list =
-  assert(is_empty_amap (get_argmap state));
-  let state, term, spilling = typeabbrev_of_ast loc ~depth macros state t in
-  let state, terms = f ~depth state term in
-  let tamap = get_argmap state in
-  let state = State.end_clause_compilation state in
-  (* TODO: may have spurious entries in the amap *)
-  state, List.map (fun (tloc,ttype) -> { ttype; tamap; tloc }) terms
-;; 
+let type_abbrev_of_ast = pretype_of_ast ~of_ast:typeabbrev_of_ast ;; 
+let type_expression_of_ast = pretype_of_ast ~of_ast:type_expression_of_ast ;; 
 
 (* exported *)
 let query_preterm_of_function ~depth:_ macros state f =
@@ -1403,7 +1385,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
 
   let compile_type_abbrev geti lcs state { Ast.TypeAbbreviation.name; nparams; loc; value } =
     let state, (taname, _) = Symbols.allocate_global_symbol state name in
-    let state, tavalue = type_abbrev_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) value in
+    let state, tavalue = type_abbrev_of_ast loc ~depth:lcs F.Map.empty state value in
     let tavalue = assert(List.length tavalue = 1); List.hd tavalue in
     if tavalue.tamap.nargs != 0 then
       error ~loc ("type abbreviation for " ^ F.show name ^ " has unbound variables");
@@ -1413,7 +1395,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
     if C.Map.mem taname m then begin
       let { taloc = otherloc; tavalue = othervalue; taparams = otherparams } =
         C.Map.find taname m in
-      if taparams != otherparams || othervalue.ttype != tavalue.ttype then
+      if taparams != otherparams || othervalue.ttype <> tavalue.ttype then
       error ~loc:taloc
         ("duplicate type abbreviation for " ^ Symbols.show state taname ^
           ". Previous declaration: " ^ Loc.show otherloc)
@@ -1422,7 +1404,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
 
   let compile_type lcs state { Ast.Type.attributes; loc; name; ty } =
     let state, (tname, _) = Symbols.allocate_global_symbol state name in
-    let state, ttype = type_expression_of_ast loc ~depth:lcs F.Map.empty state (fun ~depth:_ state x -> state, [loc,x]) ty in
+    let state, ttype = type_expression_of_ast loc ~depth:lcs F.Map.empty state ty in
     let ttype = assert(List.length ttype = 1); List.hd ttype in
     state, { Types.tindex = attributes; decl = { tname; ttype; tloc = loc } }
 
@@ -1943,12 +1925,13 @@ end = struct (* {{{ *)
 
   let rec read_ty = function
     | TApp(c,x,[y]) when c == D.Global_symbols.variadic -> `Variadic (read_ty x,read_ty y)
-    | TApp(c,x,[y]) when c == D.Global_symbols.arrowc -> 
+    | TArr(x,y) -> 
         let ty_x = read_ty x in
         begin match read_ty y with
         | `Arrow(tys,ty) -> `Arrow (ty_x :: tys, ty)
         | ty -> `Arrow([ty_x], ty) end
     | TConst x when x == D.Global_symbols.propc -> `Prop
+    | TPred (_, l) -> `Arrow (List.map (fun (_, t) -> read_ty t) l, `Prop)
     | _ -> `Unknown
 
   let type_of_const types c =
@@ -2866,11 +2849,9 @@ let quote_pretype time ~compiler_state new_state { tloc; ttype; tamap } =
     | TApp(c,x,xs) -> mkQApp (mkQCon c :: List.(map (aux depth) (x :: xs)))
     | TCData x -> App(cdatac, CData x,[])
     | TPred (f, l) -> 
-      (* TODO: (flemma) for compatibility modes are ignored. Consider them! *)
-        (* Format.eprintf "LOC %s %a\n%!" (Loc.show tloc) (Format.pp_print_list pp_ttype) (List.map snd l); *)
+        (* TODO: @FissoreD (flemma) for compatibility modes are ignored. Consider them! *)
         let l = List.rev_map snd l in
         let t = List.fold_left (fun acc e -> TArr (e, acc)) (List.hd l) (List.tl l) in
-        (* Format.eprintf "The arrow type is %a\n%!" pp_ttype t; *)
         aux depth t
   in
   let term = aux tamap.nargs ttype in
@@ -2927,30 +2908,29 @@ let quote_syntax time new_state { WithMain.clauses; query; compiler_state } =
 let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype; tloc; tamap } ttime =
   let loc = tloc in
   let rec subst lvl (args: ttype array) = function
-    | TConst c when c >= 0 -> args.(c-lvl)
+    | TConst c when c >= 0 -> args.(c)
     | TConst _ | TCData _ as t -> t
-    | TLam t -> subst (lvl+1) args t
+    | TLam t -> error ~loc "lambdas should be fully applied"
     | TArr (a, b) -> TArr (subst lvl args a, subst lvl args b)
     | TPred (f, l) -> TPred (f, List.map (fun (a,b) -> a, subst lvl args b) l)
     | TApp (a, b, c) -> TApp (a, subst lvl args b, List.map (subst lvl args) c)
   in
-  let rec beta lvl (eaten: ttype list) t args =
-    match t, args with
-    | TLam t', x::xs -> beta (lvl+1) (x::eaten) t' xs
+  let beta t args =
+    let rec aux lvl t xs = 
+    match t, xs with
+    | TLam t', x::xs -> aux (lvl+1) t' xs
     | t, [] -> 
-      (* Format.eprintf "Calling subst on %a\n%!" pp_ttype t; 
-      Format.eprintf "with args on %a\n%!" (Format.pp_print_list pp_ttype) eaten; 
-      Format.eprintf "depth is %d\n%!" lvl; *)
-      subst 0 (Array.of_list eaten) t
-    | _, _::_ -> error ~loc "higher-order types do not exist"
+      subst 0 (Array.of_list args) t
+    | _, _::_ -> error ~loc "higher-order types do not exist" in
+    aux 0 t args
   in
-  (* Format.eprintf "Going to unfold %a\n%!" (pp_ttype) ttype;  *)
   let error_undefined ~t1 ~t2 c (tavalue: pretype) =
     if is_typeabbrev && t1 <= t2 then
       error (Format.asprintf "typeabbrev %a uses the undefined %s constant at %a" pp_ttype tavalue.ttype (Symbols.show compiler_state c) Util.Loc.pp tavalue.tloc);
   in
   let find_opt c = C.Map.find_opt c type_abbrevs in
-  let rec aux seen = function
+
+  (* Format.eprintf "Going to unfold %a\n%!" (pp_ttype) ttype;  *)  let rec aux seen = function
     | TConst c as x ->
         begin match find_opt c with
         | Some { tavalue; taparams; timestamp=time } ->
@@ -2976,7 +2956,7 @@ let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype;
           Format.eprintf "lcs is %d\n%!" lcs;
           Format.eprintf "Args are [%a]\n%!" (Format.pp_print_list pp_ttype) (t::ts); *)
           error_undefined ttime time c tavalue;
-          aux time (beta 0 [] tavalue.ttype (t::ts))
+          aux time (beta tavalue.ttype (t::ts))
           (* aux (C.Set.add c seen) (R.deref_appuv ~from:lcs ~to_:lcs (t::ts) tavalue.term) *)
         | None ->
           let t1 = aux seen t in
@@ -3034,12 +3014,12 @@ let static_check ~exec ~checker:(state,program)
         let ttypet = unfold_type_abbrevs ~is_typeabbrev:false ~compiler_state initial_depth type_abbrevs ttype 0 in
         (* Format.eprintf "Going to quote_pretype %a\n%!" pp_ttype ttypet.ttype; *)
         let state, ttypet = quote_pretype time ~compiler_state state ttypet in
-        (* Format.eprintf "Going to close_w_binder %a\n%!" pp_term ttypet; *)
         state, App(colonc,c, [close_w_binder forallc ttypet ttype.tamap])) state
       in
         state, l :: tl)
       types (state,[]) in
-  let tlist = List.concat (List.rev tlist) in  
+  let tlist = List.concat (List.rev tlist) in
+  
   (* Building functionality *)
   let state, functionality = C.Set.fold (fun tname (state,tl) ->
     let state, c = mkQCon time ~compiler_state state ~on_type:false tname in

From 75168f351efbdc79dd0238d2f0e9b5a52ca4cc71 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 12:48:49 +0200
Subject: [PATCH 26/32] [compiler] fix error + promote tests

---
 src/parser/ast.ml                | 12 -----
 src/parser/ast.mli               | 12 -----
 src/parser/grammar.mly           |  2 +-
 tests/sources/trace_chr.json     |  4 +-
 tests/sources/trace_findall.json |  4 +-
 tests/sources/trace_w.elab.json  | 80 ++++++++++++++++----------------
 tests/sources/trace_w.json       | 66 +++++++++++++-------------
 7 files changed, 78 insertions(+), 102 deletions(-)

diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index f0c288c10..0a3fddbe4 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -186,18 +186,6 @@ end
   
 end *)
 
-type raw_attribute =
-  | If of string
-  | Name of string
-  | After of string
-  | Before of string
-  | Replace of string
-  | Remove of string
-  | External
-  | Index of int list * string option
-  | Functional
-[@@deriving show]
-
 module Clause = struct
   
   type ('term,'attributes) t = {
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index 66843f80e..b6e08b8f3 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -113,18 +113,6 @@ end
   
 end *)
 
-type raw_attribute =
-  | If of string
-  | Name of string
-  | After of string
-  | Before of string
-  | Replace of string
-  | Remove of string
-  | External
-  | Index of int list * string option
-  | Functional
-[@@ deriving show]
-
 module Clause : sig
 
   type ('term,'attributes) t = {
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index aceb4c34f..8292b4808 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -223,7 +223,7 @@ typeabbrev:
 | TYPEABBREV; a = abbrevform; t = type_term {
     let name, args = a in
     let nparams = List.length args in
-    let mkLam n body =  TypeAbbreviation.Lam (n, body) in
+    let mkLam (n,_) body =  TypeAbbreviation.Lam (n, body) in
     let value = List.fold_right mkLam args (Ty t) in
     { TypeAbbreviation.name = name;
       nparams = nparams;
diff --git a/tests/sources/trace_chr.json b/tests/sources/trace_chr.json
index 05edfb24d..fb2c55be7 100644
--- a/tests/sources/trace_chr.json
+++ b/tests/sources/trace_chr.json
@@ -96,7 +96,7 @@
 {"step" : 13,"kind" : ["Info"],"goal_id" : 19,"runtime_id" : 0,"name" : "user:newgoal","payload" : ["even X1"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 18,"runtime_id" : 0,"name" : "user:rule:builtin","payload" : ["success"]}
 {"step" : 14,"kind" : ["Info"],"goal_id" : 19,"runtime_id" : 0,"name" : "user:CHR:try","payload" : ["File \"tests/sources/trace_chr.elpi\", line 1, column 21, characters 21-66:"," \\ (even A0) (odd A0) | (odd z) <=> (true)"]}
-{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--516 []"]}
+{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--518 []"]}
 {"step" : 0,"kind" : ["Info"],"goal_id" : 20,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["odd z"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 20,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["odd","odd z"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 20,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
@@ -104,7 +104,7 @@
 {"step" : 1,"kind" : ["Info"],"goal_id" : 20,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
 {"step" : 14,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 0,"name" : "user:CHR:rule-failed","payload" : []}
 {"step" : 14,"kind" : ["Info"],"goal_id" : 19,"runtime_id" : 0,"name" : "user:CHR:try","payload" : ["File \"tests/sources/trace_chr.elpi\", line 2, column 45, characters 67-116:"," \\ (even A0) (odd A0) | (odd (s z)) <=> (fail)"]}
-{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 2,"name" : "user:assign","payload" : ["A0 := uvar frozen--517 []"]}
+{"step" : 0,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 2,"name" : "user:assign","payload" : ["A0 := uvar frozen--519 []"]}
 {"step" : 0,"kind" : ["Info"],"goal_id" : 21,"runtime_id" : 2,"name" : "user:newgoal","payload" : ["odd (s z)"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 21,"runtime_id" : 2,"name" : "user:curgoal","payload" : ["odd","odd (s z)"]}
 {"step" : 1,"kind" : ["Info"],"goal_id" : 21,"runtime_id" : 2,"name" : "user:rule","payload" : ["backchain"]}
diff --git a/tests/sources/trace_findall.json b/tests/sources/trace_findall.json
index 0e114dad6..43c856382 100644
--- a/tests/sources/trace_findall.json
+++ b/tests/sources/trace_findall.json
@@ -10,8 +10,8 @@
 {"step" : 1,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:curgoal","payload" : ["std.findall","std.findall (p _) X0"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin_stdlib.elpi\", line 292, column 0, characters 9597-9633:"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:try","payload" : ["File \"builtin_stdlib.elpi\", line 292, column 0, characters 9597-9633:","(std.findall A0 A1) :- (findall_solutions A0 A1)."]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9708-9744:"]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:try","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9708-9744:","(std.findall A0 A1) :- (findall_solutions A0 A1)."]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 0,"name" : "user:assign","payload" : ["A0 := p _"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 0,"name" : "user:assign","payload" : ["A1 := X0"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:subgoal","payload" : ["7"]}
diff --git a/tests/sources/trace_w.elab.json b/tests/sources/trace_w.elab.json
index 2d87872ba..84ce05415 100644
--- a/tests/sources/trace_w.elab.json
+++ b/tests/sources/trace_w.elab.json
@@ -2429,9 +2429,9 @@
                                   "File",
                                   {
                                     "filename": "builtin.elpi",
-                                    "line": 506,
+                                    "line": 514,
                                     "column": 0,
-                                    "character": 12560
+                                    "character": 12754
                                   }
                                 ]
                               }
@@ -2466,9 +2466,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -2629,9 +2629,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -2761,9 +2761,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -2873,9 +2873,9 @@
                                   "File",
                                   {
                                     "filename": "builtin.elpi",
-                                    "line": 507,
+                                    "line": 515,
                                     "column": 0,
-                                    "character": 12581
+                                    "character": 12775
                                   }
                                 ]
                               }
@@ -2906,9 +2906,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 507,
+                                  "line": 515,
                                   "column": 0,
-                                  "character": 12581
+                                  "character": 12775
                                 }
                               ]
                             }
@@ -3035,9 +3035,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 507,
+                                  "line": 515,
                                   "column": 0,
-                                  "character": 12581
+                                  "character": 12775
                                 }
                               ]
                             }
@@ -3273,9 +3273,9 @@
                                   "File",
                                   {
                                     "filename": "builtin.elpi",
-                                    "line": 506,
+                                    "line": 514,
                                     "column": 0,
-                                    "character": 12560
+                                    "character": 12754
                                   }
                                 ]
                               }
@@ -3315,9 +3315,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -3478,9 +3478,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -3655,9 +3655,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -3796,9 +3796,9 @@
                               "File",
                               {
                                 "filename": "builtin.elpi",
-                                "line": 507,
+                                "line": 515,
                                 "column": 0,
-                                "character": 12581
+                                "character": 12775
                               }
                             ]
                           }
@@ -3846,9 +3846,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -4789,9 +4789,9 @@
                                   "File",
                                   {
                                     "filename": "builtin.elpi",
-                                    "line": 506,
+                                    "line": 514,
                                     "column": 0,
-                                    "character": 12560
+                                    "character": 12754
                                   }
                                 ]
                               }
@@ -4826,9 +4826,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -4951,9 +4951,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -5045,9 +5045,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 506,
+                                  "line": 514,
                                   "column": 0,
-                                  "character": 12560
+                                  "character": 12754
                                 }
                               ]
                             }
@@ -5119,9 +5119,9 @@
                                   "File",
                                   {
                                     "filename": "builtin.elpi",
-                                    "line": 507,
+                                    "line": 515,
                                     "column": 0,
-                                    "character": 12581
+                                    "character": 12775
                                   }
                                 ]
                               }
@@ -5145,9 +5145,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 507,
+                                  "line": 515,
                                   "column": 0,
-                                  "character": 12581
+                                  "character": 12775
                                 }
                               ]
                             }
@@ -5234,9 +5234,9 @@
                                 "File",
                                 {
                                   "filename": "builtin.elpi",
-                                  "line": 507,
+                                  "line": 515,
                                   "column": 0,
-                                  "character": 12581
+                                  "character": 12775
                                 }
                               ]
                             }
diff --git a/tests/sources/trace_w.json b/tests/sources/trace_w.json
index 611a454c1..3b71c14e8 100644
--- a/tests/sources/trace_w.json
+++ b/tests/sources/trace_w.json
@@ -158,7 +158,7 @@
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 105, column 0, characters 2609-2645:"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 105, column 0, characters 2609-2645:","(free-ty (mono A0) A1 A2) :- (free A0 A1 A2)."]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 [] ==> uvar frozen--539 []"]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 [] ==> uvar frozen--541 []"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X4"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 27,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["31"]}
@@ -168,8 +168,8 @@
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 117, column 0, characters 2995-3043:"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 117, column 0, characters 2995-3043:","(free (A0 ==> A1) A2 A3) :- (free A0 A2 A4), (free A1 A4 A3)."]}
-{"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
-{"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := uvar frozen--539 []"]}
+{"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
+{"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := uvar frozen--541 []"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := []"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := X4"]}
 {"step" : 3,"kind" : ["Info"],"goal_id" : 31,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["32"]}
@@ -181,7 +181,7 @@
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:","(free (as (uvar _ _) A0) A1 A2) :- (if (mem A1 A0) (A2 = A1) (A2 = [A0 | A1]))."]}
-{"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
+{"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X7"]}
 {"step" : 4,"kind" : ["Info"],"goal_id" : 32,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["34"]}
@@ -189,9 +189,9 @@
 {"step" : 4,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
-{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
-{"step" : 5,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
+{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","File \"builtin.elpi\", line 515, column 0, characters 12775-12788:"]}
+{"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","(if A0 A1 _) :- A0, (!), A1."]}
+{"step" : 5,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--541 [])"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X7 = []"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["35"]}
 {"step" : 5,"kind" : ["Info"],"goal_id" : 35,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
@@ -215,9 +215,9 @@
 {"step" : 7,"kind" : ["Info"],"goal_id" : 38,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X7 = []) (X7 = [uvar frozen--541 []])"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
-{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
-{"step" : 8,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := X7 = [uvar frozen--539 []]"]}
+{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 515, column 0, characters 12775-12788:"]}
+{"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 515, column 0, characters 12775-12788:","(if _ _ A0) :- A0."]}
+{"step" : 8,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := X7 = [uvar frozen--541 []]"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 34,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["39"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X7 = [uvar frozen--541 []]"]}
 {"step" : 8,"kind" : ["Info"],"goal_id" : 39,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
@@ -230,18 +230,18 @@
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 118, column 0, characters 3045-3108:","(free (as (uvar _ _) A0) A1 A2) :- (if (mem A1 A0) (A2 = A1) (A2 = [A0 | A1]))."]}
-{"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
-{"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := [uvar frozen--539 []]"]}
+{"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
+{"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := [uvar frozen--541 []]"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := X4"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 33,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["40"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])"]}
 {"step" : 10,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [uvar frozen--541 []] (uvar frozen--541 [])) \n (X4 = [uvar frozen--541 []]) \n (X4 = [uvar frozen--541 [], uvar frozen--541 []])"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [uvar frozen--539 []] (uvar frozen--539 [])"]}
-{"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X4 = [uvar frozen--539 []]"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","File \"builtin.elpi\", line 515, column 0, characters 12775-12788:"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","(if A0 A1 _) :- A0, (!), A1."]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [uvar frozen--541 []] (uvar frozen--541 [])"]}
+{"step" : 11,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X4 = [uvar frozen--541 []]"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 40,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["41"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [uvar frozen--541 []] (uvar frozen--541 [])"]}
 {"step" : 11,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["42"]}
@@ -253,8 +253,8 @@
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 148, column 0, characters 4000-4042:","(mem A0 (uvar A1 _)) :- (mem! A0 (uvar A1 A2))."]}
-{"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := [uvar frozen--539 []]"]}
-{"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--539"]}
+{"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := [uvar frozen--541 []]"]}
+{"step" : 12,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := frozen--541"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 41,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["44"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem! [uvar frozen--541 []] (uvar frozen--541 X9)"]}
 {"step" : 12,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
@@ -262,7 +262,7 @@
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 143, column 0, characters 3872-3889:","File \"tests/sources/trace-w/main.elpi\", line 144, column 0, characters 3891-3916:"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 143, column 0, characters 3872-3889:","(mem! [A0 | _] A0) :- (!)."]}
-{"step" : 13,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
+{"step" : 13,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X9 := []"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 44,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["45"]}
 {"step" : 13,"kind" : ["Info"],"goal_id" : 45,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["!"]}
@@ -273,7 +273,7 @@
 {"step" : 14,"kind" : ["Info"],"goal_id" : 45,"runtime_id" : 1,"name" : "user:rule:cut","payload" : ["success"]}
 {"step" : 15,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["!","!"]}
 {"step" : 15,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:rule","payload" : ["cut"]}
-{"step" : 15,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:rule:cut:branch","payload" : ["40","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
+{"step" : 15,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:rule:cut:branch","payload" : ["40","File \"builtin.elpi\", line 515, column 0, characters 12775-12788:","(if _ _ A0) :- A0."]}
 {"step" : 15,"kind" : ["Info"],"goal_id" : 42,"runtime_id" : 1,"name" : "user:rule:cut","payload" : ["success"]}
 {"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["=","X4 = [uvar frozen--541 []]"]}
 {"step" : 16,"kind" : ["Info"],"goal_id" : 43,"runtime_id" : 1,"name" : "user:rule","payload" : ["eq"]}
@@ -291,7 +291,7 @@
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 139, column 0, characters 3758-3806:","File \"tests/sources/trace-w/main.elpi\", line 140, column 0, characters 3808-3844:"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 29,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 139, column 0, characters 3758-3806:","(filter [A0 | A1] A2 [A0 | A3]) :- (A2 A0), (!), (filter A1 A2 A3)."]}
-{"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
+{"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := c0 \\\nnot (mem [] c0)"]}
 {"step" : 18,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X6 := [uvar frozen--541 [] | X10]"]}
@@ -306,7 +306,7 @@
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 54, column 0, characters 667-686:","File \"builtin.elpi\", line 56, column 0, characters 689-694:"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 54, column 0, characters 667-686:","(not A0) :- A0, (!), fail."]}
-{"step" : 19,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
+{"step" : 19,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--541 [])"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 46,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["49"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
 {"step" : 19,"kind" : ["Info"],"goal_id" : 49,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["50"]}
@@ -346,7 +346,7 @@
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 123, column 0, characters 3268-3389:"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 30,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 123, column 0, characters 3268-3389:","(bind [A0 | A1] A2 A3 (all A4 (c0 \\ (A5 c0)))) :- (if (mem A2 A0) (A4 = eqt) \n                                                    (A4 = any)), \n (pi (c0 \\ (copy A0 c0 => bind A1 A2 A3 (A5 c0))))."]}
-{"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
+{"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A2 := []"]}
 {"step" : 25,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A3 := uvar frozen--541 [] ==> uvar frozen--541 []"]}
@@ -358,9 +358,9 @@
 {"step" : 25,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
-{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 506, column 0, characters 12560-12579:","(if A0 A1 _) :- A0, (!), A1."]}
-{"step" : 26,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--539 [])"]}
+{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","File \"builtin.elpi\", line 515, column 0, characters 12775-12788:"]}
+{"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 514, column 0, characters 12754-12773:","(if A0 A1 _) :- A0, (!), A1."]}
+{"step" : 26,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := mem [] (uvar frozen--541 [])"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := X12 = eqt"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["55"]}
 {"step" : 26,"kind" : ["Info"],"goal_id" : 55,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["mem [] (uvar frozen--541 [])"]}
@@ -384,8 +384,8 @@
 {"step" : 28,"kind" : ["Info"],"goal_id" : 58,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["fail"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["if","if (mem [] (uvar frozen--541 [])) (X12 = eqt) (X12 = any)"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:"]}
-{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 507, column 0, characters 12581-12594:","(if _ _ A0) :- A0."]}
+{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin.elpi\", line 515, column 0, characters 12775-12788:"]}
+{"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"builtin.elpi\", line 515, column 0, characters 12775-12788:","(if _ _ A0) :- A0."]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := X12 = any"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 53,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["59"]}
 {"step" : 29,"kind" : ["Info"],"goal_id" : 59,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["X12 = any"]}
@@ -409,7 +409,7 @@
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 122, column 0, characters 3232-3266:"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 122, column 0, characters 3232-3266:","(bind [] _ A0 (mono A1)) :- (copy A0 A1)."]}
-{"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 [] ==> uvar frozen--539 []"]}
+{"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 [] ==> uvar frozen--541 []"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign:simplify:heap","payload" : ["X13 := c0 \\\nX15 c0"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X15^1 := mono X16^1"]}
 {"step" : 33,"kind" : ["Info"],"goal_id" : 61,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["62"]}
@@ -419,8 +419,8 @@
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 130, column 0, characters 3446-3496:"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"tests/sources/trace-w/main.elpi\", line 130, column 0, characters 3446-3496:","(copy (A0 ==> A1) (A2 ==> A3)) :- (copy A0 A2), (copy A1 A3)."]}
-{"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--539 []"]}
-{"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := uvar frozen--539 []"]}
+{"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A0 := uvar frozen--541 []"]}
+{"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["A1 := uvar frozen--541 []"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X16^1 := X17^1 ==> X18^1"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 62,"runtime_id" : 1,"name" : "user:subgoal","payload" : ["63"]}
 {"step" : 34,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:newgoal","payload" : ["copy (uvar frozen--541 []) X17^1"]}
@@ -430,13 +430,13 @@
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--541 []) X17^1"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","File \"tests/sources/trace-w/main.elpi\", line 133, column 0, characters 3590-3616:"]}
-{"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--539 []) c0) :- ."]}
+{"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--541 []) c0) :- ."]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X17^1 := c0"]}
 {"step" : 35,"kind" : ["Info"],"goal_id" : 63,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:curgoal","payload" : ["copy","copy (uvar frozen--541 []) X18^1"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule","payload" : ["backchain"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain:candidates","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","File \"tests/sources/trace-w/main.elpi\", line 133, column 0, characters 3590-3616:"]}
-{"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--539 []) c0) :- ."]}
+{"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain:try","payload" : ["File \"(context step_id:32)\", line 1, column 0, characters 0-0:","(copy (uvar frozen--541 []) c0) :- ."]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 1,"name" : "user:assign","payload" : ["X18^1 := c0"]}
 {"step" : 36,"kind" : ["Info"],"goal_id" : 64,"runtime_id" : 1,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 17,"kind" : ["Info"],"goal_id" : 25,"runtime_id" : 0,"name" : "user:subgoal","payload" : ["65"]}

From a01a6a3f71b0424c8a856959638f9d0ffefc938f Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 13:17:26 +0200
Subject: [PATCH 27/32] [compiler] remove constructor Mode from Program module

---
 src/compiler.ml    | 14 ++++++--------
 src/parser/ast.ml  |  1 -
 src/parser/ast.mli |  1 -
 3 files changed, 6 insertions(+), 10 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index 9163c08b7..47cac5d2f 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -830,18 +830,16 @@ end = struct (* {{{ *)
       | Program.Macro m :: rest ->
           aux_run ns blocks clauses (m::macros) types tabbrs modes functionality locals chr accs rest
       | Program.Pred t :: rest ->
-          aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
-            (Program.Mode [t] :: Program.Type [t] :: rest)
-      | Program.Mode ms :: rest ->
-          let t = List.map structure_type_attributes ms in
-          aux_run ns blocks clauses macros types tabbrs (t @ modes) functionality locals chr accs rest
+          let t = structure_type_attributes t in
+          let types = if t.attributes <> Functional && List.mem t types then types else t :: types in
+          let functionality = if t.attributes = Functional then t.name :: functionality else functionality in
+          aux_run ns blocks clauses macros types tabbrs (t::modes) functionality locals chr accs rest
       | Program.Type [] :: rest ->
           aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs rest
       | Program.Type (t::ts) :: rest ->          
           let t = structure_type_attributes t in
-          (* Format.sprintf "Going to rec call aux with %s" (Ast.Type.pp (fun f x -> Ast.Structured.pp_tattribute f (List.hd x))) t |> print_endline; *)
-          let types = if t.attributes <> Functional && List.mem t types then types else t :: types in
-          let functionality = if t.attributes = Functional then t.name :: functionality else functionality in
+          if t.attributes = Functional then error ~loc:t.loc "functional attribute only applies to pred";
+          let types = if List.mem t types then types else t :: types in
           aux_run ns blocks clauses macros types tabbrs modes functionality locals chr accs
             (Program.Type ts :: rest)
       | Program.TypeAbbreviation abbr :: rest ->
diff --git a/src/parser/ast.ml b/src/parser/ast.ml
index 0a3fddbe4..363f264fa 100644
--- a/src/parser/ast.ml
+++ b/src/parser/ast.ml
@@ -267,7 +267,6 @@ module Program = struct
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
     (* TODO: to remove *)
-    | Mode of raw_attribute list Type.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list
diff --git a/src/parser/ast.mli b/src/parser/ast.mli
index b6e08b8f3..3f196f44a 100644
--- a/src/parser/ast.mli
+++ b/src/parser/ast.mli
@@ -189,7 +189,6 @@ module Program : sig
     (* data *)
     | Clause of (Term.t, raw_attribute list) Clause.t
     | Local of Func.t list
-    | Mode of raw_attribute list Type.t list
     | Chr of raw_attribute list Chr.t
     | Macro of (Func.t, Term.t) Macro.t
     | Type of raw_attribute list Type.t list

From 6a4d16d23053aa184c773a6b7296eb42456cca94 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 13:33:48 +0200
Subject: [PATCH 28/32] [compiler] update CHANGES.md

---
 CHANGES.md | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index c7c0fa133..882a8bf2c 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,26 @@
+# Unreleased
+
+Requires Menhir 20211230 and OCaml 4.08 or above.
+
+- Compiler:
+  - New syntax: anonymous predicates can be passed to type signatures in order
+    to have more information about modes and attributes of higher-order
+    arguments, eg: `pred p i:(pred i:A, o:B)` tells that the first argument of
+    `p` is a predicate whose first argument is in input and the second in
+    output.
+  - Separated terms from types; the parser generates 
+    - `TypeExpression.t` objects for `pred` and `type` objects
+    - `TypeAbbreviation.closedTypeexpression` objects for `typeabbrev`, that is
+       the `TypeExpression.t` type decorated with the `TLam` constructor
+  - The attribute `:functional` can be passed to predicates (not types),
+    for example, `:functional pred q i:int, o:int` tells the interpreter that `q` is
+    a predicate meant to be functional. Note that, due to anonymous predicates,
+    the `:functional` attributes can be passed to higher-order arguments
+  - The piece of information likes modes and functionality is transmitted to the
+    checker (currently this information is not taken into account) 
+
+    
+
 # v1.20.0 (September 2024)
 
 Requires Menhir 20211230 and OCaml 4.08 or above.

From b9f966883727d7fa7f99689ccb1cc04fbc0fe12c Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 16:11:42 +0200
Subject: [PATCH 29/32] [compiler] bug correction std.do! [CL=[];print-list
 {std.map CL p}]

---
 src/compiler.ml                  | 48 +++++++++++++++++---------------
 src/parser/grammar.mly           | 13 +++++++--
 src/parser/lexer.mll.in          |  2 +-
 src/parser/test_lexer.ml         |  1 +
 src/parser/tokens.mly            |  1 +
 tests/sources/spill_in_list.elpi | 10 +++++++
 tests/suite/elpi_specific.ml     |  5 ++++
 7 files changed, 54 insertions(+), 26 deletions(-)
 create mode 100644 tests/sources/spill_in_list.elpi

diff --git a/src/compiler.ml b/src/compiler.ml
index 47cac5d2f..d09ed1ed8 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -1428,9 +1428,7 @@ let query_preterm_of_ast ~depth macros state (loc, t) =
   and to_mode_rec = function
     | Ast.TypeExpression.TConst _ | TCData _ -> []
     | TArr (a,b) -> []
-    | TPred (_, m) ->
-        let m = List.rev m |> List.tl |> List.rev in
-        to_mode_rec_aux m
+    | TPred (_, m) -> to_mode_rec_aux m
     | TApp (a,b,l) -> []
 
   let compile_mode (state, modes) { Ast.Type.name; ty; loc } =
@@ -1921,23 +1919,27 @@ module Spill : sig
 
 end = struct (* {{{ *)
 
+  type typespill =
+    | Variadic of typespill * typespill 
+    | Arrow of typespill list * typespill | Prop | Unknown
+    [@@deriving show]
+
   let rec read_ty = function
-    | TApp(c,x,[y]) when c == D.Global_symbols.variadic -> `Variadic (read_ty x,read_ty y)
+    | TApp(c,x,[y]) when c == D.Global_symbols.variadic -> Variadic (read_ty x,read_ty y)
     | TArr(x,y) -> 
         let ty_x = read_ty x in
         begin match read_ty y with
-        | `Arrow(tys,ty) -> `Arrow (ty_x :: tys, ty)
-        | ty -> `Arrow([ty_x], ty) end
-    | TConst x when x == D.Global_symbols.propc -> `Prop
-    | TPred (_, l) -> `Arrow (List.map (fun (_, t) -> read_ty t) l, `Prop)
-    | _ -> `Unknown
+        | Arrow(tys,ty) -> Arrow (ty_x :: tys, ty)
+        | ty -> Arrow([ty_x], ty) end
+    | TConst x when x == D.Global_symbols.propc -> Prop
+    | TPred (_, l) -> Arrow (List.map (fun (_, t) -> read_ty t) l, Prop)
+    | _ -> Unknown
 
-  let type_of_const types c =
+  let type_of_const ~state types c =
     try
       let { Types.decl = { ttype } } = (C.Map.find c types).Types.def in
       read_ty ttype.ttype
-    with
-      Not_found -> `Unknown
+    with Not_found -> Unknown
 
   let missing_args_of state loc modes types t =
     let c, args =
@@ -1951,15 +1953,15 @@ end = struct (* {{{ *)
         | _ -> error ~loc "Only applications can be spilled"
       in
         aux_mia t in
-    let ty = type_of_const types c in
+    let ty = type_of_const state types c in
     let ty_mode, mode =
       match modes c with
-      | l -> `Arrow(List.length l,`Prop), l
+      | l -> `Arrow(List.length l,Prop), l
       | exception Not_found -> `Unknown, [] in
     let nargs = List.length args in
     let missing_args =
       match ty_mode, ty with
-      | `Unknown,`Arrow(args,_) -> List.length args - nargs
+      | `Unknown,Arrow(args,_) -> List.length args - nargs
       | `Arrow(arity,_),_ ->
           let missing = arity - nargs in
           let output_suffix =
@@ -2092,19 +2094,19 @@ end = struct (* {{{ *)
          let spills, args, is_prop =
            let (@@@) (s1,a1) (s2,a2,b) = s1 @ s2, a1 @ a2, b in
            let rec aux_spaux ty args = match ty, args with
-             | (`Variadic(_,`Prop) | `Arrow([],`Prop)), [] -> [],[],true
+             | (Variadic(_,Prop) | Arrow([],Prop)), [] -> [],[],true
              | _, [] -> [],[],false
-             | `Variadic(`Prop,_), a1 :: an ->
+             | Variadic(Prop,_), a1 :: an ->
                    ([],spaux1_prop ctx a1) @@@ aux_spaux ty an
-             | `Arrow(`Prop :: ty,c), a1 :: an ->
-                   ([],spaux1_prop ctx a1) @@@ aux_spaux (`Arrow(ty,c)) an
-             | `Arrow((_ :: _ as ty),c), a1 :: an ->
+             | Arrow(Prop :: ty,c), a1 :: an ->
+                   ([],spaux1_prop ctx a1) @@@ aux_spaux (Arrow(ty,c)) an
+             | Arrow((_ :: _ as ty),c), a1 :: an ->
                    let spills, a1 = spaux ctx a1 in
                    let ty = drop (size_outermost_spill spills ~default:1) ty in
-                   (spills, a1) @@@ aux_spaux (`Arrow(ty,c)) an
+                   (spills, a1) @@@ aux_spaux (Arrow(ty,c)) an
              | _, a1 :: an -> spaux ctx a1 @@@ aux_spaux ty an
            in
-             aux_spaux (type_of_const types hd) args in
+             aux_spaux (type_of_const !state types hd) args in
          if is_prop then [], [add_spilled spills (mkAppC hd args)]
          else spills, [mkAppC hd args]
       | (CData _ | Const _ | Discard | Nil) as x -> [],[x]
@@ -2849,7 +2851,7 @@ let quote_pretype time ~compiler_state new_state { tloc; ttype; tamap } =
     | TPred (f, l) -> 
         (* TODO: @FissoreD (flemma) for compatibility modes are ignored. Consider them! *)
         let l = List.rev_map snd l in
-        let t = List.fold_left (fun acc e -> TArr (e, acc)) (List.hd l) (List.tl l) in
+        let t = List.fold_left (fun acc e -> TArr (e, acc)) (TConst D.Global_symbols.propc) l in
         aux depth t
   in
   let term = aux tamap.nargs ttype in
diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 8292b4808..6aa760939 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -135,6 +135,7 @@ decl:
 | p = pred; FULLSTOP { Program.Pred p }
 | t = type_; FULLSTOP { Program.Type t }
 | t = kind; FULLSTOP { Program.Type t }
+| m = mode; FULLSTOP {  raise (ParseError(loc $loc,"mode is no more supported")) }
 | m = macro; FULLSTOP { Program.Macro m }
 | CONSTRAINT; hyps = list(constant); QDASH; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, hyps, cl) }
 | CONSTRAINT; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, [], cl) }
@@ -154,6 +155,13 @@ decl:
 | ignored; FULLSTOP { Program.Ignored (loc $sloc) }
 | f = fixity; FULLSTOP { error_mixfix (loc $loc) }
 
+mode:
+| MODE; LPAREN; c = constant; l = nonempty_list(i_o); RPAREN {
+    ()
+}
+i_o:
+| io = IO { mode_of_IO io }
+
 accumulate:
 | ACCUMULATE { ".elpi" }
 | IMPORT { ".mod" }
@@ -176,14 +184,14 @@ chr_rule:
 pred:
 | attributes = attributes; PRED;
   name = constant; args = separated_list(option(CONJ),pred_item) {
-   { Type.loc=loc $sloc; name; attributes; ty = TPred ([], args @ [mode_of_IO 'o', TConst (Func.from_string "prop")]) }
+   { Type.loc=loc $sloc; name; attributes; ty = TPred ([], args) }
  }
 pred_item:
 | io = IO_COLON; ty = type_term { (mode_of_IO io,ty) }
 
 anonymous_pred:
 | attributes = attributes; PRED;
-  args = separated_list(option(CONJ),pred_item) { TPred (attributes, args @ [mode_of_IO 'o', TConst (Func.from_string "prop")]) }
+  args = separated_list(option(CONJ),pred_item) { TPred (attributes, args) }
 
 kind:
 | KIND; names = separated_nonempty_list(CONJ,constant); k = kind_term {
@@ -409,6 +417,7 @@ constant:
 | REPLACE { Func.from_string "replace" }
 | REMOVE { Func.from_string "remove" }
 | INDEX { Func.from_string "index" }
+| MODE { Func.from_string "mode" }
 | c = IO { Func.from_string @@ String.make 1 c }
 | CUT { Func.cutf }
 | PI { Func.pif }
diff --git a/src/parser/lexer.mll.in b/src/parser/lexer.mll.in
index f1898a343..5aadb5b5c 100644
--- a/src/parser/lexer.mll.in
+++ b/src/parser/lexer.mll.in
@@ -145,7 +145,7 @@ and token = parse
 | "accumulate" { ACCUMULATE }
 | "local" { LOCAL }
 | "pred" { PRED }
-| "mode" { failwith "Mode is a no more maintained keyword" }
+| "mode" { MODE }
 | "macro" { MACRO }
 | "rule" { RULE }
 | "namespace" { NAMESPACE }
diff --git a/src/parser/test_lexer.ml b/src/parser/test_lexer.ml
index aad498a09..742473e51 100644
--- a/src/parser/test_lexer.ml
+++ b/src/parser/test_lexer.ml
@@ -28,6 +28,7 @@ type t = Tokens.token =
   | NAMESPACE
   | NAME
   | MODULE
+  | MODE
   | MOD
   | MINUSs
   | MINUSr
diff --git a/src/parser/tokens.mly b/src/parser/tokens.mly
index 77f98fc8f..1ba23ff4b 100644
--- a/src/parser/tokens.mly
+++ b/src/parser/tokens.mly
@@ -33,6 +33,7 @@
 %token MINUSr
 %token MINUSi
 %token MINUSs
+%token MODE
 %token MACRO
 %token RULE
 %token NAMESPACE
diff --git a/tests/sources/spill_in_list.elpi b/tests/sources/spill_in_list.elpi
new file mode 100644
index 000000000..3cfaf38ad
--- /dev/null
+++ b/tests/sources/spill_in_list.elpi
@@ -0,0 +1,10 @@
+pred p o:A, o:A.
+
+pred print-list i:A.
+print-list X :- print X.
+
+main :- 
+  std.do! [
+    CL = [],
+    print-list {std.map CL p},
+  ].
\ No newline at end of file
diff --git a/tests/suite/elpi_specific.ml b/tests/suite/elpi_specific.ml
index a8657ad32..393c91efe 100644
--- a/tests/suite/elpi_specific.ml
+++ b/tests/suite/elpi_specific.ml
@@ -150,6 +150,11 @@ let () = declare "spilling_or"
   ~description:"spilling prem order"
   ()
 
+let () = declare "spilling_in_list"
+  ~source_elpi:"spill_in_list.elpi"
+  ~description:"spilling prem order"
+  ()
+
 let () = declare "block"
   ~source_elpi:"block.elpi"
   ~description:"blocks are closed"

From 58f9520fe1873ac6f538a005b26e0ce219d8fd71 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Mon, 7 Oct 2024 16:45:02 +0200
Subject: [PATCH 30/32] [compiler] remove mode token

---
 src/parser/grammar.mly       | 9 ---------
 src/parser/lexer.mll.in      | 1 -
 src/parser/test_lexer.ml     | 1 -
 src/parser/tokens.mly        | 1 -
 tests/suite/elpi_specific.ml | 3 ++-
 5 files changed, 2 insertions(+), 13 deletions(-)

diff --git a/src/parser/grammar.mly b/src/parser/grammar.mly
index 6aa760939..cf34d2783 100644
--- a/src/parser/grammar.mly
+++ b/src/parser/grammar.mly
@@ -135,7 +135,6 @@ decl:
 | p = pred; FULLSTOP { Program.Pred p }
 | t = type_; FULLSTOP { Program.Type t }
 | t = kind; FULLSTOP { Program.Type t }
-| m = mode; FULLSTOP {  raise (ParseError(loc $loc,"mode is no more supported")) }
 | m = macro; FULLSTOP { Program.Macro m }
 | CONSTRAINT; hyps = list(constant); QDASH; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, hyps, cl) }
 | CONSTRAINT; cl = list(constant); LCURLY { Program.Constraint(loc $sloc, [], cl) }
@@ -155,13 +154,6 @@ decl:
 | ignored; FULLSTOP { Program.Ignored (loc $sloc) }
 | f = fixity; FULLSTOP { error_mixfix (loc $loc) }
 
-mode:
-| MODE; LPAREN; c = constant; l = nonempty_list(i_o); RPAREN {
-    ()
-}
-i_o:
-| io = IO { mode_of_IO io }
-
 accumulate:
 | ACCUMULATE { ".elpi" }
 | IMPORT { ".mod" }
@@ -417,7 +409,6 @@ constant:
 | REPLACE { Func.from_string "replace" }
 | REMOVE { Func.from_string "remove" }
 | INDEX { Func.from_string "index" }
-| MODE { Func.from_string "mode" }
 | c = IO { Func.from_string @@ String.make 1 c }
 | CUT { Func.cutf }
 | PI { Func.pif }
diff --git a/src/parser/lexer.mll.in b/src/parser/lexer.mll.in
index 5aadb5b5c..273de2362 100644
--- a/src/parser/lexer.mll.in
+++ b/src/parser/lexer.mll.in
@@ -145,7 +145,6 @@ and token = parse
 | "accumulate" { ACCUMULATE }
 | "local" { LOCAL }
 | "pred" { PRED }
-| "mode" { MODE }
 | "macro" { MACRO }
 | "rule" { RULE }
 | "namespace" { NAMESPACE }
diff --git a/src/parser/test_lexer.ml b/src/parser/test_lexer.ml
index 742473e51..aad498a09 100644
--- a/src/parser/test_lexer.ml
+++ b/src/parser/test_lexer.ml
@@ -28,7 +28,6 @@ type t = Tokens.token =
   | NAMESPACE
   | NAME
   | MODULE
-  | MODE
   | MOD
   | MINUSs
   | MINUSr
diff --git a/src/parser/tokens.mly b/src/parser/tokens.mly
index 1ba23ff4b..77f98fc8f 100644
--- a/src/parser/tokens.mly
+++ b/src/parser/tokens.mly
@@ -33,7 +33,6 @@
 %token MINUSr
 %token MINUSi
 %token MINUSs
-%token MODE
 %token MACRO
 %token RULE
 %token NAMESPACE
diff --git a/tests/suite/elpi_specific.ml b/tests/suite/elpi_specific.ml
index 393c91efe..e24b0ea13 100644
--- a/tests/suite/elpi_specific.ml
+++ b/tests/suite/elpi_specific.ml
@@ -170,7 +170,8 @@ let () = declare "elpi_only_llam"
 let () = declare "hollight"
   ~source_elpi:"hollight.elpi"
   ~description:"hollight implementation"
-  ~expectation:Test.(FailureOutput (Str.regexp "Mode is a no more maintained keyword")) (* needs advanced modes *)
+  (* ~expectation:Test.(FailureOutput (Str.regexp "Mode is a no more maintained keyword")) needs advanced modes *)
+  ~expectation:Test.Failure
   ()
 let () = declare "hollight_legacy"
   ~source_elpi:"hollight_legacy.elpi"

From 3a7367f4533551e7402017ffee1a51a5217812c9 Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 8 Oct 2024 11:02:54 +0200
Subject: [PATCH 31/32] [compiler] remove functionality from type program + use
 pred in ho arguments

---
 src/builtin.elpi                      | 76 ++++++++++++-------------
 src/builtin_map.elpi                  | 16 +++---
 src/builtin_set.elpi                  | 16 +++---
 src/builtin_stdlib.elpi               | 44 +++++++-------
 src/compiler.ml                       | 82 +++++++++++----------------
 tests/sources/trace_findall.elab.json |  6 +-
 tests/sources/trace_findall.json      |  4 +-
 tests/test.real.ml                    | 33 ++++++-----
 8 files changed, 133 insertions(+), 144 deletions(-)

diff --git a/src/builtin.elpi b/src/builtin.elpi
index 371c0fc23..4c243cefa 100644
--- a/src/builtin.elpi
+++ b/src/builtin.elpi
@@ -573,7 +573,7 @@ assert! Cond Msg :- (Cond ; fatal-error-w-data Msg Cond), !.
 
 % [assert-ok! C M] like assert! but the last argument of the predicate must
 % be a diagnostic that is printed after M in case it is not ok
-pred assert-ok! i:(diagnostic -> prop), i:string.
+pred assert-ok! i:(pred o:diagnostic), i:string.
 assert-ok! Cond Msg :- Cond Diagnostic, !, (Diagnostic = ok ; Diagnostic = error S, fatal-error-w-data Msg S), !.
 assert-ok! _ Msg :- fatal-error-w-data Msg "no diagnostic returned".
 
@@ -648,59 +648,59 @@ split-at 0 L [] L :- !.
 split-at N [X|XS] [X|LN] LM :- !, N1 is N - 1, split-at N1 XS LN LM.
 split-at _ _ _ _ :- fatal-error "split-at run out of list items".
 
-pred fold i:list B, i:A, i:(B -> A -> A -> prop), o:A.
+pred fold i:list B, i:A, i:(pred i:B, i:A, o:A), o:A.
 fold [] A _ A.
 fold [X|XS] A F R :- F X A A1, fold XS A1 F R.
 
-pred fold-right i:list B, i:A, i:(B -> A -> A -> prop), o:A.
+pred fold-right i:list B, i:A, i:(pred i:B, i:A, o:A), o:A.
 fold-right [] A _ A.
 fold-right [X|XS] A F R :- fold-right XS A F A', F X A' R.
 
-pred fold2 i:list C, i:list B, i:A, i:(C -> B -> A -> A -> prop), o:A.
+pred fold2 i:list C, i:list B, i:A, i:(pred i:C, i:B, i:A, o:A), o:A.
 fold2 [] [_|_] _ _ _ :- fatal-error "fold2 on lists of different length".
 fold2 [_|_] [] _ _ _ :- fatal-error "fold2 on lists of different length".
 fold2 [] [] A _ A.
 fold2 [X|XS] [Y|YS] A F R :- F X Y A A1, fold2 XS YS A1 F R.
 
-pred map i:list A, i:(A -> B -> prop), o:list B.
+pred map i:list A, i:(pred i:A, o:B), o:list B.
 map [] _ [].
 map [X|XS] F [Y|YS] :- F X Y, map XS F YS.
 
-pred map-i i:list A, i:(int -> A -> B -> prop), o:list B.
+pred map-i i:list A, i:(pred i:int, i:A, o:B), o:list B.
 map-i L F R :- map-i.aux L 0 F R.
 
-pred map-i.aux i:list A, i:int, i:(int -> A -> B -> prop), o:list B.
+pred map-i.aux i:list A, i:int, i:(pred i:int, i:A, o:B), o:list B.
 map-i.aux [] _ _ [].
 map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS.
 
-pred map-filter i:list A, i:(A -> B -> prop), o:list B.
+pred map-filter i:list A, i:(pred i:A, o:B), o:list B.
 map-filter [] _ [].
 map-filter [X|XS] F [Y|YS] :- F X Y, !, map-filter XS F YS.
 map-filter [_|XS] F YS :- map-filter XS F YS.
 
 :index(1 1)
-pred map2 i:list A, i:list B, i:(A -> B -> C -> prop), o:list C.
+pred map2 i:list A, i:list B, i:(pred i:A, i:B, o:C), o:list C.
 map2 [] [_|_] _ _ :- fatal-error "map2 on lists of different length".
 map2 [_|_] [] _ _ :- fatal-error "map2 on lists of different length".
 map2 [] [] _ [].
 map2 [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, map2 XS YS F ZS.
 
-pred map2-filter i:list A, i:list B, i:(A -> B -> C -> prop), o:list C.
+pred map2-filter i:list A, i:list B, i:(pred i:A, i:B, o:C), o:list C.
 map2-filter [] [_|_] _ _ :- fatal-error "map2-filter on lists of different length".
 map2-filter [_|_] [] _ _ :- fatal-error "map2-filter on lists of different length".
 map2-filter [] [] _ [].
 map2-filter [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, !, map2-filter XS YS F ZS.
 map2-filter [_|XS] [_|YS] F ZS :- map2-filter XS YS F ZS.
 
-pred map-ok i:list A, i:(A -> B -> diagnostic -> prop), o:list A, o:diagnostic.
+pred map-ok i:list A, i:(pred i:A, i:B, o:diagnostic), o:list A, o:diagnostic.
 map-ok [X|L] P [Y|YS] S :- P X Y S0, if (S0 = ok) (map-ok L P YS S) (S = S0).
 map-ok [] _ [] ok.
 
-pred fold-map i:list A, i:B, i:(A -> B -> C -> B -> prop), o:list C, o:B.
+pred fold-map i:list A, i:B, i:(pred i:A, i:B, o:C, o:B), o:list C, o:B.
 fold-map [] A _ [] A.
 fold-map [X|XS] A F [Y|YS] A2 :- F X A Y A1, fold-map XS A1 F YS A2.
 
-pred omap i:option A, i:(A -> B -> prop), o:option B.
+pred omap i:option A, i:(pred i:A, o:B), o:option B.
 omap none _ none.
 omap (some X) F (some Y) :- F X Y.
 
@@ -731,31 +731,31 @@ pred mem i:list A, o:A.
 mem [X|_] X.
 mem [_|L] X :- mem L X.
 
-pred exists i:list A, i:(A -> prop).
+pred exists i:list A, i:(pred i:A).
 exists [X|_] P :- P X.
 exists [_|L] P :- exists L P.
 
-pred exists2 i:list A, i:list B, i:(A -> B -> prop).
+pred exists2 i:list A, i:list B, i:(pred i:A, i:B).
 exists2 [] [_|_] _ :- fatal-error "exists2 on lists of different length".
 exists2 [_|_] [] _ :- fatal-error "exists2 on lists of different length".
 exists2 [X|_] [Y|_] P :- P X Y.
 exists2 [_|L] [_|M] P :- exists2 L M P.
 
-pred forall i:list A, i:(A -> prop).
+pred forall i:list A, i:(pred i:A).
 forall [] _.
 forall [X|L] P :- P X, forall L P.
 
-pred forall-ok i:list A, i:(A -> diagnostic -> prop), o:diagnostic.
+pred forall-ok i:list A, i:(pred i:A, o:diagnostic), o:diagnostic.
 forall-ok [X|L] P S :- P X S0, if (S0 = ok) (forall-ok L P S) (S = S0).
 forall-ok [] _ ok.
 
-pred forall2 i:list A, i:list B, i:(A -> B -> prop).
+pred forall2 i:list A, i:list B, i:(pred i:A, i:B).
 forall2 [] [_|_] _ :- fatal-error "forall2 on lists of different length".
 forall2 [_|_] [] _ :- fatal-error "forall2 on lists of different length".
 forall2 [X|XS] [Y|YS] P :- P X Y, forall2 XS YS P.
 forall2 [] [] _.
 
-pred filter i:list A, i:(A -> prop), o:list A.
+pred filter i:list A, i:(pred i:A), o:list A.
 filter []    _ [].
 filter [X|L] P R :- if (P X) (R = X :: L1) (R = L1), filter L P L1.
 
@@ -792,7 +792,7 @@ intersperse Sep [X|XS] [X,Sep|YS] :- intersperse Sep XS YS.
 
 %  -- Misc --
 
-pred flip i:(A -> B -> prop), i:B, i:A.
+pred flip i:(pred i:A, i:B), i:B, i:A.
 flip P X Y :- P Y X.
 
 pred time i:prop, o:float.
@@ -803,7 +803,7 @@ do! [].
 do! [P|PS] :- P, !, do! PS.
 
 :index(_ 1)
-pred do-ok! o:diagnostic, i:list (diagnostic -> prop).
+pred do-ok! o:diagnostic, i:list (pred o:diagnostic).
 do-ok! ok [].
 do-ok! S [P|PS] :- P S0, !, if (S0 = ok) (do-ok! S PS) (S = S0).
 
@@ -813,7 +813,7 @@ lift-ok P Msg R :- (P, R = ok; R = error Msg).
 pred spy-do! i:list prop.
 spy-do! L :- map L (x\y\y = spy x) L1, do! L1.
 
-pred while-ok-do! i:diagnostic, i:list (diagnostic -> prop), o:diagnostic.
+pred while-ok-do! i:diagnostic, i:list (pred o:diagnostic), o:diagnostic.
 while-ok-do! (error _ as E) _ E.
 while-ok-do! ok [] ok.
 while-ok-do! ok [P|PS] R :- P C, !, while-ok-do! C PS R.
@@ -1142,12 +1142,12 @@ external pred std.loc.set.partition i:std.loc.set, i:loc -> prop,
 
 #line 0 "builtin_map.elpi"
 kind std.map type -> type -> type.
-type std.map std.map.private.map K V -> (K -> K -> cmp -> prop) -> std.map K V.
+type std.map std.map.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map K V.
 
 namespace std.map {
 
 % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(K -> K -> cmp -> prop), o:std.map K V.
+pred make i:(pred i:K, i:K, o:cmp), o:std.map K V.
 make Cmp (std.map private.empty Cmp).
 
 % [find K M V] looks in M for the value V associated to K
@@ -1203,19 +1203,19 @@ bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
   create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
 bal.aux _ _ _ _ L K V R T :- create L K V R T.
 
-pred add i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
+pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
 add empty _ K V T :- create empty K V empty T.
 add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1.
 
-pred add.aux i:cmp, i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
+pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
 add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H. 
 add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T.
 add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T.
 
-pred find i:map K V, i:(K -> K -> cmp -> prop), i:K, o:V.
+pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
 find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V.
 
-pred find.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, o:V.
+pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
 find.aux eq _   _ _ V _ V.
 find.aux lt Cmp L _ _ K V :- find L Cmp K V.
 find.aux gt Cmp _ R _ K V :- find R Cmp K V.
@@ -1235,11 +1235,11 @@ merge M1 M2 R :-
   min-binding M2 X D,
   bal M1 X D {remove-min-binding M2} R.
 
-pred remove i:map K V, i:(K -> K -> cmp -> prop), i:K, o:map K V.
+pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
 remove empty _ _ empty :- !.
 remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
 
-pred remove.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
+pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
 remove.aux eq _   L R _ _ _ M :- merge L R M.
 remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
 remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
@@ -1256,12 +1256,12 @@ bindings (node L V D R _) X X1 :-
 
 #line 0 "builtin_set.elpi"
 kind std.set type -> type.
-type std.set std.set.private.set E -> (E -> E -> cmp -> prop) -> std.set E.
+type std.set std.set.private.set E -> (pred i:E, i:E, o:cmp) -> std.set E.
 
 namespace std.set {
 
 % [make Eq Ltn M] builds an empty set M where keys are compared using Eq and Ltn
-pred make i:(E -> E -> cmp -> prop), o:std.set E.
+pred make i:(pred i:E, i:E, o:cmp), o:std.set E.
 make Cmp (std.set private.empty Cmp).
 
 % [mem E M] looks if E is in M
@@ -1320,20 +1320,20 @@ bal.aux _ HR HL2 _ L X (node (node RLL RLV RLR _) RV RR _) T :-
   create {create L X RLL} RLV {create RLR RV RR} T.
 bal.aux _ _ _ _ L E R T :- create L E R T.
 
-pred add i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
+pred add i:set E, i:(pred i:E, i:E, o:cmp), i:E, o:set E.
 add empty _ E T :- create empty E empty T.
 add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S.
 
-pred add.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, i:int, o:set E.
+pred add.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E, i:E, i:int, o:set E.
 add.aux eq _   L R X _ H (node L X R H).
 add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T.
 add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T.
 
-pred mem i:set E, i:(E -> E -> cmp -> prop), i:E.
+pred mem i:set E, i:(pred i:E, i:E, o:cmp), i:E.
 mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E.
 mem.aux eq _ _ _ _.
 
-pred mem.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E.
+pred mem.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E.
 mem.aux lt Cmp L _ E :- mem L Cmp E.
 mem.aux gt Cmp _ R E :- mem R Cmp E.
 
@@ -1352,11 +1352,11 @@ merge M1 M2 R :-
   min-binding M2 X,
   bal M1 X {remove-min-binding M2} R.
 
-pred remove i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
+pred remove i:set E, i:(pred i:E, i:E, o:cmp), i:E, o:set E.
 remove empty _ _ empty.
 remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M.
 
-pred remove.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, o:set E.
+pred remove.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E, i:E, o:set E.
 remove.aux eq _   L R _ _ M :- merge L R M.
 remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M.
 remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M.
diff --git a/src/builtin_map.elpi b/src/builtin_map.elpi
index 9c0666e2d..5f38a5873 100644
--- a/src/builtin_map.elpi
+++ b/src/builtin_map.elpi
@@ -1,10 +1,10 @@
 kind std.map type -> type -> type.
-type std.map std.map.private.map K V -> (K -> K -> cmp -> prop) -> std.map K V.
+type std.map std.map.private.map K V -> (pred i:K, i:K, o:cmp) -> std.map K V.
 
 namespace std.map {
 
 % [make Eq Ltn M] builds an empty map M where keys are compared using Eq and Ltn
-pred make i:(K -> K -> cmp -> prop), o:std.map K V.
+pred make i:(pred i:K, i:K, o:cmp), o:std.map K V.
 make Cmp (std.map private.empty Cmp).
 
 % [find K M V] looks in M for the value V associated to K
@@ -60,19 +60,19 @@ bal.aux _ HR HL2 _ L X D (node (node RLL RLV RLD RLR _) RV RD RR _) T :-
   create {create L X D RLL} RLV RLD {create RLR RV RD RR} T.
 bal.aux _ _ _ _ L K V R T :- create L K V R T.
 
-pred add i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
+pred add i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
 add empty _ K V T :- create empty K V empty T.
 add (node _ X _ _ _ as M) Cmp X1 XD M1 :- Cmp X1 X E, add.aux E M Cmp X1 XD M1.
 
-pred add.aux i:cmp, i:map K V, i:(K -> K -> cmp -> prop), i:K, i:V, o:map K V.
+pred add.aux i:cmp, i:map K V, i:(pred i:K, i:K, o:cmp), i:K, i:V, o:map K V.
 add.aux eq (node L _ _ R H) _   X XD T :- T = node L X XD R H. 
 add.aux lt (node L V D R _) Cmp X XD T :- bal {add L Cmp X XD} V D R T.
 add.aux gt (node L V D R _) Cmp X XD T :- bal L V D {add R Cmp X XD} T.
 
-pred find i:map K V, i:(K -> K -> cmp -> prop), i:K, o:V.
+pred find i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:V.
 find (node L K1 V1 R _) Cmp K V :- Cmp K K1 E, find.aux E Cmp L R V1 K V.
 
-pred find.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, o:V.
+pred find.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, o:V.
 find.aux eq _   _ _ V _ V.
 find.aux lt Cmp L _ _ K V :- find L Cmp K V.
 find.aux gt Cmp _ R _ K V :- find R Cmp K V.
@@ -92,11 +92,11 @@ merge M1 M2 R :-
   min-binding M2 X D,
   bal M1 X D {remove-min-binding M2} R.
 
-pred remove i:map K V, i:(K -> K -> cmp -> prop), i:K, o:map K V.
+pred remove i:map K V, i:(pred i:K, i:K, o:cmp), i:K, o:map K V.
 remove empty _ _ empty :- !.
 remove (node L V D R _) Cmp X M :- Cmp X V E, remove.aux E Cmp L R V D X M.
 
-pred remove.aux i:cmp, i:(K -> K -> cmp -> prop), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
+pred remove.aux i:cmp, i:(pred i:K, i:K, o:cmp), i:map K V, i:map K V, i:V, i:K, i:K, o:map K V.
 remove.aux eq _   L R _ _ _ M :- merge L R M.
 remove.aux lt Cmp L R V D X M :- bal {remove L Cmp X} V D R M.
 remove.aux gt Cmp L R V D X M :- bal L V D {remove R Cmp X} M.
diff --git a/src/builtin_set.elpi b/src/builtin_set.elpi
index e9efecc33..5ccd55afb 100644
--- a/src/builtin_set.elpi
+++ b/src/builtin_set.elpi
@@ -1,10 +1,10 @@
 kind std.set type -> type.
-type std.set std.set.private.set E -> (E -> E -> cmp -> prop) -> std.set E.
+type std.set std.set.private.set E -> (pred i:E, i:E, o:cmp) -> std.set E.
 
 namespace std.set {
 
 % [make Eq Ltn M] builds an empty set M where keys are compared using Eq and Ltn
-pred make i:(E -> E -> cmp -> prop), o:std.set E.
+pred make i:(pred i:E, i:E, o:cmp), o:std.set E.
 make Cmp (std.set private.empty Cmp).
 
 % [mem E M] looks if E is in M
@@ -63,20 +63,20 @@ bal.aux _ HR HL2 _ L X (node (node RLL RLV RLR _) RV RR _) T :-
   create {create L X RLL} RLV {create RLR RV RR} T.
 bal.aux _ _ _ _ L E R T :- create L E R T.
 
-pred add i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
+pred add i:set E, i:(pred i:E, i:E, o:cmp), i:E, o:set E.
 add empty _ E T :- create empty E empty T.
 add (node L X R H) Cmp X1 S :- Cmp X1 X E, add.aux E Cmp L R X X1 H S.
 
-pred add.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, i:int, o:set E.
+pred add.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E, i:E, i:int, o:set E.
 add.aux eq _   L R X _ H (node L X R H).
 add.aux lt Cmp L R E X _ T :- bal {add L Cmp X} E R T.
 add.aux gt Cmp L R E X _ T :- bal L E {add R Cmp X} T.
 
-pred mem i:set E, i:(E -> E -> cmp -> prop), i:E.
+pred mem i:set E, i:(pred i:E, i:E, o:cmp), i:E.
 mem (node L K R _) Cmp E :- Cmp E K O, mem.aux O Cmp L R E.
 mem.aux eq _ _ _ _.
 
-pred mem.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E.
+pred mem.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E.
 mem.aux lt Cmp L _ E :- mem L Cmp E.
 mem.aux gt Cmp _ R E :- mem R Cmp E.
 
@@ -95,11 +95,11 @@ merge M1 M2 R :-
   min-binding M2 X,
   bal M1 X {remove-min-binding M2} R.
 
-pred remove i:set E, i:(E -> E -> cmp -> prop), i:E, o:set E.
+pred remove i:set E, i:(pred i:E, i:E, o:cmp), i:E, o:set E.
 remove empty _ _ empty.
 remove (node L E R _) Cmp X M :- Cmp X E O, remove.aux O Cmp L R E X M.
 
-pred remove.aux i:cmp, i:(E -> E -> cmp -> prop), i:set E, i:set E, i:E, i:E, o:set E.
+pred remove.aux i:cmp, i:(pred i:E, i:E, o:cmp), i:set E, i:set E, i:E, i:E, o:set E.
 remove.aux eq _   L R _ _ M :- merge L R M.
 remove.aux lt Cmp L R E X M :- bal {remove L Cmp X} E R M.
 remove.aux gt Cmp L R E X M :- bal L E {remove R Cmp X} M.
diff --git a/src/builtin_stdlib.elpi b/src/builtin_stdlib.elpi
index 088fbaddc..4d457d0a4 100644
--- a/src/builtin_stdlib.elpi
+++ b/src/builtin_stdlib.elpi
@@ -40,7 +40,7 @@ assert! Cond Msg :- (Cond ; fatal-error-w-data Msg Cond), !.
 
 % [assert-ok! C M] like assert! but the last argument of the predicate must
 % be a diagnostic that is printed after M in case it is not ok
-pred assert-ok! i:(diagnostic -> prop), i:string.
+pred assert-ok! i:(pred o:diagnostic), i:string.
 assert-ok! Cond Msg :- Cond Diagnostic, !, (Diagnostic = ok ; Diagnostic = error S, fatal-error-w-data Msg S), !.
 assert-ok! _ Msg :- fatal-error-w-data Msg "no diagnostic returned".
 
@@ -115,59 +115,59 @@ split-at 0 L [] L :- !.
 split-at N [X|XS] [X|LN] LM :- !, N1 is N - 1, split-at N1 XS LN LM.
 split-at _ _ _ _ :- fatal-error "split-at run out of list items".
 
-pred fold i:list B, i:A, i:(B -> A -> A -> prop), o:A.
+pred fold i:list B, i:A, i:(pred i:B, i:A, o:A), o:A.
 fold [] A _ A.
 fold [X|XS] A F R :- F X A A1, fold XS A1 F R.
 
-pred fold-right i:list B, i:A, i:(B -> A -> A -> prop), o:A.
+pred fold-right i:list B, i:A, i:(pred i:B, i:A, o:A), o:A.
 fold-right [] A _ A.
 fold-right [X|XS] A F R :- fold-right XS A F A', F X A' R.
 
-pred fold2 i:list C, i:list B, i:A, i:(C -> B -> A -> A -> prop), o:A.
+pred fold2 i:list C, i:list B, i:A, i:(pred i:C, i:B, i:A, o:A), o:A.
 fold2 [] [_|_] _ _ _ :- fatal-error "fold2 on lists of different length".
 fold2 [_|_] [] _ _ _ :- fatal-error "fold2 on lists of different length".
 fold2 [] [] A _ A.
 fold2 [X|XS] [Y|YS] A F R :- F X Y A A1, fold2 XS YS A1 F R.
 
-pred map i:list A, i:(A -> B -> prop), o:list B.
+pred map i:list A, i:(pred i:A, o:B), o:list B.
 map [] _ [].
 map [X|XS] F [Y|YS] :- F X Y, map XS F YS.
 
-pred map-i i:list A, i:(int -> A -> B -> prop), o:list B.
+pred map-i i:list A, i:(pred i:int, i:A, o:B), o:list B.
 map-i L F R :- map-i.aux L 0 F R.
 
-pred map-i.aux i:list A, i:int, i:(int -> A -> B -> prop), o:list B.
+pred map-i.aux i:list A, i:int, i:(pred i:int, i:A, o:B), o:list B.
 map-i.aux [] _ _ [].
 map-i.aux [X|XS] N F [Y|YS] :- F N X Y, M is N + 1, map-i.aux XS M F YS.
 
-pred map-filter i:list A, i:(A -> B -> prop), o:list B.
+pred map-filter i:list A, i:(pred i:A, o:B), o:list B.
 map-filter [] _ [].
 map-filter [X|XS] F [Y|YS] :- F X Y, !, map-filter XS F YS.
 map-filter [_|XS] F YS :- map-filter XS F YS.
 
 :index(1 1)
-pred map2 i:list A, i:list B, i:(A -> B -> C -> prop), o:list C.
+pred map2 i:list A, i:list B, i:(pred i:A, i:B, o:C), o:list C.
 map2 [] [_|_] _ _ :- fatal-error "map2 on lists of different length".
 map2 [_|_] [] _ _ :- fatal-error "map2 on lists of different length".
 map2 [] [] _ [].
 map2 [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, map2 XS YS F ZS.
 
-pred map2-filter i:list A, i:list B, i:(A -> B -> C -> prop), o:list C.
+pred map2-filter i:list A, i:list B, i:(pred i:A, i:B, o:C), o:list C.
 map2-filter [] [_|_] _ _ :- fatal-error "map2-filter on lists of different length".
 map2-filter [_|_] [] _ _ :- fatal-error "map2-filter on lists of different length".
 map2-filter [] [] _ [].
 map2-filter [X|XS] [Y|YS] F [Z|ZS] :- F X Y Z, !, map2-filter XS YS F ZS.
 map2-filter [_|XS] [_|YS] F ZS :- map2-filter XS YS F ZS.
 
-pred map-ok i:list A, i:(A -> B -> diagnostic -> prop), o:list A, o:diagnostic.
+pred map-ok i:list A, i:(pred i:A, i:B, o:diagnostic), o:list A, o:diagnostic.
 map-ok [X|L] P [Y|YS] S :- P X Y S0, if (S0 = ok) (map-ok L P YS S) (S = S0).
 map-ok [] _ [] ok.
 
-pred fold-map i:list A, i:B, i:(A -> B -> C -> B -> prop), o:list C, o:B.
+pred fold-map i:list A, i:B, i:(pred i:A, i:B, o:C, o:B), o:list C, o:B.
 fold-map [] A _ [] A.
 fold-map [X|XS] A F [Y|YS] A2 :- F X A Y A1, fold-map XS A1 F YS A2.
 
-pred omap i:option A, i:(A -> B -> prop), o:option B.
+pred omap i:option A, i:(pred i:A, o:B), o:option B.
 omap none _ none.
 omap (some X) F (some Y) :- F X Y.
 
@@ -198,31 +198,31 @@ pred mem i:list A, o:A.
 mem [X|_] X.
 mem [_|L] X :- mem L X.
 
-pred exists i:list A, i:(A -> prop).
+pred exists i:list A, i:(pred i:A).
 exists [X|_] P :- P X.
 exists [_|L] P :- exists L P.
 
-pred exists2 i:list A, i:list B, i:(A -> B -> prop).
+pred exists2 i:list A, i:list B, i:(pred i:A, i:B).
 exists2 [] [_|_] _ :- fatal-error "exists2 on lists of different length".
 exists2 [_|_] [] _ :- fatal-error "exists2 on lists of different length".
 exists2 [X|_] [Y|_] P :- P X Y.
 exists2 [_|L] [_|M] P :- exists2 L M P.
 
-pred forall i:list A, i:(A -> prop).
+pred forall i:list A, i:(pred i:A).
 forall [] _.
 forall [X|L] P :- P X, forall L P.
 
-pred forall-ok i:list A, i:(A -> diagnostic -> prop), o:diagnostic.
+pred forall-ok i:list A, i:(pred i:A, o:diagnostic), o:diagnostic.
 forall-ok [X|L] P S :- P X S0, if (S0 = ok) (forall-ok L P S) (S = S0).
 forall-ok [] _ ok.
 
-pred forall2 i:list A, i:list B, i:(A -> B -> prop).
+pred forall2 i:list A, i:list B, i:(pred i:A, i:B).
 forall2 [] [_|_] _ :- fatal-error "forall2 on lists of different length".
 forall2 [_|_] [] _ :- fatal-error "forall2 on lists of different length".
 forall2 [X|XS] [Y|YS] P :- P X Y, forall2 XS YS P.
 forall2 [] [] _.
 
-pred filter i:list A, i:(A -> prop), o:list A.
+pred filter i:list A, i:(pred i:A), o:list A.
 filter []    _ [].
 filter [X|L] P R :- if (P X) (R = X :: L1) (R = L1), filter L P L1.
 
@@ -259,7 +259,7 @@ intersperse Sep [X|XS] [X,Sep|YS] :- intersperse Sep XS YS.
 
 %  -- Misc --
 
-pred flip i:(A -> B -> prop), i:B, i:A.
+pred flip i:(pred i:A, i:B), i:B, i:A.
 flip P X Y :- P Y X.
 
 pred time i:prop, o:float.
@@ -270,7 +270,7 @@ do! [].
 do! [P|PS] :- P, !, do! PS.
 
 :index(_ 1)
-pred do-ok! o:diagnostic, i:list (diagnostic -> prop).
+pred do-ok! o:diagnostic, i:list (pred o:diagnostic).
 do-ok! ok [].
 do-ok! S [P|PS] :- P S0, !, if (S0 = ok) (do-ok! S PS) (S = S0).
 
@@ -280,7 +280,7 @@ lift-ok P Msg R :- (P, R = ok; R = error Msg).
 pred spy-do! i:list prop.
 spy-do! L :- map L (x\y\y = spy x) L1, do! L1.
 
-pred while-ok-do! i:diagnostic, i:list (diagnostic -> prop), o:diagnostic.
+pred while-ok-do! i:diagnostic, i:list (pred o:diagnostic), o:diagnostic.
 while-ok-do! (error _ as E) _ E.
 while-ok-do! ok [] ok.
 while-ok-do! ok [P|PS] R :- P C, !, while-ok-do! C PS R.
diff --git a/src/compiler.ml b/src/compiler.ml
index d09ed1ed8..a7635a342 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -561,7 +561,6 @@ type program = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : (mode * Loc.t) C.Map.t;
-  functionality : C.Set.t;
   clauses : (preterm,Ast.Structured.attribute) Ast.Clause.t list;
   chr : block_constraint list;
   local_names : int;
@@ -576,7 +575,6 @@ type program = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : (mode * Loc.t) C.Map.t;
-  functionality: C.Set.t;
   clauses : (preterm,attribute) Ast.Clause.t list;
   prolog_program : index;
   indexing : (mode * indexing) C.Map.t;
@@ -596,7 +594,6 @@ let empty () = {
   types = C.Map.empty;
   type_abbrevs = C.Map.empty;
   modes = C.Map.empty;
-  functionality = C.Set.empty;
   clauses = [];
   prolog_program = { idx = Ptmap.empty; time = 0; times = StrMap.empty };
   indexing = C.Map.empty;
@@ -627,7 +624,6 @@ type 'a query = {
   types : Types.types C.Map.t;
   type_abbrevs : type_abbrev_declaration C.Map.t;
   modes : mode C.Map.t;
-  functionality : C.Set.t;
   clauses : (preterm,Assembled.attribute) Ast.Clause.t list;
   prolog_program : index;
   chr : block_constraint list;
@@ -1861,13 +1857,11 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
     let types = apply_subst_types ~live_symbols state empty_subst types in
     let type_abbrevs = apply_subst_type_abbrevs ~live_symbols state empty_subst type_abbrevs in
     let modes = apply_subst_modes ~live_symbols empty_subst modes in
-    let functionality = apply_subst_functionality ~live_symbols empty_subst functionality in
     let types, type_abbrevs, modes, clauses, chr =
       compile_body live_symbols state local_names types type_abbrevs modes [] [] empty_subst body in
     !live_symbols, toplevel_macros, { Flat.types;
       type_abbrevs;
       modes;
-      functionality;
       clauses;
       chr = List.rev chr;
       local_names;
@@ -1880,7 +1874,6 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
       Flat.types;
       type_abbrevs;
       modes;
-      functionality;
       clauses;
       chr;
       local_names;
@@ -1890,7 +1883,6 @@ let subst_amap state f { nargs; c2i; i2n; n2t; n2i } =
       Flat.types = apply_subst_types state f types;
       type_abbrevs = apply_subst_type_abbrevs state f type_abbrevs;
       modes = apply_subst_modes f modes;
-      functionality = apply_subst_functionality f functionality;
       clauses = apply_subst_clauses state f clauses;
       chr = smart_map (apply_subst_chr state f) chr;
       local_names;
@@ -2313,16 +2305,15 @@ let compile_clause modes initial_depth (state, index, clauses)
 let assemble flags state code  (ul : compilation_unit list) =
   let local_names = code.Assembled.local_names in
 
-  let state, index, indexing, clauses, types, type_abbrevs, modes, functionality, chr_rev =
-    List.fold_left (fun (state, index, idx1, clauses, t1, ta1, m1, f1, c1) ({ symbol_table; code }  as _u) ->
-      let state, { Flat.clauses = cl2; types = t2; type_abbrevs = ta2; modes = m2; functionality = f2; chr = c2; } =
+  let state, index, indexing, clauses, types, type_abbrevs, modes, chr_rev =
+    List.fold_left (fun (state, index, idx1, clauses, t1, ta1, m1, c1) ({ symbol_table; code }  as _u) ->
+      let state, { Flat.clauses = cl2; types = t2; type_abbrevs = ta2; modes = m2; chr = c2; } =
         let state, shift = Stdlib.Result.get_ok @@ Symbols.build_shift ~flags ~base:state symbol_table in
         let code =
           if C.Map.is_empty shift then code
           else Flatten.relocate state shift code in
         state, code in
       let modes = ToDBL.merge_modes state m1 m2 in
-      let functionality = ToDBL.merge_functionality f1 f2 in
       let type_abbrevs = ToDBL.merge_type_abbrevs state ta1 ta2 in
       let types = ToDBL.merge_types state t1 t2 in
 
@@ -2337,14 +2328,14 @@ let assemble flags state code  (ul : compilation_unit list) =
       let state, index,clauses =
         List.fold_left (compile_clause modes local_names) (state,index,clauses) cl2 in
       
-      state, index, idx2, clauses, types, type_abbrevs, modes, functionality, c2 :: c1
-    ) (state, code.prolog_program, code.indexing, code.clauses, code.types, code.type_abbrevs, code.modes, code.functionality, []) ul in
+      state, index, idx2, clauses, types, type_abbrevs, modes, c2 :: c1
+    ) (state, code.prolog_program, code.indexing, code.clauses, code.types, code.type_abbrevs, code.modes, []) ul in
   let prolog_program = index in
   let chr = List.concat (code.chr :: List.rev chr_rev) in
   let chr =
     let pifexpr { pifexpr } = pifexpr in
     List.map (fun {ctx_filter;clique;rules} -> {ctx_filter;clique;rules=filter_if flags pifexpr rules}) chr in
-  state, { Assembled.clauses; indexing; prolog_program; types; type_abbrevs; modes; functionality; chr; local_names = code.local_names; toplevel_macros = code.toplevel_macros }
+  state, { Assembled.clauses; indexing; prolog_program; types; type_abbrevs; modes; chr; local_names = code.local_names; toplevel_macros = code.toplevel_macros }
 
 end (* }}} *)
 
@@ -2548,7 +2539,6 @@ let query_of_ast (compiler_state, assembled_program) t state_update =
   {
     WithMain.types;
     modes;
-    functionality = assembled_program.Assembled.functionality;
     type_abbrevs;
     prolog_program = assembled_program.Assembled.prolog_program;
     clauses = assembled_program.Assembled.clauses;
@@ -2582,7 +2572,6 @@ let query_of_term (compiler_state, assembled_program) f =
     WithMain.types;
     type_abbrevs;
     modes;
-    functionality = assembled_program.functionality;
     clauses = assembled_program.clauses;
     prolog_program = assembled_program.prolog_program;
     chr = assembled_program.Assembled.chr;
@@ -2930,11 +2919,10 @@ let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype;
   in
   let find_opt c = C.Map.find_opt c type_abbrevs in
 
-  (* Format.eprintf "Going to unfold %a\n%!" (pp_ttype) ttype;  *)  let rec aux seen = function
+  let rec aux seen = function
     | TConst c as x ->
         begin match find_opt c with
         | Some { tavalue; taparams; timestamp=time } ->
-          (* Format.printf "Found a match %a\n" pp_ttype tavalue.ttype; *)
           if taparams > 0 then
             error ~loc ("type abbreviation " ^ Symbols.show compiler_state c ^ " needs " ^
               string_of_int taparams ^ " arguments");
@@ -2950,14 +2938,8 @@ let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype;
             error ~loc ("type abbreviation " ^ Symbols.show compiler_state c ^ " needs " ^
               string_of_int taparams ^ " arguments, only " ^
               string_of_int nargs ^ " are provided");
-          (* Format.eprintf "Seen is [%a]\n%!" (Format.pp_print_list Format.pp_print_int) (C.Set.elements seen);
-          Format.eprintf "Current is %d\n%!" c;
-          Format.eprintf "Result is %a\n%!" pp_ttype tavalue.ttype;
-          Format.eprintf "lcs is %d\n%!" lcs;
-          Format.eprintf "Args are [%a]\n%!" (Format.pp_print_list pp_ttype) (t::ts); *)
           error_undefined ttime time c tavalue;
           aux time (beta tavalue.ttype (t::ts))
-          (* aux (C.Set.add c seen) (R.deref_appuv ~from:lcs ~to_:lcs (t::ts) tavalue.term) *)
         | None ->
           let t1 = aux seen t in
           let ts1 = smart_map (aux seen) ts in
@@ -2969,7 +2951,6 @@ let unfold_type_abbrevs ~is_typeabbrev ~compiler_state lcs type_abbrevs { ttype;
     | TCData _ as a -> a
     | TLam a -> TLam (aux seen a)
   in
-    (* Format.eprintf "Unfold result is %a\n%!" pp_ttype (aux C.Set.empty ttype); *)
     { ttype = aux ttime ttype; tloc; tamap }
 
 
@@ -2989,42 +2970,47 @@ let term_of_ast ~depth state text =
  state, R.move ~argsdepth ~from:depth ~to_:depth env t
 ;;
 
+let is_functional = function TPred (b,_) -> b | _ -> false
+
 let static_check ~exec ~checker:(state,program)
-  ({ WithMain.types; type_abbrevs; functionality; modes; initial_depth; compiler_state } as q) =
+  ({ WithMain.types; type_abbrevs; modes; initial_depth; compiler_state } as q) =
   let time = `Compiletime in
   let state, p,q = quote_syntax time state q in
 
-    (* Building type abbrev list *)
+  
+  let estract_info_from_types tname {Types.lst} (state, tlist, functionality) =
+    let functionality = ref functionality in
+    let state = ref state in
+    let l =
+      List.rev_map (fun { Types.decl = { ttype; tname } } ->
+        let st, c = mkQCon time ~compiler_state !state ~on_type:false tname in
+        let ttypet = unfold_type_abbrevs ~is_typeabbrev:false ~compiler_state initial_depth type_abbrevs ttype 0 in
+        let st, ttypet = quote_pretype time ~compiler_state st ttypet in
+        state := st;
+        begin
+          if is_functional ttype.ttype then
+            let st, f = mkQCon time ~compiler_state st ~on_type:false tname in
+            state := st;
+            functionality := f :: !functionality
+        end;
+        App(colonc,c, [close_w_binder forallc ttypet ttype.tamap])) lst
+    in
+    !state, l :: tlist, !functionality
+  in
+
+  (* Building type abbrev list *)
   let state, talist =
     C.Map.bindings type_abbrevs |>
     map_acc (fun state (name, { tavalue; timestamp=ttime } ) ->
-      (* Printf.eprintf "Unfolding %d %s\n" name (Symbols.show compiler_state name);  *)
       let tavaluet = unfold_type_abbrevs ~is_typeabbrev:true ~compiler_state initial_depth type_abbrevs tavalue ttime in
       let state, tavaluet = quote_pretype time ~compiler_state state tavaluet in
       state, App(colonec, D.C.of_string (Symbols.show compiler_state name), [lam2forall tavaluet])) state
   in
 
-  (* Building types *)
-  let state, tlist = C.Map.fold (fun tname l (state,tl) ->
-    let l = l.Types.lst in
-    let state, l =
-      List.rev l |> map_acc (fun state { Types.decl = { ttype; tname } } ->
-        let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
-        (* Printf.eprintf "Working with the type %s\n" (Symbols.show compiler_state tname); *)
-        let ttypet = unfold_type_abbrevs ~is_typeabbrev:false ~compiler_state initial_depth type_abbrevs ttype 0 in
-        (* Format.eprintf "Going to quote_pretype %a\n%!" pp_ttype ttypet.ttype; *)
-        let state, ttypet = quote_pretype time ~compiler_state state ttypet in
-        state, App(colonc,c, [close_w_binder forallc ttypet ttype.tamap])) state
-      in
-        state, l :: tl)
-      types (state,[]) in
+  (* Building types and functionality *)
+  let state, tlist, functionality = C.Map.fold estract_info_from_types types (state,[],[]) in
   let tlist = List.concat (List.rev tlist) in
   
-  (* Building functionality *)
-  let state, functionality = C.Set.fold (fun tname (state,tl) ->
-    let state, c = mkQCon time ~compiler_state state ~on_type:false tname in
-    state, c :: tl) functionality (state,[]) in
-
   (* Building modes *)
   let arg_mode2bool = function Input -> Const truec | Output -> Const falsec in
 
diff --git a/tests/sources/trace_findall.elab.json b/tests/sources/trace_findall.elab.json
index 1c10f9770..b1c46e252 100644
--- a/tests/sources/trace_findall.elab.json
+++ b/tests/sources/trace_findall.elab.json
@@ -91,7 +91,7 @@
                       "filename": "builtin_stdlib.elpi",
                       "line": 296,
                       "column": 0,
-                      "character": 9708
+                      "character": 9686
                     }
                   ]
                 }
@@ -119,7 +119,7 @@
                     "filename": "builtin_stdlib.elpi",
                     "line": 296,
                     "column": 0,
-                    "character": 9708
+                    "character": 9686
                   }
                 ]
               }
@@ -444,7 +444,7 @@
                     "filename": "builtin_stdlib.elpi",
                     "line": 296,
                     "column": 0,
-                    "character": 9708
+                    "character": 9686
                   }
                 ]
               }
diff --git a/tests/sources/trace_findall.json b/tests/sources/trace_findall.json
index 43c856382..03a5d7d7d 100644
--- a/tests/sources/trace_findall.json
+++ b/tests/sources/trace_findall.json
@@ -10,8 +10,8 @@
 {"step" : 1,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain","payload" : ["success"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:curgoal","payload" : ["std.findall","std.findall (p _) X0"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule","payload" : ["backchain"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9708-9744:"]}
-{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:try","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9708-9744:","(std.findall A0 A1) :- (findall_solutions A0 A1)."]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:candidates","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9686-9722:"]}
+{"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:rule:backchain:try","payload" : ["File \"builtin_stdlib.elpi\", line 296, column 0, characters 9686-9722:","(std.findall A0 A1) :- (findall_solutions A0 A1)."]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 0,"name" : "user:assign","payload" : ["A0 := p _"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 0,"runtime_id" : 0,"name" : "user:assign","payload" : ["A1 := X0"]}
 {"step" : 2,"kind" : ["Info"],"goal_id" : 5,"runtime_id" : 0,"name" : "user:subgoal","payload" : ["7"]}
diff --git a/tests/test.real.ml b/tests/test.real.ml
index ce3854b01..abe330fe2 100644
--- a/tests/test.real.ml
+++ b/tests/test.real.ml
@@ -14,7 +14,7 @@ module Printer : sig
     executables:string list -> seed:int -> timeout:float -> unit
     
   val print_summary :
-    total:int -> ok:int -> ko:int -> skipped:int -> timeout:int -> unit
+    total:int -> ok:int -> ko_list:string list -> skipped:int -> timeout:int -> unit
 
   val print_log :
     fname:string -> unit
@@ -46,16 +46,19 @@ let print_header ~executables ~seed ~timeout =
   printf [blue] "------------------------------------------------------------------\n";
 ;;
 
-let print_summary ~total ~ok ~ko ~skipped ~timeout =
+let print_summary ~total ~ok ~ko_list ~skipped ~timeout =
   printf [blue] "------------------------------------------------------------------\n";
   let print_stat ?(to_print=false) k v =
     if to_print || v <> 0 then (printf [blue] "%s: " k; printf [] "%d\n" v)
   in
   print_stat ~to_print:true "Tests" total;
   print_stat ~to_print:true "Passed" ok;
-  print_stat ~to_print:true "Failed" ko;
+  print_stat ~to_print:true "Failed" (List.length ko_list);
   print_stat "Skipped" skipped;
-  print_stat "Timeout" timeout
+  print_stat "Timeout" timeout;
+  if ko_list <> [] then 
+    let verb = if List.length ko_list = 1 then "is" else "are" in
+    printf [red] "Failed tests %s [%s]\n" verb (String.concat "," ko_list)
 ;;
 
 let print_file fname =
@@ -154,16 +157,16 @@ let main sources plot timeout promote executables namef catskip timetool seed =
           |> List.concat in
   let results =
     List.map (run timeout seed sources promote env) jobs in
-  let total, ok, ko, skipped, timeout =
-    let rec part total ok ko skipped timeout = function
-      | [] -> (total, ok, ko, skipped, timeout)
-      | Some {Runner.rc = Success _; _} :: l -> part (total+1) (ok+1) ko skipped timeout l
-      | Some {rc = Promote _; _} :: l ->        part (total+1) (ok+1) ko skipped timeout l
-      | Some {rc = Failure _; _} :: l ->        part (total+1) ok (ko+1) skipped timeout l
-      | None :: l ->                            part (total+1) ok ko (skipped+1) timeout l
-      | Some {rc = Timeout _; _} :: l ->        part (total+1) ok ko skipped (timeout+1) l
-    in part 0 0 0 0 0 results in
-  Printer.print_summary ~total ~ok ~ko ~skipped ~timeout;
+  let total, ok, ko_list, skipped, timeout =
+    let rec part total ok ko_list skipped timeout = function
+      | [] -> (total, ok, List.rev ko_list, skipped, timeout)
+      | Some {Runner.rc = Success _; _} :: l -> part (total+1) (ok+1) ko_list skipped timeout l
+      | Some {rc = Promote _; _} :: l ->        part (total+1) (ok+1) ko_list skipped timeout l
+      | Some {rc = Failure _; test} :: l ->        part (total+1) ok (test.name :: ko_list) skipped timeout l
+      | None :: l ->                            part (total+1) ok ko_list (skipped+1) timeout l
+      | Some {rc = Timeout _; _} :: l ->        part (total+1) ok ko_list skipped (timeout+1) l
+    in part 0 0 [] 0 0 results in
+  Printer.print_summary ~total ~ok ~ko_list ~skipped ~timeout;
   begin try
     let log_first_failure =
       results |> find_map (function
@@ -173,7 +176,7 @@ let main sources plot timeout promote executables namef catskip timetool seed =
   with Not_found -> ()
   end;
   if List.length executables > 1 then print_csv plot results;
-  if ko = 0 then exit 0 else exit 1
+  if ko_list = [] then exit 0 else exit 1
 
 open Cmdliner
 

From 3c062745523735512ee70c333d189419789c6a5a Mon Sep 17 00:00:00 2001
From: Davide Fissore <fisso9900@gmail.com>
Date: Tue, 8 Oct 2024 14:36:46 +0200
Subject: [PATCH 32/32] [compiler] smal fix

---
 src/compiler.ml | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/src/compiler.ml b/src/compiler.ml
index a7635a342..11e2b2cf8 100644
--- a/src/compiler.ml
+++ b/src/compiler.ml
@@ -2977,7 +2977,6 @@ let static_check ~exec ~checker:(state,program)
   let time = `Compiletime in
   let state, p,q = quote_syntax time state q in
 
-  
   let estract_info_from_types tname {Types.lst} (state, tlist, functionality) =
     let functionality = ref functionality in
     let state = ref state in
@@ -2987,12 +2986,7 @@ let static_check ~exec ~checker:(state,program)
         let ttypet = unfold_type_abbrevs ~is_typeabbrev:false ~compiler_state initial_depth type_abbrevs ttype 0 in
         let st, ttypet = quote_pretype time ~compiler_state st ttypet in
         state := st;
-        begin
-          if is_functional ttype.ttype then
-            let st, f = mkQCon time ~compiler_state st ~on_type:false tname in
-            state := st;
-            functionality := f :: !functionality
-        end;
+        if is_functional ttype.ttype then functionality := c :: !functionality;
         App(colonc,c, [close_w_binder forallc ttypet ttype.tamap])) lst
     in
     !state, l :: tlist, !functionality