[REBME] First draft of the APIapi

4 files changed, 108 insertions, 0 deletions

diff --git a/src/Common.ml b/src/Common.ml
index 6f7c5f4..8f8d8d6 100644
--- a/src/Common.ml
+++ b/src/Common.ml
@@ -198,3 +198,7 @@ let lift3 (type a) (type b) (type c) (type d)
   function
   | [x; y; z] -> Obj.repr @$ f (cast a x) (cast b y) (cast c z)
   | xs        -> unsupported_arity 3 @$ List.length xs
+
+let string_of_string_option = function
+  | Some str -> str
+  | None     -> ""
diff --git a/src/Hook.ml b/src/Hook.ml
new file mode 100644
index 0000000..25caaec
--- /dev/null
+++ b/src/Hook.ml
@@ -0,0 +1,57 @@
+(*
+Copyright (c) 2014, Grégoire Duchêne <gduchene@awhk.org>
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted, provided that the
+above copyright notice and this permission notice appear in all
+copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.
+*)
+
+open Common
+open Printf
+
+type env          = Environment.t
+and  finalize_fun = env -> result
+and  hook         = string * init_fun * finalize_fun
+and  init_fun     = term list -> result
+and  result       = [ `Abort of string option
+                    | `Continue
+                    | `Warn of string option ]
+and  term         = Lambda.lambda
+
+let hooks : hook Queue.t = Queue.create ()
+
+let abort hook_name hook_reason =
+  match hook_reason with
+  | Some reason -> eprintf "fatal error: hook %s: %s" hook_name reason
+  | None        -> eprintf "fatal error: hook %s failed" hook_name
+  ;
+
+  exit 1
+
+let warn hook_name hook_reason =
+  match hook_reason with
+  | Some reason -> eprintf "warning: hook %s: %s" hook_name reason
+  | None        -> eprintf "warning: hook %s failed" hook_name
+
+let handle_result hook_name = function
+  | `Abort why -> abort hook_name why
+  | `Continue  -> ()
+  | `Warn why  -> warn hook_name why
+
+let init_hooks terms =
+  Queue.iter (fun (n, f, _) -> handle_result n @$ f terms) hooks
+
+let finalize_hooks env =
+  Queue.iter (fun (n, _, f) -> handle_result n @$ f env) hooks
+
+let register_hook hook = Queue.push hook hooks
diff --git a/src/TamasheqLib.ml b/src/TamasheqLib.ml
new file mode 100644
index 0000000..65d4903
--- /dev/null
+++ b/src/TamasheqLib.ml
@@ -0,0 +1,19 @@
+(*
+Copyright (c) 2014, Grégoire Duchêne <gduchene@awhk.org>
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted, provided that the
+above copyright notice and this permission notice appear in all
+copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.
+*)
+
+include Hook
diff --git a/src/TamasheqLib.mli b/src/TamasheqLib.mli
new file mode 100644
index 0000000..32f53c7
--- /dev/null
+++ b/src/TamasheqLib.mli
@@ -0,0 +1,28 @@
+(*
+Copyright (c) 2014, Grégoire Duchêne <gduchene@awhk.org>
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted, provided that the
+above copyright notice and this permission notice appear in all
+copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.
+*)
+
+type env
+and  finalize_fun = env -> result
+and  hook         = string * init_fun * finalize_fun
+and  init_fun     = term list -> result
+and  result       = [ `Abort of string option
+                    | `Continue
+                    | `Warn of string option ]
+and  term         = Lambda.lambda
+
+val register_hook : hook -> unit