1 files changed, 38 insertions, 15 deletions
diff --git a/src/catalog.ml b/src/catalog.ml
index cd217b3..526a3ed 100644
--- a/src/catalog.ml
+++ b/src/catalog.ml
@@ -15,6 +15,8 @@ You should have received a copy of the GNU General Public License
 along with licht.  If not, see <http://www.gnu.org/licenses/>.
 *)
 
+let u = UTF8.from_utf8string
+
 module T = Tools
 module type DATA_SIG = sig
 
@@ -89,12 +91,31 @@ module Make(Data:DATA_SIG) = struct
   type 'a argument = 'a Data.t
   type 'a returnType = 'a Data.returnType
 
-  type result =
-    | R : 'a returnType * 'a -> result
+  type result = R : 'a returnType * 'a -> result
+  type ex_argument = ExArg : 'a argument -> ex_argument
 
   type _ lift =
     | Z : result lift (* No more parameter in the function *)
-    | S : 'c argument * 't1 lift -> ('c -> 't1) lift
+    | S : 'a argument * 't1 lift -> ('a -> 't1) lift (* Add an argument to the function *)
+
+  (** Build a reversed list with each argument mapped *)
+  let rev_map: type a. (ex_argument -> 'c) -> a lift -> 'c list = begin fun f lift ->
+    let rec map': type a. 'c list -> a lift -> 'c list = fun acc -> function
+    | Z -> acc
+    | S (l, tl) -> map' ((f (ExArg l))::acc) tl in
+    map' [] lift
+  end
+
+  (** Get the name for argument *)
+  let show_args lift = begin
+    let formatter = Format.str_formatter in
+    let print (ExArg arg) = begin
+      Data.repr formatter arg;
+      Format.flush_str_formatter ()
+    end in
+    List.rev @@ rev_map print lift
+  end
+
 
   module ComparableSignature = struct
 
@@ -106,10 +127,8 @@ module Make(Data:DATA_SIG) = struct
     (** Compare two signature *)
     let rec comp: type a1 a2. a1 lift -> a2 lift -> (a1, a2) T.cmp = fun a b ->
       begin match (a, b) with
-      | (S _, Z) -> T.Lt
-      | (Z, S _) -> T.Gt
-      | (Z, Z) -> T.Eq
-      | (S (arg1, s1), S (arg2, s2)) -> begin match Data.compare_typ arg1 arg2 with
+      | Z  , Z   -> T.Eq
+      | S (arg1, s1), S (arg2, s2) -> begin match Data.compare_typ arg1 arg2 with
         | T.Lt -> T.Lt
         | T.Gt -> T.Gt
         | T.Eq -> begin match comp s1 s2 with
@@ -117,10 +136,12 @@ module Make(Data:DATA_SIG) = struct
           | T.Lt -> T.Lt
           | T.Gt -> T.Gt
           end
-      end
+        end
+      | _  , Z   -> T.Lt
+      | Z  , _   -> T.Gt
     end
 
-    let rec repr : type a b. Format.formatter -> a t -> unit = begin fun formatter t -> match t with
+    let rec repr : type a. Format.formatter -> a t -> unit = begin fun formatter t -> match t with
       | Z -> Format.fprintf formatter "->"
       | S (t1, f) -> Format.fprintf formatter "(%a,%a)" Data.repr t1 repr f
     end
@@ -161,26 +182,30 @@ module Make(Data:DATA_SIG) = struct
   end
 
   let register1 name typ1 result f catalog =
-    let f' arg1 = R(result, f arg1) in
+    let f' arg1 = R (result, f arg1) in
     register catalog name (S (typ1, Z)) f'
 
   let register2 name (typ1, typ2) result f catalog =
-    let f' arg1 arg2 = R(result, f arg1 arg2) in
+    let f' arg1 arg2 = R (result, f arg1 arg2) in
     register catalog name (S (typ1, S (typ2, Z))) f'
 
   let register3 name (typ1, typ2, typ3) result f catalog =
-    let f' arg1 arg2 arg3 = R(result, f arg1 arg2 arg3) in
+    let f' arg1 arg2 arg3 = R (result, f arg1 arg2 arg3) in
     register catalog name (S (typ1, S (typ2, S (typ3, Z)))) f'
 
   (** Look in the catalog for a function with the given name and signature *)
   let find_function:
   type a b. t -> string -> a ComparableSignature.t  -> a =
   begin fun t name signature ->
-       String_dict.find_exn t (String.uppercase_ascii name)
+    try String_dict.find_exn t (String.uppercase_ascii name)
     |> Functions.find signature
+    with Not_found ->
+        (* None found, build an error message *)
+        raise (Errors.Undefined (u name, show_args signature))
   end
 
   let compile t =
+
     (* Use efficient String_dict.
        The requirement to have a unique key is garantee by the Map structure.
     *)
@@ -202,6 +227,4 @@ module Make(Data:DATA_SIG) = struct
     f arg1 arg2 arg3
   end
 
-
-
 end