aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2017-01-01 12:36:00 +0100
committerSébastien Dailly <sebastien@chimrod.com>2017-01-01 12:36:00 +0100
commit4b091fbb37d5a42d0e78bb30b72822483e0119fa (patch)
treeafe3119db5a14b57ee32b3b4434dcff92792571e
parentf75cf3857bf19f5923ef409573b16adff7fe0abb (diff)
fst article about licht internals
-rw-r--r--.gitignore1
-rw-r--r--content/Informatique/2017-01-01-gadt.rst594
-rw-r--r--content/images/catalog/catalog.jpgbin0 -> 25782 bytes
-rw-r--r--content/images/catalog/catalog_75.jpgbin0 -> 8301 bytes
-rw-r--r--content/resources/catalog.ml196
5 files changed, 791 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
index 4937ede..24ecff8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,6 @@
disqus.py
output/*
+cache/
*.pyc
*.swp
*.pid
diff --git a/content/Informatique/2017-01-01-gadt.rst b/content/Informatique/2017-01-01-gadt.rst
new file mode 100644
index 0000000..ce34ad5
--- /dev/null
+++ b/content/Informatique/2017-01-01-gadt.rst
@@ -0,0 +1,594 @@
+.. -*- mode: rst -*-
+.. -*- coding: utf-8 -*-
+
+===================================================
+Écrire un catalogue dynamique de fonctions en OCaml
+===================================================
+
+:date: 2017-01-01
+:tags: OCaml
+:logo: /images/catalog/catalog_75.jpg
+:summary: |summary|
+
+.. default-role:: literal
+
+.. figure:: {filename}/images/catalog/catalog.jpg
+ :figwidth: 250
+ :figclass: floatright
+ :alt: Furniture
+
+ Image : `Adam mayer`_ (creativecommons_)
+
+.. _Adam mayer: https://www.flickr.com/photos/phooky/12687690/in/photostream/
+.. _creativecommons: https://creativecommons.org/licenses/by-sa/2.0/
+
+|summary|
+
+.. |summary| replace::
+
+ J'ai commencé à écrire un tableur. Je présenterai le résultat une autre fois,
+ quand le sujet aura plus avancé, et je vais ici me focaliser sur une partie du
+ code de ce tableur : le catalogue de fonction, en expliquant comment stocker
+ ensemble des fonctions prenant des paramètres différents, et comment mettre en
+ place l'appel à ces fonctions.
+
+Le code est téléchargeable à la fin de l'article.
+
+.. contents:: \
+ :depth: 1
+ :backlinks: top
+
+Présentation
+============
+
+Un tableur donc, comprend un mini langage. Quand on écrit dans une cellule
+`= 2 + 2` ou `sum(A1:C2)` on exécute une instruction et pour obtenir un
+résultat. Ce langage contient :
+
+:des valeurs:
+ `2`
+
+:des fonctions:
+ `+` ou `sum`
+
+:des références:
+ `A1` (qui contient à son tour le résultat d'un autre calcul)
+
+
+Tout cela peut être combiné, il est ainsi possible d'écrire `A2 + 1` ou
+`sum(C3:E4) + A2`, et le nombre de fonctions disponibles s'approche de la
+centaine. Dans le tableur, je souhaitai pouvoir enrichir les fonctions
+disponibles en en ajoutant sans avoir à recompiler l'application (par exemple
+avec un système de *plugin*).
+
+En quelque sorte, mon but est de pouvoir enregistrer la fonction dans un
+catalogue, et que celle-ci soit appelée automatiquement. Par exemple on peut
+imaginer quelque chose comme :
+
+.. code-block:: ocaml
+
+ (* Enregistrer la fonction + dans le catalogue :
+ la fonction prend deux paramètres, tous les deux de type int
+ elle renvoie une valeur également de type int
+ *)
+ Catalog.register2 "+" (t_int, t_int) t_int (fun x y -> x + y);
+
+ (* Enregistrer la fonction sum dans le catalogue
+ la fonction prend un paramètre, qui est une liste une int
+ elle renvoie une valeur, qui est de type int
+ *)
+ register1 "sum" (t_list t_int) t_int (fun x -> List.fold_left (+) 0 x);
+
+ (* Appeler la fonction "+" avec deux paramètres *)
+ let arg1 = …
+ and arg2 = … in
+ eval2 "+" arg1 arg2;
+
+Je vais montrer comment y parvenir à travers une méthode qui *garantie* à la
+compilation que les fonctions font bien ce que l'on attend d'elles.
+
+Les garanties d'un compilateur
+==============================
+
+Du point de vue d'un programmeur, on s'attend à avoir certaines garanties de la
+part du compilateur du programme :
+
+1. La cohérence des types.
+
+ .. code-block:: ocaml
+
+ let ajoute_2 (x:int) = x + 2
+
+ Dans la ligne écrite ci-dessus, nous avons déclaré que la variable `x` était
+ de type `int`. Il est donc inutile de tester si c'est bien le cas (en OCaml
+ du moins, mais certains langages ne permettent pas d'ajouter cette
+ information).
+
+ Si le programme a été compilé, alors on peut avoir l'assurance que la
+ fonction sera appelée uniquement avec des variables de type `int`.
+
+ Cette contrainte peut être vérifiée au moment de la compilation du programme.
+
+2. La cohérence durant l'exécution.
+
+ Si le langage permet d'avoir plusieurs fonctions avec le même
+ nom, (par exemple une fonction `+` qui ajoute deux nombres, et une fonction
+ `+` qui ajoute un nombre à une date, alors je dois être sûr qu'au moment où
+ j'appelle `date_du jour + 2`, je n'appelle pas la même fonction qu'au moment
+ où j'appelle `2 + 2`.
+
+ Puisque l'on ne sait pas à l'avance quelle fonction sera appelée (puisque
+ cela est réalisé de manière dynamique), il est nécessaire de mettre en place
+ un contrôle à chaque appel de fonction.
+
+Et maintenant, quelle fonction vais-je devoir appeler quand j'écris `A2 + 2`.
+On ne sait pas quelle est la valeur de `A2`, et l'on ne peut donc pas savoir
+quelle est la fonction à appeler. Il nous faut donc avoir une information pour
+être sûr de pouvoir garantir ces deux contraintes à tout moment dans le
+programme : le type.
+
+Typons nos données
+==================
+
+Dans un langage de programmation typé, la nature de chaque variable est
+connue (liste, booléen, nombre entier…), le compilateur est donc capable de
+savoir quelle est la fonction à appeler à partir de cette information. Eh bien
+pour s'en sortir, nous allons devoir faire pareil, et, à tout moment, conserver
+cette information.
+
+Par exemple dans `A2 + 2`, on ne sait pas quelle est la fonction `+` à
+appeler, mais on connait le contenu de la variable `A2`. En suivant le fil des
+valeurs, on est ainsi capable de trouver les bonnes informations (et lever une
+erreur en disant qu'il n'est pas possible d'appeler la fonction `+` en lui
+donnant des arguments de types `bool` et `int`).
+
+Quels sont les types dont nous avons besoin ? Je propose que nous fassions
+notre exemple avec deux seulement pour commencer : les `int` et les `bool`.
+
+.. code-block:: ocaml
+
+ (*On définit un type générique, qui peut être paramétré*)
+ type 'a typ
+
+ (*Et deux variantes*)
+ val t_bool: bool typ
+ val t_int: int typ
+
+
+Ici, nous venons de déclarer un type nommé `typ` (quelle originalité !) qui
+peut être d'un type quelconque. Cette information est destinée au compilateur
+(elle ne sera plus disponible après), et lui permet de mettre en place des
+contraintes dans les signatures (par exemple une fonction qui prend en
+paramètre un `bool typ` ne pourra pas être appelée avec un argument de type
+`int typ`).
+
+Ce type est proposé sous forme de deux déclinaisons, qui correspondent aux deux
+variantes que nous souhaitons prendre en charge dans notre application.
+
+En utilisant cette définition, il devient facile de donner la signature de la
+fonction `register2` que nous avons cité au début de l'article :
+
+.. code-block:: ocaml
+
+ val register2:
+ string -> (* Le nom de la fonction à enregistrer *)
+ ('a typ * 'b typ) ->(* Sa signature *)
+ 'c typ -> (* Le type de retour *)
+ ( 'a -> 'b -> 'c) (* La fonction en elle-même*)
+ -> unit
+
+Il faut ici prêter attentions aux `a` `b` `c` qui apparaissent. Le `a` et le
+`b` qui apparaissent dans la signature signifient que la fonction prend en
+paramètre un type `a` et `b`. Si ces valeurs ne correspondent pas, le
+compilateur OCaml va rejeter le programme en indiquant que les valeurs sont
+différentes.
+
+Cette solution permet de répondre au problème de la *cohérence des types* que
+nous avons expliqué plus haut : les contrôles sont désormais à la charge du
+compilateur.
+
+Et concrètement ?
+=================
+
+En présentant notre type de données `'a typ`, j'ai précisé que le `'a` était
+destiné au compilateur et n'était plus disponible après. Si l'on souhaite juste
+s'en servir pour mettre en place des contrôles à la compilation, alors il est
+possible de l'implémenter sous la forme d'un `type fantôme (en)`_. Mais dans
+notre utilisation, cela n'est pas suffisant : il faut conserver cette
+information pour contrôler au moment d'un appel que les paramètres donnés
+correspondent à ceux attendus.
+
+.. _type fantôme (en): https://wiki.haskell.org/Phantom_type
+
+C'est là qu'interviennent les GADTs. Cette syntaxe nous permet d'écrire un type
+somme, et d'associer à chaque élément un type différent :
+
+.. code-block:: ocaml
+
+ type _ typ =
+ | Bool: bool typ
+ | Int: int typ
+
+Nous venons ici de créer un constructeur `Bool` (sans paramètres), ayant pour
+type `bool typ` et un second constructeur `Int` ayant pour type `int typ`. Armé
+de ces deux constructeurs, il est facile d'écrire les types `t_bool` et `t_int`
+que nous avons défini dans notre signature :
+
+.. code-block:: ocaml
+
+ let t_bool = Bool
+ and t_int = Int
+
+Pourquoi mettre en place un type somme ?
+----------------------------------------
+
+Cela permet de fermer la liste des types possibles : dans notre interface, nous
+avons déclaré un type abstrait `'a typ` ouvert, mais en interne, nous aurons
+juste à faire du *pattern matching* sur les constructeurs `Bool` et `Int`. On
+peut ainsi tester l'exhaustivité des cas à chaque fois que l'on souhaite faire
+une opération sur les types disponibles.
+
+Comment on l'utilise ?
+----------------------
+
+Alors, là il va falloir compliquer un peu l'écriture de notre code. En effet,
+la fonction qui reçoit en paramètre notre GADT doit être capable de traiter des
+paramètres de types différents, ce que le compilateur OCaml ne tolère pas par
+défaut. Il faut explicitement déclarer nos paramètres (ce qui rend l'écriture
+un peu plus verbeuse).
+
+Si l'on souhaite écrire une fonction qui retourne le nom de chaque type il va
+falloir écrire notre fonction comme cela :
+
+.. code-block:: ocaml
+
+ let print_typ: type a. a typ -> string = begin function
+ | Bool -> "Bool"
+ | Int -> "Int"
+ end
+
+
+Revenons en à nos données
+=========================
+
+Maintenant que nos types sont posés, nous allons pouvoir traiter nos données de
+la même manière. Pour commencer, nous allons créer un type de données qui sera
+le *miroir* de celui utilisé pour déclarer nos types :
+
+.. code-block:: ocaml
+
+ type _ value =
+ | Bool: bool -> bool value
+ | Int: int -> int value
+
+La déclaration est similaire à celle du type `'a typ`, mais cette fois, les
+constructeurs prennent chacun un paramètre (qui est en accord avec le type de
+chaque valeur).
+
+Avec nos deux types `value` et `typ`, nous allons pouvoir faire des choses
+intéressantes :
+
+Déduire le type à partir d'une valeur
+-------------------------------------
+
+La fonction est assez simple (elle tient en quelques lignes), mais elle montre
+comment il est possible de transposer l'information contenue dans la structure de
+données : en effet, comme nos deux types peuvent être mis en correspondance —
+l'information qu'ils portent est la même. Il est donc possible pour tout `a
+value` de fournir un `a typ`, tout en conservant la cohérence de l'information
+:
+
+.. code-block:: ocaml
+
+ (* Extract the type from a boxed value *)
+ let type_of_value: type a. a value -> a typ = begin function
+ | Bool b -> Bool
+ | Int n -> Int
+ end
+
+Dans le cadre de notre catalogue, cette fonction va permettre de transformer
+les arguments donnés à l'appel de la fonction, pour les comparer avec la
+signature de la fonction enregistrée.
+
+Construire une valeur à partir d'un type
+----------------------------------------
+
+Cette fois, il s'agit de l'opération inverse, mais nous avons besoin d'une
+information supplémentaire (puisque le type `'a typ` est un type somme sans
+paramètre). Par contre, nous pouvons demander au compilateur de s'assurer que
+les valeurs données en paramètre de la fonction sont les bons :
+
+.. code-block:: ocaml
+
+ let build_value: type a. a typ -> a -> a value = fun typ content ->
+ begin match typ, content with
+ | Bool, x -> Bool x
+ | Int, x -> Int x
+ end
+
+La signature de la fonction oblige à donner en paramètre un `a typ`, un `a` et
+donne en retour un `a value`, et ce *quel que soit* le type de `a`.
+
+Dans notre catalogue de fonction, cette fonction nous permet de reconstruire
+notre données, une fois que l'on a appelé la fonction enregistrée, en effet, on
+connait le type de retour de la fonction, et la valeur est en accord avec ce
+type. Avec ces deux informations, il est facile de reconstruire notre résultat.
+
+Construire un type existentiel
+------------------------------
+
+Jusqu'à présent, nous avons toujours créé des fonctions qui prenaient
+l'information du type à traiter en paramètre. Si nous souhaitons créer une
+fonction qui puisse retourner un résultat *de n'importe quel type* nous ne
+pouvons procéder ainsi.
+
+Notre fonction `eval` doit être en mesure de retourner une donnée inconnue
+(puisque cela dépend de la fonction appelée), et OCaml n'autorise pas une
+fonction à retourner un type inconnu :
+
+.. code-block:: ocaml
+
+ TODO
+
+Pour pouvoir faire ce que l'on souhaite, il faut encapsuler notre retour dans
+un type existentiel. Il s'agit d'un type qui ne porte pas l'information de la
+donnée qu'il contient :
+
+.. code-block:: ocaml
+
+ type result =
+ | Result : 'a value -> result
+
+
+Avec ce type, il devient possible de coder le retour de nos fonctions
+d'évaluations, (qui retourneront une valeur de type `result`) :
+
+.. code-block:: ocaml
+
+ (** Create a result from a known type and a value *)
+ let inject: type a. a typ -> a -> result = fun typ res ->
+ Result (build_value typ res)
+
+Cet type ne contient pas d'information sur son contenu, mais puisqu'il a été
+créé à partir d'une valeur valide, il est possible de décomposer cette valeur.
+Par exemple :
+
+.. code-block:: ocaml
+
+ (* Décompose le retour d'un appel *)
+ let Result r = … in
+ let type_of = type_of_value r in
+ …
+
+Récupérer la valeur
+-------------------
+
+La dernière chose dont nous avons besoin est de pouvoir extraire la valeur qui
+est contenu dans notre type. Là encore le code est vraiment simple puisqu'il
+s'agit de faire du *pattern matching* :
+
+.. code-block:: ocaml
+
+ (** Get the value out of the box *)
+ let get_value_content: type a. a value -> a = function
+ | Bool b -> b
+ | Int n -> n
+
+On constate en lisant la signature que là encore, aucune information de type
+n'est inventée, tout est déjà déduit à partir des données déjà existantes.
+
+Et notre dictionnaire ?
+=======================
+
+Maintenant que les concepts sont posés, il ne reste qu'à les mettre en œuvre.
+Nous allons représenter notre dictionnaire sous la forme d'une table
+associative, dont la clef sera un couple `nom de la fonction * signature`, et
+la valeur associée sera un triplet `signature * type de retour * fonction à
+appeler`.
+
+Nous avons besoin de stocker la signature de la fonction pour la comparer avec
+les paramètres donnés en arguments. Par contre, il sera là encore nécessaire de
+l'encapsuler dans un type existentiel pour pouvoir l'utiliser de manière
+générique :
+
+
+.. code-block:: ocaml
+
+ type _ sig_typ =
+ | T1: 'a typ -> 'a sig_typ
+ | T2: 'a typ * 'b typ -> ('a * 'b) sig_typ
+
+ type t_signature =
+ | Sig : 'a sig_typ -> t_signature
+
+`T1` est la signature d'une fonction n'ayant qu'un argument, `T2` est une
+signature à deux paramètres.
+
+En présente de la même manière nos fonctions :
+
+.. code-block:: ocaml
+
+ type t_function =
+ | Fn1: 'a typ * 'b typ * ('a -> 'b) -> t_function
+ | Fn2: ('a * 'b) sig_typ * 'c typ * ('a -> 'b -> 'c) -> t_function
+
+
+Une fonction peut se présenter comme ayant 1 ou 2 paramètres, et est dans tous
+les cas, enregistrée avec :
+
+- Le type des arguments qu'elle reçoit
+- Le type de retour
+- La fonction à exécuter
+
+Remplissons notre catalogue
+---------------------------
+
+Avec ces nouveaux types, nous pouvons construire notre dictionnaire de données,
+et y insérer nos fonctions à appeler :
+
+.. code-block:: ocaml
+
+ let (catalog:t_function Catalog.t ref) = ref Catalog.empty
+
+ let register name signature f = begin
+ let name' = String.uppercase_ascii name in
+ catalog := Catalog.add (name', signature) f !catalog
+ end
+
+ let register2: type a b c. string -> (a typ * b typ) -> c typ -> ( a -> b -> c) -> unit = begin
+ fun name (typ1, typ2) result f ->
+ let signature = T2(typ1, typ2) in
+ register name (Sig signature) (Fn2 (signature, result, f))
+ end
+
+La fonction `register2` correspond exactement à l'implémentation de celle
+donnée dans l'introduction. Le catalogue est conservé comme une référence
+mutable et mis à jour à à chaque appel de la fonction `register`.
+
+Appelons les fonctions
+----------------------
+
+L'appel d'une fonction va se décomposer en deux étapes :
+
+1. La recherche dans le catalogue d'une fonction ayant le même nom et la même
+ signature que les arguments d'appels
+2. Le contrôle que la fonction que l'on a pu obtenir présente bien la même
+ signature que les arguments d'appels.
+
+Pourquoi ces deux étapes ? Car même si notre fonction `register2` empêche que
+l'on écrive n'importe quoi dans notre catalogue, la structure du catalogue
+autorise d'y insérer des données incohérentes. Le compilateur OCaml nous oblige
+à faire le contrôle pour que l'on puisse appeler la fonction.
+
+Et comment fait-on ce contrôle ? Me direz-vous ? En contrôlant `l'égalité des
+types`_ : le type `eq` présenté dans les exemples avancés est exactement ce
+dont nous avons besoin, il suffit juste d'adapter la fonction `eq_type` donné
+dans l'exemple pour tester un type de signature et le résultat est présenté
+ci-dessous :
+
+.. _l'égalité des types: https://caml.inria.fr/pub/docs/manual-ocaml/extn.html#sec238
+
+.. code-block:: ocaml
+
+ let find_function name signature = begin
+ Catalog.find (String.uppercase_ascii name, (Sig signature)) !catalog
+ end
+
+ let eval2 name (Result p1) (Result p2) = begin
+ (* Construit la signature à partir des paramètres *)
+ let signature = T2 ((type_of_value p1), (type_of_value p2)) in
+ try
+ (* Recherche dans le catalogue *)
+ begin match find_function name signature with
+ | Fn2 (fn_sig, returnType, f) ->
+ (* Réalise le contrôle de type sur la signature de la fonction *)
+ begin match eq_sig_typ signature fn_sig with Eq ->
+ (* Appelle la fonction *)
+ let result = f (get_value_content p1) (get_value_content p2) in
+ (* Injecte le résultat de notre appel. *)
+ inject returnType result
+ end
+ | _ -> raise Not_found
+ end
+ with Not_found ->
+ print_error name signature;
+ raise Not_found
+ end
+
+La ligne la plus importante est celle-ci :
+
+.. code-block:: ocaml
+
+ begin match eq_sig_typ signature fn_sig with Eq ->
+
+La fonction `eq_sig_typ` prend en paramètres deux signatures, et renvoie `Eq` si
+et seulement si les deux signatures sont identiques. Cette information est
+déduite par le compilateur OCaml, et c'est seulement grâce à la présence de ce
+contrôle qu'il autorise l'appel à une fonction inconnue à la compilation, avec
+des paramètres également inconnus au moment de la compilation.
+
+.. note::
+
+ Il est possible de se passer de ce double contrôle en réécrivant nous-même
+ notre type `Map` pour garantir que les valeurs portent les même informations
+ de type que les clefs, mais cela sort du cadre de cet article.
+
+Terminons
+=========
+
+Tout est en place, il ne reste plus qu'à enregistrer les fonctions dans notre
+catalogue :
+
+.. code-block:: ocaml
+
+ (* nom signature retour fonction *)
+ register2 "=" (t_int, t_int) t_bool (=);
+ register2 "<>" (t_int, t_int) t_bool (<>);
+
+ register2 "+" (t_int, t_int) t_int (+);
+ register2 "*" (t_int, t_int) t_int ( * );
+ register2 "/" (t_int, t_int) t_int (/);
+ register2 "-" (t_int, t_int) t_int (-);
+
+ (* nom signature retour fonction *)
+ register2 "=" (t_bool, t_bool) t_bool (=);
+ register2 "<>" (t_bool, t_bool) t_bool (<>);
+
+ register1 "not" t_bool t_bool not;
+ register2 "and"(t_bool, t_bool) t_bool (&&);
+ register2 "or" (t_bool, t_bool) t_bool (||);
+
+
+Et enfin testons :
+
+
+.. code-block:: ocaml
+
+ let i2 = inject t_int 2
+ and i3 = inject t_int 3
+ and b1 = inject t_bool true in
+ let r1 = eval2 "=" i2 i3 in (* r1 vaut Bool false *)
+ let r2 = eval1 "not" r1 in (* r2 vaut Bool true *)
+ let r3 = C.eval2 "=" b1 r2 in (* r3 vaut Bool true *)
+ let Result value = r3 in (* Extrait la valeur *)
+ match value with (* Teste le résultat *)
+ | Int n -> Printf.printf "%d\n" n
+ | Bool b -> Printf.printf "%b\n" b (* Doit afficher true *)
+
+.. code-block:: console
+
+ $ ocaml catalog.ml
+ true
+
+Nous avons appelé ici la fonction `=` une fois sur des entiers, une fois sur
+des booléens, et à chaque fois, la fonction à appeler a été déduite des
+arguments passés en paramètres. En cas d'appel avec de mauvais types, l'erreur
+n'est pas détectée à la compilation, mais à l'exécution :
+
+.. code-block:: console
+
+ $ ocaml wrong_catalog.ml
+ There is no function '=' with signature (Int, Bool)
+
+
+.. figure:: {filename}/images/package-x-generic.png
+ :figclass: floatleft
+ :alt: get the file
+ :target: {filename}/resources/catalog.ml
+
+ Télécharger
+
+J'espère avoir été assez clair dans les explications. Le code à télécharger
+reprend la totalité des exemples présentés ici.
+
+Pour aller plus loin, il reste à enrichir les différents types (en introduction
+j'ai présenté le type `t_list` qui n'a pas été décrit, mais qui peut également
+s'intégrer dans ce schéma), et gérer une plus grande arité dans les fonctions
+(dans le tableur, il existe des fonctions qui ne prennent pas de paramètres,
+telle `rand()` ou `true()` ou davantage que deux).
+
+
+On pourrait également mettre en place une généricité des types (la fonction `=`
+peut s'appliquer quel que soit le type de paramètres passés en arguments), mais
+cela dépasse le simple catalogue que je présente ici.
+
diff --git a/content/images/catalog/catalog.jpg b/content/images/catalog/catalog.jpg
new file mode 100644
index 0000000..f13a03a
--- /dev/null
+++ b/content/images/catalog/catalog.jpg
Binary files differ
diff --git a/content/images/catalog/catalog_75.jpg b/content/images/catalog/catalog_75.jpg
new file mode 100644
index 0000000..b72f00a
--- /dev/null
+++ b/content/images/catalog/catalog_75.jpg
Binary files differ
diff --git a/content/resources/catalog.ml b/content/resources/catalog.ml
new file mode 100644
index 0000000..e624315
--- /dev/null
+++ b/content/resources/catalog.ml
@@ -0,0 +1,196 @@
+exception TypeError
+exception RegisteredFunction
+
+(*** Type definitions *)
+
+type _ typ =
+ | Bool: bool typ
+ | Int: int typ
+
+let t_bool= Bool
+let t_int = Int
+
+(* Encode type equality *)
+type (_,_) eq = Eq : ('a,'a) eq
+
+let eq_typ: type a b. a typ -> b typ -> (a, b) eq = fun a b ->
+ begin match a, b with
+ | Bool, Bool -> Eq
+ | Int, Int -> Eq
+ | _ -> raise TypeError
+end
+
+let print_typ: type a. Buffer.t -> a typ -> unit = fun printer typ -> match typ with
+ | Bool -> Printf.bprintf printer "Bool"
+ | Int -> Printf.bprintf printer "Int"
+
+(*** Values definitions *)
+
+type 'a value =
+ | Bool: bool -> bool value
+ | Int: int -> int value
+
+(** Get the value out of the box *)
+let get_value_content: type a. a value -> a = function
+ | Bool b -> b
+ | Int n -> n
+
+(** Create a value from a known type and an unboxed value *)
+let build_value: type a. a typ -> a -> a value = begin fun typ content ->
+ match typ, content with
+ | Bool, x -> Bool x
+ | Int, x -> Int x
+end
+
+(* Extract the type from a boxed value *)
+let type_of_value: type a. a value -> a typ = function
+ | Bool b -> Bool
+ | Int n -> Int
+
+type result =
+ | Result : 'a value -> result
+
+(** Create a result from a known type and a value *)
+let inject: type a. a typ -> a -> result = fun typ res ->
+ Result (build_value typ res)
+
+(** Catalog for all functions *)
+module C = struct
+
+ type _ sig_typ =
+ | T1: 'a typ -> 'a sig_typ
+ | T2: 'a typ * 'b typ -> ('a * 'b) sig_typ
+
+ let eq_sig_typ: type a b. a sig_typ -> b sig_typ -> (a, b) eq = fun a b ->
+ begin match a, b with
+ | T1(a), T1(b) -> eq_typ a b
+ | T2(a, b), T2(c, d) ->
+ begin match (eq_typ a c), (eq_typ b d) with
+ | Eq, Eq -> Eq
+ end
+ | _ -> raise TypeError
+ end
+
+ let print_sig_typ: type a. Buffer.t -> a sig_typ -> unit = begin fun printer typ -> match typ with
+ | T1 a -> Printf.bprintf printer "(%a)"
+ print_typ a
+ | T2 (a, b) -> Printf.bprintf printer "(%a, %a)"
+ print_typ a
+ print_typ b
+ end
+
+ type t_signature =
+ | Sig : 'a sig_typ -> t_signature
+
+ type t_function =
+ | Fn1: 'a typ * 'b typ * ('a -> 'b) -> t_function
+ | Fn2: ('a * 'b) sig_typ * 'c typ * ('a -> 'b -> 'c) -> t_function
+
+ module Catalog = Map.Make(
+ struct
+ type t = string * t_signature
+ let compare = Pervasives.compare
+
+ end
+ )
+
+ let (catalog:t_function Catalog.t ref) = ref Catalog.empty
+
+ let register name signature f = begin
+ let name' = String.uppercase_ascii name in
+ catalog := Catalog.add (name', signature) f !catalog
+ end
+
+ let find_function name signature = begin
+ Catalog.find (String.uppercase_ascii name, (Sig signature)) !catalog
+ end
+
+ let print_error: type a. string -> a sig_typ -> unit = begin fun name signature ->
+ let buffer = Buffer.create 16 in
+ print_sig_typ buffer signature;
+
+ Printf.printf "There is no function '%s' with signature %s\n"
+ name
+ (Buffer.contents buffer);
+ end
+
+ let eval1 name (Result p1) = begin
+ let signature = type_of_value p1 in
+ try
+ begin match find_function name (T1 signature) with
+ | Fn1 (fn_sig, returnType, f) ->
+ (* We check the type equality between the function signature and the parameters type *)
+ begin match eq_typ fn_sig signature with Eq ->
+ inject returnType (f (get_value_content p1))
+ end
+ | _ -> raise Not_found
+ end
+ with Not_found ->
+ print_error name (T1 signature);
+ raise Not_found
+ end
+
+ let eval2 name (Result p1) (Result p2) = begin
+ let signature = T2 ((type_of_value p1), (type_of_value p2)) in
+ try
+ begin match find_function name signature with
+ | Fn2 (fn_sig, returnType, f) ->
+ (* We check the type equality between the function signature and the parameters type *)
+ begin match eq_sig_typ signature fn_sig with Eq ->
+ inject returnType (
+ f (get_value_content p1) (get_value_content p2)
+ )
+ end
+ | _ -> raise Not_found
+ end
+ with Not_found ->
+ print_error name signature;
+ raise Not_found
+ end
+
+end
+
+let register1: type a b. string -> a typ -> b typ -> (a -> b) -> unit = begin
+ fun name typ1 returnType f ->
+ let signature = C.T1(typ1) in
+ C.register name (C.Sig signature) (C.Fn1 (typ1, returnType, f))
+end
+
+let register2: type a b c. string -> (a typ * b typ) -> c typ -> ( a -> b -> c) -> unit = begin
+ fun name (typ1, typ2) result f ->
+ let signature = C.T2(typ1, typ2) in
+ C.register name (C.Sig signature) (C.Fn2 (signature, result, f))
+end
+
+(* Register the standard functions *)
+
+let () = begin
+
+ register2 "=" (t_int, t_int) t_bool (=);
+ register2 "<>" (t_int, t_int) t_bool (<>);
+
+ register2 "+" (t_int, t_int) t_int (+);
+ register2 "*" (t_int, t_int) t_int ( * );
+ register2 "/" (t_int, t_int) t_int (/);
+ register2 "-" (t_int, t_int) t_int (-);
+
+ register2 "=" (t_bool, t_bool) t_bool (=);
+ register2 "<>" (t_bool, t_bool) t_bool (<>);
+
+ register1 "not" t_bool t_bool not;
+ register2 "and"(t_bool, t_bool) t_bool (&&);
+ register2 "or" (t_bool, t_bool) t_bool (||);
+
+
+ let i2 = inject t_int 2
+ and i3 = inject t_int 3
+ and b1 = inject t_bool true in
+ let r1 = C.eval2 "=" i2 i3 in
+ let r2 = C.eval1 "not" r1 in
+ let r3 = C.eval2 "=" b1 r2 in
+ let Result value = r3 in
+ match value with
+ | Bool b -> Printf.printf "%b\n" b
+ | Int n -> Printf.printf "%d\n" n
+
+end