From: admin <admin@vouivredigital.com>
Date: Sun, 26 Nov 2023 08:27:07 +0000 (+0900)
Subject: Automake
X-Git-Tag: v0.2.0~6
X-Git-Url: https://git.vouivredigital.com/?a=commitdiff_plain;h=5d69b0a4023ee0caecad7c116a2f2aaf68aed5de;p=vouivre.git

Automake
---

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..0a123e7
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,65 @@
+*.eps
+*.go
+*.log
+*.pdf
+*.png
+*.tar.xz
+*.tar.gz
+*.tmp
+*~
+.#*
+\#*\#
+,*
+/ABOUT-NLS
+/INSTALL
+/aclocal.m4
+/autom4te.cache
+/build-aux/ar-lib
+/build-aux/compile
+/build-aux/config.guess
+/build-aux/config.rpath
+/build-aux/config.sub
+/build-aux/depcomp
+/build-aux/install-sh
+/build-aux/mdate-sh
+/build-aux/missing
+/build-aux/test-driver
+/build-aux/texinfo.tex
+/config.status
+/configure
+/doc/*.1
+/doc/.dirstamp
+/doc/contributing.*.texi
+/doc/*.aux
+/doc/*.cp
+/doc/*.cps
+/doc/*.fn
+/doc/*.fns
+/doc/*.html
+/doc/*.info
+/doc/*.info-[0-9]
+/doc/*.ky
+/doc/*.pg
+/doc/*.toc
+/doc/*.t2p
+/doc/*.tp
+/doc/*.vr
+/doc/*.vrs
+/doc/stamp-vti
+/doc/version.texi
+/doc/version-*.texi
+/m4/*
+/pre-inst-env
+/test-env
+/test-tmp
+/tests/*.trs
+GPATH
+GRTAGS
+GTAGS
+Makefile
+Makefile.in
+config.cache
+stamp-h[0-9]
+tmp
+/.version
+/doc/stamp-[0-9]
diff --git a/AUTHORS b/AUTHORS
new file mode 100644
index 0000000..5dedf35
--- /dev/null
+++ b/AUTHORS
@@ -0,0 +1,3 @@
+Contributors to Vouivre 0.1.0:
+
+    Vouivre Digital Corporation <admin@vouivredigital.com>
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..e69de29
diff --git a/HACKING b/HACKING
new file mode 100644
index 0000000..b7de064
--- /dev/null
+++ b/HACKING
@@ -0,0 +1,37 @@
+# -*- mode: org; coding: utf-8; -*-
+
+#+TITLE: Hacking Vouivre
+
+* Requirements
+
+To build the system you will need:
+  - autoconf
+  - automake
+  - guile
+  - guix[fn:: This (somewhat big) dependency is used to download the MNIST
+    dataset automatically. It can be avoided by downloading and extracting both
+    train-images-idx3-ubyte.gz and train-labels-idx1-ubyte.gz from
+    [[http://yann.lecun.com/exdb/mnist][the official website]] to a 'mnist' directory at the project's
+    root, and hacking vouivre/mnist.scm to remove the dependency.]
+
+* Building
+
+#+BEGIN_SRC bash
+  autoreconf -vif
+  ./configure
+  make
+#+END_SRC
+
+* Testing
+
+#+BEGIN_SRC bash
+  make check
+#+END_SRC
+
+* Installing
+
+Install the Scheme source code and generated binaries so that Guile can find
+them:
+#+BEGIN_SRC bash
+  make install
+#+END_SRC
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..3d3a8f6
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,103 @@
+bin_SCRIPTS = examples/example.scm \
+              examples/base.scm
+
+# Handle substitution of fully-expanded Autoconf variables.
+do_subst = $(SED)					\
+  -e 's,[@]GUILE[@],$(GUILE),g'				\
+  -e 's,[@]guilemoduledir[@],$(guilemoduledir),g'	\
+  -e 's,[@]guileobjectdir[@],$(guileobjectdir),g'	\
+  -e 's,[@]localedir[@],$(localedir),g'
+
+nodist_noinst_SCRIPTS = pre-inst-env
+
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
+godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
+ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
+
+nobase_dist_mod_DATA = $(filter-out $(BUILT_SOURCES),$(SOURCES)) $(NOCOMP_SOURCES)
+nobase_nodist_mod_DATA = $(BUILT_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files.  See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_dist_modDATA
+
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+	$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_TARGET) $(GUILE_WARNINGS) -o "$@" "$<"
+
+SOURCES = vouivre.scm \
+          language/vouivre/decompile-tree-il.scm \
+          language/vouivre/spec.scm \
+          language/vouivre/compile-tree-il.scm \
+          vouivre/hconfig.scm \
+          vouivre/curry.scm \
+          vouivre/autodiff.scm \
+          vouivre/misc.scm \
+          vouivre/promises.scm \
+          vouivre/mnist.scm
+
+TESTS = tests/curry.scm \
+        tests/autodiff.scm
+
+TEST_EXTENSIONS = .scm
+SCM_LOG_DRIVER =                                \
+  $(top_builddir)/pre-inst-env                  \
+  $(GUILE) --no-auto-compile -e main            \
+      $(top_srcdir)/build-aux/test-driver.scm
+
+# Tell 'build-aux/test-driver.scm' to display only source file names,
+# not indivdual test names.
+AM_SCM_LOG_DRIVER_FLAGS = --brief=yes
+
+AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
+
+AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
+
+info_TEXINFOS = doc/version.texi \
+                doc/vouivre.texi
+
+EXTRA_DIST = README.org \
+             README \
+             HACKING \
+             COPYING \
+             doc/vouivre.info \
+             doc/version.info \
+             doc/.dirstamp \
+             doc/stamp-vti \
+             NEWS \
+             AUTHORS \
+             ChangeLog \
+             guix.scm \
+             .gitignore \
+             hall.scm \
+             build-aux/texinfo.tex \
+             build-aux/mdate-sh \
+             build-aux/test-driver.scm \
+             build-aux/missing \
+             build-aux/install-sh \
+             configure.ac \
+             pre-inst-env.in \
+             Makefile.am \
+             build-aux/test-driver.scm \
+             $(TESTS)
+
+ACLOCAL_AMFLAGS = -I m4
+
+AM_DISTCHECK_DVI_TARGET = info # Disable DVI as part of distcheck
+
+clean-go:
+	-$(RM) $(GOBJECTS)
+.PHONY: clean-go
+
+CLEANFILES =					\
+  $(BUILT_SOURCES)				\
+  $(GOBJECTS)					\
+  $(TESTS:tests/%.scm=%.log)
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..a635e87
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,14 @@
+# -*- mode: org; coding: utf-8; -*-
+
+#+TITLE: Vouivre NEWS – history of user-visible changes
+#+STARTUP: content hidestars
+
+Copyright © (2023) Vouivre Digital Corporation <admin@vouivredigital.com>
+
+  Copying and distribution of this file, with or without modification,
+  are permitted in any medium without royalty provided the copyright
+  notice and this notice are preserved.
+
+Please send Vouivre bug reports to admin@vouivredigital.com.
+
+* Publication at 0.1.0
diff --git a/README b/README
new file mode 120000
index 0000000..314e17d
--- /dev/null
+++ b/README
@@ -0,0 +1 @@
+README.org
\ No newline at end of file
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..7b57c19
--- /dev/null
+++ b/README.org
@@ -0,0 +1,4 @@
+# -*- mode: org; coding: utf-8; -*-
+
+#+TITLE: README for Vouivre
+
diff --git a/autodiff-tests.scm b/autodiff-tests.scm
deleted file mode 100644
index ef638ff..0000000
--- a/autodiff-tests.scm
+++ /dev/null
@@ -1,368 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre autodiff tests)
-  #:use-module ((vouivre autodiff) #:prefix v:)
-  #:use-module (ice-9 receive)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-64)
-  #:use-module (vouivre misc)
-  #:export
-  (apply-diff
-   a~
-   const-generator
-   differentiable-func-generator
-   lambda-const-call
-   ndiff
-   n~
-   random-array
-   random-array-shape
-   random-func1
-   random-func2
-   random-func2-rank&dims>0
-   random-input
-   random-list-element
-   random-non-empty-array
-   random-shape
-   random-shared
-   random-shared-array-rank&dims>0
-   random-shared-contractible
-   with-generators
-   ~))
-
-(define f1s (list v:abs v:cos v:exp v:identity v:sin))
-(define f2s (list v:+ v:- v:* v:max v:min))
-
-(define (with-generators% generators equal proc1 proc2 . more)
-  "Check that all procedures return the same value according to `equal' when
-evaluated on arguments produced by the generators (the number of generators
-being the number of arguments to each procedure."
-  (let ((times 100)
-	(procs (cons proc1 (cons proc2 more))))
-    (call/cc
-     (lambda (break)
-       (do ((i 0 (1+ i)))
-	   ((= i times) #t)
-	 (let ((zs (map-in-order (lambda (g) (g)) generators)))
-	   (with-exception-handler
-	       (lambda (e)
-		 (break #f zs))
-	     (lambda ()
-	       (let* ((rs (map (lambda (f) (apply f zs)) procs))
-		      (head (car rs)))
-		 (unless (every (lambda (x) (equal x head))
-				(cdr rs))
-		   (break #f zs rs))))
-	     #:unwind? #t)))))))
-
-(define-syntax-rule (with-generators (g1 g2 ...) equal expected given more ...)
-  (with-generators% (list g1 g2 ...) equal expected given more ...))
-
-(define (lambda-const-call f . consts)
-  (lambda _
-    (apply f consts)))
-
-(define* (random-array-shape
-	  #:optional (min-rank 0) (max-rank 5) (min-dim 0) (max-dim 5))
-  (list-tabulate (+ min-rank (random (- max-rank min-rank)))
-		 (lambda _ (+ min-dim (random (- max-dim min-dim))))))
-
-(define (random-shape)
-  (if (= 0 (random 2))
-      0
-      (random-array-shape)))
-
-(define* (random-array #:optional shape)
-  (apply produce-typed-array
-	 (lambda _ (random:uniform))
-	 v:*atype* (or shape (random-array-shape))))
-
-(define (random-non-empty-array)
-  "Random array of at least one element."
-  (random-array (random-array-shape 0 5 1 5)))
-
-(define* (random-input #:optional shape)
-  (let ((shape (or shape (random-shape))))
-    (if (eq? 0 shape)
-	(random:uniform)
-	(random-array shape))))
-
-(define (random-shared)
-  (let ((shape (random-shape)))
-    (values
-     (lambda ()
-       (random-input shape))
-     (lambda ()
-       (let ((x (random-input
-		 (random-list-element
-		  (list 0 (if (list? shape)
-			      shape
-			      (random-shape)))))))
-	 (set! shape (random-shape))
-	 x)))))
-
-(define (random-shared-array-rank&dims>0)
-  (let ((shape (random-array-shape 1 5 1 5)))
-    (values
-     (lambda ()
-       (random-array shape))
-     (lambda ()
-       (let ((x (random-array shape)))
-	 (set! shape (random-array-shape 1 5 1 5))
-	 x)))))
-
-(define (random-list-element lst)
-  (list-ref lst (random (length lst))))
-
-(define (const-generator generator)
-  (lambda ()
-    generator))
-
-(define (differentiable-func-generator lst . input-generators)
-  (lambda ()
-    (random-list-element
-     (cons
-      (apply
-       lambda-const-call
-       (random-list-element lst)
-       (map (lambda (g) (g))
-	    input-generators))
-      lst))))
-
-(define random-func1
-  (differentiable-func-generator f1s random-input))
-(define random-func2
-  (receive (gx gy) (random-shared)
-    (differentiable-func-generator f2s gx gy)))
-
-(define* (n~ x y #:optional (error 1e-4))
-  (and
-   (>= y (- x error))
-   (<= y (+ x error))))
-
-(define* (a~ x y #:optional (error 1e-4))
-  (and
-   (equal? (array-dimensions x)
-	   (array-dimensions y))
-   (call/cc
-    (lambda (break)
-      (array-for-each
-       (lambda (x y)
-	 (unless (~ x y error)
-	   (break #f)))
-       x y)
-      #t))))
-
-(define* (~ x y #:optional (error 1e-4))
-  (cond
-   ((and (number? x) (number? y))
-    (n~ x y error))
-   ((and (array? x) (array? y))
-    (a~ x y error))
-   (else #f)))
-
-(define* (ndiff f #:optional (axis 0) (step 1e-6))
-  "Differentiation using a numerical centered difference approximation."
-  (define (axis-add xs dh . indices)
-    "Add `dh' to the number or array at the given `axis' of `xs',
-and, when it's an array, at the given index."
-    (map-indexed
-     (lambda (x i)
-       (ifn (= i axis)
-	    x
-	    (if (number? x)
-		(+ x dh)
-		(array-map-indexed
-		 (lambda (x . indices_)
-		   (ifn (equal? indices indices_)
-			x
-			(+ x dh)))
-		 x))))
-     xs))
-  (lambda xs
-    ;; We need the output shape and the input shape along the
-    ;; differentiated axis.
-    (let ((fxs (apply f xs))
-	  (x (list-ref xs axis)))
-      (cond
-       ((and (number? fxs)
-	     (number? x))
-	(/ (- (apply f (axis-add xs step))
-	      (apply f (axis-add xs (- step))))
-	   (* 2 step)))
-       ((and (number? fxs)
-	     (array? x))
-	(apply
-	 produce-typed-array
-	 (lambda indices
-	   (/ (- (apply f (apply axis-add xs step indices))
-		 (apply f (apply axis-add xs (- step) indices)))
-	      (* 2 step)))
-	 v:*atype*
-	 (array-dimensions x)))
-       ((and (array? fxs)
-	     (number? x))
-	((v:extend /)
-	 ((v:extend -)
-	  (apply f (axis-add xs step))
-	  (apply f (axis-add xs (- step))))
-	 (* 2 step)))
-       ((and (array? fxs)
-	     (array? x))
-	(let ((a (apply
-		  make-typed-array v:*atype* *unspecified*
-		  (append (array-dimensions fxs)
-			  (array-dimensions x)))))
-	  (for-indices-in-range
-	   (lambda indices-in
-	     (let ((dfxs ((v:extend /)
-			  ((v:extend -)
-			   (apply f (apply axis-add xs step indices-in))
-			   (apply f (apply axis-add xs (- step) indices-in)))
-			  (* 2 step))))
-	       (for-indices-in-range
-		(lambda indices-out
-		  (apply
-		   array-set!
-		   a
-		   (apply array-ref dfxs indices-out)
-		   (append indices-out indices-in)))
-		(list-zeros (array-rank fxs))
-		(array-dimensions fxs))))
-	   (list-zeros (array-rank x))
-	   (array-dimensions x))
-	  a))))))
-
-(define* (apply-diff differentiator #:optional (axis 0))
-  "Apply a differentiator (`ndiff', `fdiff', `rdiff') to a function and its
-arguments (this is a convenience function)."
-  (lambda (f . args)
-    (apply (differentiator f axis) args)))
-
-(test-begin "autodiff")
-
-;; not differentiating
-(test-assert (with-generators (random-input) ~ (v:extend identity) v:identity))
-(test-assert (with-generators (random-input) ~ (v:extend exp) v:exp))
-(test-assert
-    (receive (gx gy) (random-shared)
-      (with-generators (gx gy) ~ (v:extend *) v:*)))
-
-;; differentiation in one variable
-(test-assert
-    (with-generators
-     (random-func1 random-input)
-     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
-
-;; `v:mean' only takes non-empty arrays so we treat it separately
-(test-assert
-    (with-generators
-     ((differentiable-func-generator (list v:mean) random-non-empty-array)
-      random-non-empty-array)
-     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
-
-;; differentiation in two variables
-(test-assert
-    (receive (gx gy) (random-shared)
-      (with-generators
-       (random-func2 gx gy)
-       ~ (apply-diff ndiff 0) (apply-diff v:fdiff 0) (apply-diff v:rdiff 0))))
-(test-assert
-    (receive (gx gy) (random-shared)
-      (with-generators
-       (random-func2 gx gy)
-       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
-
-;; `v:amap2' only takes arrays of rank > 0 and batch-size > 0 so we treat it
-;; separately
-(define random-func2-rank&dims>0
-  (receive (gx gy) (random-shared-array-rank&dims>0)
-    (differentiable-func-generator f2s gx gy)))
-(test-assert
-    (receive (gx gy) (random-shared-array-rank&dims>0)
-      (with-generators
-       ((const-generator v:amap2) random-func2-rank&dims>0 gx gy)
-       ;; NOTE: for `v:amap2' the differentiable axes are 1 and 2.
-       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
-(test-assert
-    (receive (gx gy) (random-shared-array-rank&dims>0)
-      (with-generators
-       ((const-generator v:amap2) random-func2-rank&dims>0 gx gy)
-       ~ (apply-diff ndiff 2) (apply-diff v:fdiff 2) (apply-diff v:rdiff 2))))
-(let* ((z #(1 2 3))
-       (f (lambda (a)
-	    (v:amap2 (lambda (x y)
-		       (v:* a a))
-		     #(10 20 30)
-		     #(40 50 60))))
-       (e ((ndiff f) z)))
-  (test-assert (~ e ((v:fdiff f) z)))
-  (test-assert (~ e ((v:rdiff f) z))))
-
-;; `v:adot'
-(define (random-shared-contractible)
-  "Returns three generators: the first two generate arrays that are contractible
-according to the number generated by the third one."
-  (let* ((n (random 5))
-	 (sa (random-array-shape n))
-	 (sb (append (reverse (take (reverse sa)
-				    n))
-		     (random-array-shape 0 (- 5 n)))))
-    (values
-     (lambda ()
-       (random-array sa))
-     (lambda ()
-       (random-array sb))
-     (lambda ()
-       (let ((tmp n))
-	 (set! n (random 5))
-	 (set! sa (random-array-shape n))
-	 (set! sb (append (reverse (take (reverse sa)
-					 n))
-			  (random-array-shape 0 (- 5 n))))
-	 tmp)))))
-(test-assert
-    (receive (gx gy gz) (random-shared-contractible)
-      (with-generators
-       ((const-generator v:adot) gx gy gz)
-       ~ (apply-diff ndiff 0) (apply-diff v:fdiff 0) (apply-diff v:rdiff 0))))
-(test-assert
-    (receive (gx gy gz) (random-shared-contractible)
-      (with-generators
-       ((const-generator v:adot) gx gy gz)
-       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
-
-;; let binding re-entry
-(test-assert
-    (with-generators
-     ((const-generator
-       (lambda (x)
-	 (let ((c (v:maximum x)))
-	   (v:+ c (v:- x c)))))
-      random-non-empty-array)
-     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
-
-;; chain rule
-(test-assert
-    (with-generators
-     (random-func1 random-func1 random-input)
-     ~
-     (lambda (f g x) ((ndiff (compose f g)) x))
-     (lambda (f g x) ((v:fdiff (compose f g)) x))
-     (lambda (f g x) ((v:rdiff (compose f g)) x))))
-
-(test-end "autodiff")
diff --git a/autodiff.scm b/autodiff.scm
deleted file mode 100644
index d243107..0000000
--- a/autodiff.scm
+++ /dev/null
@@ -1,876 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre autodiff)
-  #:use-module (ice-9 receive)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (vouivre misc)
-  #:use-module (vouivre promises)
-  #:export
-  (*atype*
-   adot
-   amap2
-   contract-arrays
-   differentiable-wrapper
-   dot
-   do-times
-   ewise1
-   ewise2
-   extend
-   fdiff
-   rdiff
-   make-batch
-   make-internal
-   maximum
-   mean
-   rank-of
-   sum)
-  #:replace
-  ((i:sqrt . sqrt)
-   (i:exp . exp)
-   (i:expt . expt)
-   (i:log . log)
-   (i:sin . sin)
-   (i:cos . cos)
-   (i:tan . tan)
-   (i:+ . +)
-   (i:- . -)
-   (i:* . *)
-   (i:/ . /)
-   (i:max . max)
-   (i:min . min)
-   (i:abs . abs)
-   (i:identity . identity)
-   (i:array-ref . array-ref)
-   (i:array-cell-ref . array-cell-ref))
-  #:re-export
-  (fold
-   reduce))
-
-;;;; array utilities
-
-(define (rel->abs indices dimensions)
-  (let rec ((s 0)
-	    (p 1)
-	    (is (reverse indices))
-	    (ds (reverse dimensions)))
-    (if (null? is)
-	s
-	(rec (+ s (* p (car is)))
-	     (* p (car ds))
-	     (cdr is)
-	     (cdr ds)))))
-
-(define(do-times n proc)
-  (let rec ((i 0))
-    (unless (= i n)
-      (proc i)
-      (rec (1+ i)))))
-
-(define (contract-arrays a b n)
-  (let* ((dims-a (array-dimensions a))
-	 (dims-b (array-dimensions b))
-	 (free-dims-a (take dims-a (- (array-rank a) n)))
-	 (free-dims-b (drop dims-b n))
-	 (bound-dims (take dims-b n))
-	 (n-free-dims-a (apply * free-dims-a))
-	 (n-free-dims-b (apply * free-dims-b))
-	 (n-bound-dims (apply * bound-dims))
-	 (s 0)
-	 (r (apply make-typed-array *atype* *unspecified* (append free-dims-a
-								  free-dims-b)))
-	 (ac (array-contents a))
-	 (bc (array-contents b))
-	 (rc (array-contents r)))
-    (do-times
-     n-free-dims-a
-     (lambda (i)
-       (let ((i-k (* n-bound-dims i))
-	     (i-j (* n-free-dims-b i)))
-	 (do-times
-	  n-free-dims-b
-	  (lambda (j)
-	    (set! s 0)
-	    (do-times
-	     n-bound-dims
-	     (lambda (k)
-	       (set! s (+ s (* (array-ref ac (+ i-k k))
-			       (array-ref bc (+ (* n-free-dims-b k) j)))))))
-	    (array-set! rc s (+ i-j j)))))))
-    r))
-
-;;;; utilities that work on both numbers and arrays
-
-(define (extend f)
-  "Extend a function of one or more scalars to apply to numbers/arrays
-element-wise. All arrays must have the same dimension."
-  (define (apply-elemwise f indices args)
-    (apply f (map (lambda (x)
-		    (if (number? x)
-			x
-			(apply array-ref x indices)))
-		  args)))
-  (lambda xs
-    (if-let (x (find array? xs))
-	    (apply
-	     produce-typed-array
-	     (lambda is
-	       (apply-elemwise f is xs))
-	     *atype*
-	     (array-dimensions x))
-	    (apply f xs))))
-
-(define (dot x y n)
-  (cond
-   ((and (number? x) (number? y))
-    (* x y))
-   ((and (array? x) (array? y))
-    (contract-arrays x y n))
-   ((and (array? x) (number? y))
-    ((extend *) x y))
-   ((and (number? x) (array? y))
-    ((extend *) x y))
-   (else (error "can't dot because of invalid types or ranks" x y n))))
-
-(define (rank-of x)
-  (if (number? x)
-      0
-      (array-rank x)))
-
-;;;; differentiation
-
-(define-record-type internal
-  (make-internal forward jacobian)
-  internal?
-  (forward internal-forward)
-  (jacobian internal-jacobian))
-
-;;(define *atype* 'f32)
-(define *atype* #t)
-(define *differentiation-mode* (make-parameter #f))
-(define *n-y-dims* (make-parameter #f))
-(define *j* (make-parameter #f))
-
-(define-syntax-rule (w/j val body ...)
-  (parameterize ((*j* val))
-    body ...))
-
-(define (wrap axis)
-  (lambda (x i)
-    (if (= i axis)
-	(make-internal x 'input)
-	x)))
-
-(define (unwrap-fwd x)
-  (if (internal? x)
-      (internal-forward x)
-      x))
-
-(define (unwrap-jac x)
-  (if (internal? x)
-      (internal-jacobian x)
-      x))
-
-(define (dims-of x)
-  (if (number? x)
-      '()
-      (array-dimensions x)))
-
-(define (add dst-buf src-buf n-dims)
-  (do-times
-   n-dims
-   (lambda (i)
-     (array-set!
-      dst-buf
-      (+ (array-ref dst-buf i)
-	 (array-ref src-buf i))
-      i)))
-  dst-buf)
-
-(define (movg dst-buf n-dst-dims generator naked-inputs data j)
-  (do-times
-   n-dst-dims
-   (lambda (i)
-     (array-set!
-      dst-buf
-      (apply generator naked-inputs i j data)
-      i)))
-  dst-buf)
-
-(define (addg dst-buf n-dst-dims generator naked-inputs data j)
-  (do-times
-   n-dst-dims
-   (lambda (i)
-     (array-set!
-      dst-buf
-      (+ (array-ref dst-buf i)
-	 (apply generator naked-inputs i j data))
-      i)))
-  dst-buf)
-
-(define (movc dst-buf n-dst-dims src-buf n-src-dims
-	      generator naked-inputs data)
-  "Contract the Jacobian column produced by the generator with the source buffer
-storing the result in the destination buffer."
-  (let ((s 0))
-    (do-times
-     n-dst-dims
-     (lambda (i)
-       (set! s 0)
-       (do-times
-	n-src-dims
-	(lambda (k)
-	  (set! s (+ s (* (apply generator naked-inputs i k data)
-			  (array-ref src-buf k))))))
-       (array-set! dst-buf s i))))
-  dst-buf)
-
-(define (addc dst-buf n-dst-dims src-buf n-src-dims
-	      generator naked-inputs data)
-  "Contract the Jacobian column produced by the generator with the source buffer
-adding the result to the destination buffer."
-  (let ((s 0))
-    (do-times
-     n-dst-dims
-     (lambda (i)
-       (set! s (array-ref dst-buf i))
-       (do-times
-	n-src-dims
-	(lambda (k)
-	  (set! s (+ s (* (apply generator naked-inputs i k data)
-			  (array-ref src-buf k))))))
-       (array-set! dst-buf s i))))
-  dst-buf)
-
-(define (transpose-generator generator)
-  (lambda (xs i j . data)
-    (apply generator xs j i data)))
-
-(define* (fdiff f #:optional (axis 0))
-  (lambda xs
-    (parameterize (((@@ (vouivre autodiff) *differentiation-mode*) 'fwd)
-		   ((@@ (vouivre autodiff) *promises*) (cons '() #f)))
-      (let* ((internal (apply f (map-indexed (wrap axis) xs)))
-	     (fx (internal-forward internal))
-	     (y (list-ref xs axis))  ; variable to differentiate w.r.t
-	     (pre-Jx (internal-jacobian internal))
-	     (Jx (cond
-		  ;; TODO: implement 'input case and test 'zero and 'input
-		  ((eq? pre-Jx 'zero)
-		   (lambda (j)
-		     (lambda (i)
-		       0)))
-		  ((eq? pre-Jx 'input)
-		   (error "TBD."))
-		  (else
-		   (lambda (j)
-		     (reset-promises (car (*promises*)))
-		     (let ((column-jac (w/j j (force pre-Jx))))
-		       (lambda (i)
-			 (array-ref column-jac i))))))))
-	(cond
-	 ((and (number? fx) (number? y))
-	  ((Jx 0) 0))
-	 ((and (number? fx) (array? y))
-	  (let* ((y-dims (array-dimensions y))
-		 (a (apply make-array *unspecified* y-dims))
-		 (ac (array-contents a)))
-	    (do-times
-	     (apply * y-dims)
-	     (lambda (j)
-	       (array-set! ac ((Jx j) 0)
-			   j)))
-	    a))
-	 ((and (array? fx) (number? y))
-	  (let* ((fx-dims (array-dimensions fx))
-		 (a (apply make-array *unspecified* fx-dims))
-		 (ac (array-contents a))
-		 (Jx (Jx 0)))
-	    (do-times
-	     (apply * fx-dims)
-	     (lambda (i)
-	       (array-set! ac (Jx i)
-			   i)))
-	    a))
-	 (else
-	  (let* ((fx-dims (array-dimensions fx))
-		 (y-dims (array-dimensions y))
-		 (n-fx-dims (apply * fx-dims))
-		 (n-y-dims (apply * y-dims))
-		 (a (apply make-array *unspecified* (append fx-dims y-dims)))
-		 (ac (array-contents a)))
-	    (do-times
-	     n-y-dims
-	     (lambda (j)
-	       (let ((Jx (Jx j)))
-		 (do-times
-		  n-fx-dims
-		  (lambda (i)
-		    (array-set! ac (Jx i)
-				(+ j (* n-y-dims i))))))))
-	    a)))))))
-
-(define* (rdiff f #:optional (axis 0))
-  (lambda xs
-    (parameterize (((@@ (vouivre autodiff) *differentiation-mode*) 'rev)
-		   ((@@ (vouivre autodiff) *promises*) (cons '() #f)))
-      (let* ((internal (apply f (map-indexed (wrap axis) xs)))
-	     (fx (internal-forward internal))
-	     (y (list-ref xs axis))  ; variable to differentiate w.r.t
-	     (y-dims (dims-of y))
-	     (pre-Jx (internal-jacobian internal))
-	     (Jx (cond
-		  ;; TODO: implement 'input case and test 'zero and 'input
-		  ((eq? pre-Jx 'zero)
-		   (lambda (i)
-		     (lambda (j)
-		       0)))
-		  ((eq? pre-Jx 'input)
-		   (error "TBD."))
-		  (else
-		   (let ((pre-Jx (pre-Jx #f)))
-		     (lambda (i)
-		       (let ((row-jac (pre-Jx i)))
-			 (lambda (j)
-			   (array-ref row-jac j)))))))))
-	(parameterize ((*n-y-dims* (apply * y-dims)))
-	  (cond
-	   ((and (number? fx) (number? y))
-	    ((Jx 0) 0))
-	   ((and (number? fx) (array? y))
-	    (let* ((a (apply make-array *unspecified* y-dims))
-		   (ac (array-contents a))
-		   (Jx (Jx 0)))
-	      (do-times
-	       (*n-y-dims*)
-	       (lambda (j)
-		 (array-set! ac (Jx j)
-			     j)))
-	      a))
-	   ((and (array? fx) (number? y))
-	    (let* ((fx-dims (array-dimensions fx))
-		   (a (apply make-array *unspecified* fx-dims))
-		   (ac (array-contents a)))
-	      (do-times
-	       (apply * fx-dims)
-	       (lambda (i)
-		 (array-set! ac ((Jx i) 0)
-			     i)))
-	      a))
-	   (else
-	    (let* ((fx-dims (array-dimensions fx))
-		   (n-fx-dims (apply * fx-dims))
-		   (a (apply make-array *unspecified* (append fx-dims y-dims)))
-		   (ac (array-contents a)))
-	      (do-times
-	       n-fx-dims
-	       (lambda (i)
-		 (let ((Jx (Jx i)))
-		   (do-times
-		    (*n-y-dims*)
-		    (lambda (j)
-		      (array-set! ac (Jx j)
-				  (+ j (* (*n-y-dims*) i))))))))
-	      a))))))))
-
-;; In the comment that follows:
-;;
-;; `n' is the number of arguments to `proc'.
-;; `generators is not a `Vec' but a `List' we only use the former to illustrate
-;; its length.
-;; `X1', ..., `Xn' are the types of inputs and thus `Array's of some dimension.
-;; `I' is the type of multi-indices indexing the output of `function'.
-;; `J' is the type of multi-indices indexing the input array being differentiated.
-;; `|I|' (resp. `|J|') is the type of absolute indices of `I' (resp. `J').
-;; `Array I' is the type of arrays indexed by multi-indices of `I'.
-;; `[X]' means that `X' is boxed in an internal as when returned by
-;;       `differentiable-wrapper' with the array being `X' and the promise that
-;;       given a |J| we will get the change of `X' with a change of the
-;;       the differentiated argument at multi-index `J'.
-;; (∷ (→ (Vec n (→ X1 ... Xn |I| |J| Number))
-;;       (→ X1 ... Xn (Array I))*
-;;       [X1] ... [Xn]
-;;       (Internal (Array I) (Promise |J| (Array |I|)))))
-;;
-;; (*) We extend this definition to allow `proc' to be a list of procedures
-;;     the head of which is as described above and the remaining elements
-;;     are procedures of the same arguments but returning values that are
-;;     then fed as extra data to the generators.
-;;
-;; NOTE: In cases where an argument isn't meant to be differentiable its
-;;       corresponding generator should be `#f'.
-(define (differentiable-wrapper generators proc* arg . more)
-  (define (precompute-data naked-args)
-    (if (procedure? proc*)
-	'()
-	(map (lambda (g)
-	       (apply g naked-args))
-	     (cdr proc*))))
-  (let* ((args (cons arg more))
-	 (proc (if (procedure? proc*)
-		   proc*
-		   (car proc*)))
-	 (naked-args (map unwrap-fwd args))
-	 (out (apply proc naked-args)))
-    (case (*differentiation-mode*)
-      ((#f)
-       out)
-      ((fwd)
-       (let* ((data (precompute-data naked-args))
-	      (n-out-dims (apply * (dims-of out)))
-	      (buf (make-array *unspecified* n-out-dims)))
-	 (make-internal
-	  out
-	  (fold
-	   (lambda (generator arg prev)
-	     (if (or (not (internal? arg))
-		     (eq? 'zero (internal-jacobian arg)))
-		 prev
-		 (let ((Jx (internal-jacobian arg))
-		       (n-fwd-dims (apply * (dims-of (unwrap-fwd arg)))))
-		   (if (eq? Jx 'input)
-		       (if (eq? prev 'zero)
-			   (delay
-			     (movg buf n-out-dims
-				   generator naked-args data (*j*)))
-			   (delay
-			     (addg (force prev) n-out-dims
-				   generator naked-args data (*j*))))
-		       (if (eq? prev 'zero)
-			   (delay
-			     (movc buf n-out-dims (force Jx) n-fwd-dims
-				   generator naked-args data))
-			   (delay
-			     (addc (force prev) n-out-dims
-				   (force Jx) n-fwd-dims
-				   generator naked-args data)))))))
-	   'zero generators args))))
-      ((rev)
-       (let ((data (precompute-data naked-args))
-	     (n-out-dims (apply * (dims-of out))))
-	 (make-internal
-	  out
-	  (fold
-	   (lambda (generator arg prev)
-	     (let ((generator (transpose-generator generator)))
-	       (if (or (not (internal? arg))
-		       (eq? 'zero (internal-jacobian arg)))
-		   prev
-		   (let* ((Jx (internal-jacobian arg))
-			  (n-fwd-dims (apply * (dims-of (unwrap-fwd arg)))))
-		     (if (eq? Jx 'input)
-			 (if (eq? prev 'zero)
-			     (lambda (buf?)
-			       (let ((dst-buf (make-array *unspecified*
-							  n-fwd-dims)))
-				 (if buf?
-				     (lambda (buf)
-				       (movc dst-buf n-fwd-dims
-					     buf n-out-dims
-					     generator naked-args data))
-				     (lambda (i)
-				       (movg dst-buf n-fwd-dims
-					     generator naked-args data
-					     i)))))
-			     (lambda (buf?)
-			       (let ((prev (prev buf?)))
-				 (if buf?
-				     (lambda (buf)
-				       (addc (prev buf) n-fwd-dims
-					     buf n-out-dims
-					     generator naked-args data))
-				     (lambda (i)
-				       (addg (prev i) n-fwd-dims
-					     generator naked-args data
-					     i))))))
-			 (if (eq? prev 'zero)
-			     (lambda (buf?)
-			       (let ((Jx (Jx #t))
-				     (dst-buf (make-array *unspecified*
-							  n-fwd-dims)))
-				 (if buf?
-				     (lambda (buf)
-				       (Jx
-					(movc dst-buf n-fwd-dims buf
-					      n-out-dims
-					      generator naked-args data)))
-				     (lambda (i)
-				       (Jx
-					(movg dst-buf n-fwd-dims
-					      generator naked-args data
-					      i))))))
-			     (lambda (buf?)
-			       (let ((prev (prev buf?))
-				     (Jx (Jx #t))
-				     (dst-buf (make-array *unspecified*
-							  n-fwd-dims)))
-				 (if buf?
-				     (lambda (buf)
-				       (add (prev buf)
-					    (Jx
-					     (movc dst-buf n-fwd-dims
-						   buf n-out-dims
-						   generator naked-args data))
-					    (*n-y-dims*)))
-				     (lambda (i)
-				       (add (prev i)
-					    (Jx
-					     (movg dst-buf n-fwd-dims
-						   generator naked-args data
-						   i))
-					    (*n-y-dims*))))))))))))
-	   'zero generators args)))))))
-
-(define (ewise1 f)
-  (lambda (xs i j)
-    (let ((x (car xs)))
-      (if (number? x)
-	  (f x)
-	  (ifn (= i j)
-	       0
-	       (f (array-ref (array-contents x)
-			     j)))))))
-
-(define (ewise2 proc axis)
-  (lambda (xs i j)
-    (let ((x (car xs))
-	  (y (cadr xs)))
-      (cond
-       ((and (number? x) (number? y))
-	(proc x y))
-       ((and (number? x) (array? y))
-	(if (= axis 0)
-	    (proc x (array-ref (array-contents y)
-			       i))
-	    (ifn (= i j)
-		 0
-		 (proc x (array-ref (array-contents y)
-				    j)))))
-       ((and (array? x) (number? y))
-	(if (= axis 1)
-	    (proc (array-ref (array-contents x)
-			     i)
-		  y)
-	    (ifn (= i j)
-		 0
-		 (proc (array-ref (array-contents x)
-				  j)
-		       y))))
-       (else
-	(ifn (= i j)
-	     0
-	     (proc (array-ref (array-contents x)
-			      j)
-		   (array-ref (array-contents y)
-			      j))))))))
-
-(define (i:identity x)
-  "Differentiable identity."
-  (differentiable-wrapper
-   (list (ewise1 (lambda _ 1)))
-   identity
-   x))
-
-(define (i:sqrt x)
-  "Differentiable square root."
-  (differentiable-wrapper
-   (list (ewise1 (lambda (x) (/ 1 2 (sqrt x)))))
-   (extend sqrt)
-   x))
-
-(define (i:exp x)
-  "Differentiable exponential."
-  (differentiable-wrapper
-   (list (ewise1 exp))
-   (extend exp)
-   x))
-
-(define (i:expt x y)
-  "Differentiable power."
-  (differentiable-wrapper
-   (list (ewise2 (lambda (x y) (* y (expt x (1- y)))) 0)
-	 (ewise2 (lambda (x y) (* (expt x y) (log x))) 1))
-   (extend expt)
-   x y))
-
-(define (i:log x)
-  "Differentiable logarithm."
-  (differentiable-wrapper
-   (list (ewise1 (lambda (x) (/ x))))
-   (extend log)
-   x))
-
-(define (i:sin x)
-  "Differentiable sine."
-  (differentiable-wrapper
-   (list (ewise1 cos))
-   (extend sin)
-   x))
-
-(define (i:cos x)
-  "Differentiable cosine."
-  (differentiable-wrapper
-   (list (ewise1 (lambda (x) (- (sin x)))))
-   (extend cos)
-   x))
-
-(define (i:tan x)
-  "Differentiable tangent."
-  (differentiable-wrapper
-   (list (ewise1 (lambda (x) (/ (expt (cos x) 2)))))
-   (extend tan)
-   x))
-
-(define (i:+ x y)
-  "Differentiable element-wise addition."
-  (differentiable-wrapper
-   (list
-    (ewise2 (lambda _ +1) 0)
-    (ewise2 (lambda _ +1) 1))
-   (extend +)
-   x y))
-
-(define (i:- x y)
-  "Differentiable element-wise subtraction."
-  (differentiable-wrapper
-   (list
-    (ewise2 (lambda _ +1) 0)
-    (ewise2 (lambda _ -1) 1))
-   (extend -)
-   x y))
-
-(define (i:* x y)
-  "Differentiable element-wise multiplication."
-  (differentiable-wrapper
-   (list
-    (ewise2 (lambda (x y) y) 0)
-    (ewise2 (lambda (x y) x) 1))
-   (extend *)
-   x y))
-
-(define (i:/ x y)
-  "Differentiable element-wise division."
-  (differentiable-wrapper
-   (list
-    (ewise2 (lambda (x y) (/ y)) 0)
-    (ewise2 (lambda (x y) (- (/ x y y))) 1))
-   (extend /)
-   x y))
-
-(define (i:max x y)
-  "Differentiable element-wise maximum."
-  (define (dmax x y)
-    (cond
-     ((> x y)
-      1)
-     ((= x y)
-      1/2)
-     (else
-      0)))
-  (differentiable-wrapper
-   (list
-    (ewise2 dmax 0)
-    (ewise2 (flip dmax) 1))
-   (extend max)
-   x y))
-
-(define (i:min x y)
-  "Differentiable element-wise minimum."
-  (define (dmin x y)
-    (cond
-     ((< x y)
-      1)
-     ((= x y)
-      1/2)
-     (else
-      0)))
-  (differentiable-wrapper
-   (list
-    (ewise2 dmin 0)
-    (ewise2 (flip dmin) 1))
-   (extend min)
-   x y))
-
-(define (i:abs x)
-  "Differentiable absolute."
-  (differentiable-wrapper
-   (list (ewise1 (lambda (x)
-		   (cond ((> x 0)
-			  +1)
-			 ((= x 0)
-			  1/2)
-			 ((< x 0)
-			  -1)))))
-   (extend abs)
-   x))
-
-(define (mean x)
-  "Differentiable mean on arrays."
-  (differentiable-wrapper
-   (list
-    (lambda (xs i j one-over-n)
-      one-over-n))
-   (let ((n 0))
-     (list
-      (lambda (x)
-	(let ((sum 0))
-	  (array-for-each
-	   (lambda (x)
-	     (set! sum (+ sum x))
-	     (set! n (1+ n)))
-	   x)
-	  (/ sum n)))
-      (lambda _ (/ n))))
-   x))
-
-(define (i:array-ref x . indices)
-  "Differentiable array-ref w.r.t `x'."
-  (apply
-   differentiable-wrapper
-   (cons
-    (lambda (xs i j abs-index)
-      (if (= j abs-index)
-	  1
-	  0))
-    (map not indices))
-   (list
-    array-ref
-    (lambda (x . indices)
-      (rel->abs indices (array-dimensions x))))
-   x indices))
-
-(define (i:array-cell-ref x . indices)
-  (apply
-   differentiable-wrapper
-   (cons
-    (lambda (xs i j abs-index n-rst-dims)
-      (receive (j-ref j-rst) (euclidean/ j n-rst-dims)
-	(if (and (= j-ref abs-index)
-		 (= j-rst i))
-	    1
-	    0)))
-    (map not indices))
-   (list
-    array-cell-ref
-    (lambda (x . indices)
-      (rel->abs indices (take (array-dimensions x)
-			      (length indices))))
-    (lambda (x . indices)
-      (apply * (drop (array-dimensions x)
-		     (length indices)))))
-   x indices))
-
-(define (make-batch elem . more)
-  (let ((batch-size (1+ (length more))))
-    (apply
-     differentiable-wrapper
-     (list-tabulate
-      batch-size
-      (lambda (b)
-	(lambda (xs i j n-rest-dims)
-	  (receive (i-batch i-rest) (euclidean/ i n-rest-dims)
-	    (if (and (= i-batch b)
-		     (= i-rest j))
-		1
-		0
-		)))))
-     (list
-      (lambda (elem . more)
-	(let ((a (apply make-typed-array *atype* *unspecified* batch-size
-			(dims-of elem))))
-	  (for-each
-	   (lambda (x b)
-	     (array-cell-set! a x b))
-	   (cons elem more)
-	   (list-tabulate batch-size identity))
-	  a))
-      (lambda (elem . more)
-	(apply * (dims-of elem))))
-     elem more)))
-
-(define (maximum x)
-  "Differentiable maximum on arrays."
-  (differentiable-wrapper
-   (list
-    (lambda (xs i j max-index)
-      (if (= j max-index)
-	  1
-	  0)))
-   (let ((max-index 'TBD))
-     (list
-      (lambda (x)
-	(let ((m (- (inf)))
-	      (i 0))
-	  (array-for-each
-	   (lambda (x)
-	     (when (< m x)
-	       (set! m x)
-	       (set! max-index i))
-	     (set! i (1+ i)))
-	   x)
-	  m))
-      (lambda _ max-index)))
-   x))
-
-(define (sum x)
-  "Differentiable sum on arrays."
-  (differentiable-wrapper
-   (list (lambda _ 1))
-   (lambda (x)
-     (let ((sum 0))
-       (array-for-each
-	(lambda (x)
-	  (set! sum (+ sum x)))
-	x)
-       sum))
-   x))
-
-(define (adot x y n)
-  (differentiable-wrapper
-   (list
-    (lambda (xs i j n-free-dims-y n-bound-dims)
-      (receive (i-x i-y) (euclidean/ i n-free-dims-y)
-	(receive (j-free j-bound) (euclidean/ j n-bound-dims)
-	  (ifn (= i-x j-free)
-	       0
-	       (array-ref (array-contents (cadr xs))
-			  (+ i-y (* n-free-dims-y j-bound)))))))
-    (lambda (xs i j n-free-dims-y n-bound-dims)
-      (receive (i-x i-y) (euclidean/ i n-free-dims-y)
-	(receive (j-bound j-free) (euclidean/ j n-free-dims-y)
-	  (ifn (= i-y j-free)
-	       0
-	       (array-ref (array-contents (car xs))
-			  (+ j-bound (* n-bound-dims i-x)))))))
-    #f)
-   (list
-    contract-arrays
-    (lambda (x y n)
-      (apply * (drop (array-dimensions y)
-		     n)))
-    (lambda (x y n)
-      (apply * (take (array-dimensions y)
-		     n))))
-   x y n))
-
-(define (amap2 f x y)
-  (apply make-batch
-	 (list-tabulate (car (dims-of (unwrap-fwd x)))
-			(lambda (b)
-			  (f (i:array-cell-ref x b)
-			     (i:array-cell-ref y b))))))
diff --git a/base.scm b/base.scm
deleted file mode 100644
index 8c62bae..0000000
--- a/base.scm
+++ /dev/null
@@ -1,605 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre base)
-  #:use-module ((guile) #:select (1+) #:prefix guile:)
-  #:use-module ((rnrs base) #:prefix rnrs:)
-  #:use-module ((srfi srfi-1) #:prefix srfi-1:)
-  #:use-module (vouivre curry)
-  #:export
-  (∘
-   ⊙
-   flip)
-  #:replace
-  (boolean?
-   not
-   symbol?
-   symbol->string
-   string->symbol
-   char?
-   char=?
-   char<?
-   char>?
-   char<=?
-   char>=?
-   integer->char
-   char->integer
-   list?
-   null?
-   pair?
-   cons
-   car
-   cdr
-   caar
-   cadr
-   cdar
-   cddr
-   caaar
-   cadar
-   cdaar
-   caddr
-   cdadr
-   cddar
-   cdddr
-   caaaar
-   caaadr
-   caadar
-   cadaar
-   cdaaar
-   cddaar
-   cdadar
-   cdaadr
-   cadadr
-   caaddr
-   caddar
-   cadddr
-   cdaddr
-   cddadr
-   cdddar
-   cddddr
-   number?
-   string?
-   procedure?
-   eq?
-   eqv?
-   equal?
-   symbol=?
-   complex?
-   real-part
-   imag-part
-   make-rectangular
-   make-polar
-   magnitude
-   angle
-   sqrt
-   exp
-   expt
-   log
-   sin
-   cos
-   tan
-   asin
-   acos
-   atan
-   real?
-   rational?
-   numerator
-   denominator
-   rationalize
-   exact?
-   inexact?
-   integer?
-   odd?
-   even?
-   gcd
-   lcm
-   exact-integer-sqrt
-   =
-   <
-   >
-   <=
-   >=
-   zero?
-   positive?
-   negative?
-   length
-   list-ref
-   list-tail
-   append
-   reverse
-   number->string
-   string->number
-   make-string
-   list->string
-   string->list
-   string-length
-   string-ref
-   string-copy
-   substring
-   string=?
-   string<?
-   string>?
-   string<=?
-   string>=?
-   string-append
-   +
-   -
-   *
-   /
-   max
-   min
-   abs
-   truncate
-   floor
-   ceiling
-   round
-   div
-   mod
-   real-valued?
-   rational-valued?
-   integer-valued?
-   nan?
-   infinite?
-   finite?
-   fold
-   fold-right
-   reduce
-   reduce-right
-   map
-   1+
-   identity))
-
-;; abbreviation
-(define-syntax cudefine (identifier-syntax curried-untyped-define))
-
-(∷ boolean? (0 . 0))
-(cudefine (boolean? x) (rnrs:boolean? x))
-
-(∷ not (0 . 0))
-(cudefine (not x) (rnrs:not x))
-
-(∷ symbol? (0 . 0))
-(cudefine (symbol? x) (rnrs:symbol? x))
-
-(∷ symbol->string (0 . 0))
-(cudefine (symbol->string x) (rnrs:symbol->string x))
-
-(∷ string->symbol (0 . 0))
-(cudefine (string->symbol x) (rnrs:string->symbol x))
-
-(∷ char? (0 . 0))
-(cudefine (char? x) (rnrs:char? x))
-
-(∷ char=? (0 . (0 . 0)))
-(cudefine (char=? x y) (rnrs:char=? x y))
-
-(∷ char<? (0 . (0 . 0)))
-(cudefine (char<? x y) (rnrs:char<? x y))
-
-(∷ char>? (0 . (0 . 0)))
-(cudefine (char>? x y) (rnrs:char>? x y))
-
-(∷ char<=? (0 . (0 . 0)))
-(cudefine (char<=? x y) (rnrs:char<=? x y))
-
-(∷ char>=? (0 . (0 . 0)))
-(cudefine (char>=? x y) (rnrs:char>=? x y))
-
-(∷ integer->char (0 . 0))
-(cudefine (integer->char x) (rnrs:integer->char x))
-
-(∷ char->integer (0 . 0))
-(cudefine (char->integer x) (rnrs:char->integer x))
-
-(∷ list? (0 . 0))
-(cudefine (list? x) (rnrs:list? x))
-
-(∷ null? (0 . 0))
-(cudefine (null? x) (rnrs:null? x))
-
-(∷ pair? (0 . 0))
-(cudefine (pair? x) (rnrs:pair? x))
-
-(∷ cons (0 . (0 . 0)))
-(cudefine (cons x y) (rnrs:cons x y))
-
-(∷ car (0 . 0))
-(cudefine (car x) (rnrs:car x))
-
-(∷ cdr (0 . 0))
-(cudefine (cdr x) (rnrs:cdr x))
-
-(∷ caar (0 . 0))
-(cudefine (caar x) (rnrs:caar x))
-
-(∷ cadr (0 . 0))
-(cudefine (cadr x) (rnrs:cadr x))
-
-(∷ cdar (0 . 0))
-(cudefine (cdar x) (rnrs:cdar x))
-
-(∷ cddr (0 . 0))
-(cudefine (cddr x) (rnrs:cddr x))
-
-(∷ caaar (0 . 0))
-(cudefine (caaar x) (rnrs:caaar x))
-
-(∷ caadr (0 . 0))
-(cudefine (caadr x) (rnrs:caadr x))
-
-(∷ cadar (0 . 0))
-(cudefine (cadar x) (rnrs:cadar x))
-
-(∷ cdaar (0 . 0))
-(cudefine (cdaar x) (rnrs:cdaar x))
-
-(∷ caddr (0 . 0))
-(cudefine (caddr x) (rnrs:caddr x))
-
-(∷ cdadr (0 . 0))
-(cudefine (cdadr x) (rnrs:cdadr x))
-
-(∷ cddar (0 . 0))
-(cudefine (cddar x) (rnrs:cddar x))
-
-(∷ cdddr (0 . 0))
-(cudefine (cdddr x) (rnrs:cdddr x))
-
-(∷ caaaar (0 . 0))
-(cudefine (caaaar x) (rnrs:caaaar x))
-
-(∷ caaadr (0 . 0))
-(cudefine (caaadr x) (rnrs:caaadr x))
-
-(∷ caadar (0 . 0))
-(cudefine (caadar x) (rnrs:caadar x))
-
-(∷ cadaar (0 . 0))
-(cudefine (cadaar x) (rnrs:cadaar x))
-
-(∷ cdaaar (0 . 0))
-(cudefine (cdaaar x) (rnrs:cdaaar x))
-
-(∷ cddaar (0 . 0))
-(cudefine (cddaar x) (rnrs:cddaar x))
-
-(∷ cdadar (0 . 0))
-(cudefine (cdadar x) (rnrs:cdadar x))
-
-(∷ cdaadr (0 . 0))
-(cudefine (cdaadr x) (rnrs:cdaadr x))
-
-(∷ cadadr (0 . 0))
-(cudefine (cadadr x) (rnrs:cadadr x))
-
-(∷ caaddr (0 . 0))
-(cudefine (caaddr x) (rnrs:caaddr x))
-
-(∷ caddar (0 . 0))
-(cudefine (caddar x) (rnrs:caddar x))
-
-(∷ cadddr (0 . 0))
-(cudefine (cadddr x) (rnrs:cadddr x))
-
-(∷ cdaddr (0 . 0))
-(cudefine (cdaddr x) (rnrs:cdaddr x))
-
-(∷ cddadr (0 . 0))
-(cudefine (cddadr x) (rnrs:cddadr x))
-
-(∷ cdddar (0 . 0))
-(cudefine (cdddar x) (rnrs:cdddar x))
-
-(∷ cddddr (0 . 0))
-(cudefine (cddddr x) (rnrs:cddddr x))
-
-(∷ number? (0 . 0))
-(cudefine (number? x) (rnrs:number? x))
-
-(∷ string? (0 . 0))
-(cudefine (string? x) (rnrs:string? x))
-
-(∷ procedure? (0 . 0))
-(cudefine (procedure? x) (rnrs:procedure? x))
-
-(∷ eq? (0 . (0 . 0)))
-(cudefine (eq? x y) (rnrs:eq? x y))
-
-(∷ eqv? (0 . (0 . 0)))
-(cudefine (eqv? x y) (rnrs:eqv? x y))
-
-(∷ equal? (0 . (0 . 0)))
-(cudefine (equal? x y) (rnrs:equal? x y))
-
-(∷ symbol=? (0 . (0 . 0)))
-(cudefine (symbol=? x y) (rnrs:symbol=? x y))
-
-(∷ complex? (0 . 0))
-(cudefine (complex? x) (rnrs:complex? x))
-
-(∷ real-part (0 . 0))
-(cudefine (real-part x) (rnrs:real-part x))
-
-(∷ imag-part (0 . 0))
-(cudefine (imag-part x) (rnrs:imag-part x))
-
-(∷ make-rectangular (0 . (0 . 0)))
-(cudefine (make-rectangular x y) (rnrs:make-rectangular x y))
-
-(∷ make-polar (0 . (0 . 0)))
-(cudefine (make-polar x y) (rnrs:make-polar x y))
-
-(∷ magnitude (0 . 0))
-(cudefine (magnitude x) (rnrs:magnitude x))
-
-(∷ angle (0 . 0))
-(cudefine (angle x) (rnrs:angle x))
-
-(∷ sqrt (0 . 0))
-(cudefine (sqrt x) (rnrs:sqrt x))
-
-(∷ exp (0 . 0))
-(cudefine (exp x) (rnrs:exp x))
-
-(∷ expt (0 . (0 . 0)))
-(cudefine (expt x y) (rnrs:expt x y))
-
-(∷ log (0 . 0))
-(cudefine (log x) (rnrs:log x))
-
-(∷ sin (0 . 0))
-(cudefine (sin x) (rnrs:sin x))
-
-(∷ cos (0 . 0))
-(cudefine (cos x) (rnrs:cos x))
-
-(∷ tan (0 . 0))
-(cudefine (tan x) (rnrs:tan x))
-
-(∷ asin (0 . 0))
-(cudefine (asin x) (rnrs:asin x))
-
-(∷ acos (0 . 0))
-(cudefine (acos x) (rnrs:acos x))
-
-(∷ atan (0 . 0))
-(cudefine (atan x) (rnrs:atan x))
-
-(∷ real? (0 . 0))
-(cudefine (real? x) (rnrs:real? x))
-
-(∷ rational? (0 . 0))
-(cudefine (rational? x) (rnrs:rational? x))
-
-(∷ numerator (0 . 0))
-(cudefine (numerator x) (rnrs:numerator x))
-
-(∷ denominator (0 . 0))
-(cudefine (denominator x) (rnrs:denominator x))
-
-(∷ rationalize (0 . (0 . 0)))
-(cudefine (rationalize x eps) (rnrs:rationalize x eps))
-
-(∷ exact? (0 . 0))
-(cudefine (exact? x) (rnrs:exact? x))
-
-(∷ inexact? (0 . 0))
-(cudefine (inexact? x) (rnrs:inexact? x))
-
-(∷ integer? (0 . 0))
-(cudefine (integer? x) (rnrs:integer? x))
-
-(∷ odd? (0 . 0))
-(cudefine (odd? x) (rnrs:odd? x))
-
-(∷ even? (0 . 0))
-(cudefine (even? x) (rnrs:even? x))
-
-(∷ gcd (0 . (0 . 0)))
-(cudefine (gcd x y) (rnrs:gcd x y))
-
-(∷ lcm (0 . (0 . 0)))
-(cudefine (lcm x y) (rnrs:lcm x y))
-
-(∷ exact-integer-sqrt (0 . 0))
-(cudefine (exact-integer-sqrt x) (rnrs:exact-integer-sqrt x))
-
-(∷ = (0 . (0 . 0)))
-(cudefine (= x y) (rnrs:= x y))
-
-(∷ < (0 . (0 . 0)))
-(cudefine (< x y) (rnrs:< x y))
-
-(∷ > (0 . (0 . 0)))
-(cudefine (> x y) (rnrs:> x y))
-
-(∷ <= (0 . (0 . 0)))
-(cudefine (<= x y) (rnrs:<= x y))
-
-(∷ >= (0 . (0 . 0)))
-(cudefine (>= x y) (rnrs:>= x y))
-
-(∷ zero? (0 . 0))
-(cudefine (zero? x) (rnrs:zero? x))
-
-(∷ positive? (0 . 0))
-(cudefine (positive? x) (rnrs:positive? x))
-
-(∷ negative? (0 . 0))
-(cudefine (negative? x) (rnrs:negative? x))
-
-(∷ length (0 . 0))
-(cudefine (length x) (rnrs:length x))
-
-(∷ list-ref (0 . (0 . 0)))
-(cudefine (list-ref lst k) (rnrs:list-ref lst k))
-
-(∷ list-tail (0 . (0 . 0)))
-(cudefine (list-tail lst k) (rnrs:list-tail lst k))
-
-(∷ append (0 . (0 . 0)))
-(cudefine (append x y) (rnrs:append x y))
-
-(∷ reverse (0 . 0))
-(cudefine (reverse x) (rnrs:reverse x))
-
-(∷ number->string (0 . (0 . 0)))
-(cudefine (number->string n radix) (rnrs:number->string n radix))
-
-(∷ string->number (0 . (0 . 0)))
-(cudefine (string->number str radix) (rnrs:string->number str radix))
-
-(∷ make-string (0 . (0 . 0)))
-(cudefine (make-string k char) (rnrs:make-string k char))
-
-(∷ list->string (0 . 0))
-(cudefine (list->string x) (rnrs:list->string x))
-
-(∷ string->list (0 . (0 . (0 . 0))))
-(cudefine (string->list str start end) (rnrs:string->list str start end))
-
-(∷ string-length (0 . 0))
-(cudefine (string-length x) (rnrs:string-length x))
-
-(∷ string-ref (0 . (0 . 0)))
-(cudefine (string-ref str k) (rnrs:string-ref str k))
-
-(∷ string-copy (0 . (0 . (0 . 0))))
-(cudefine (string-copy str start end) (rnrs:string-copy str start end))
-
-(∷ substring (0 . (0 . (0 . 0))))
-(cudefine (substring str start end) (rnrs:substring str start end))
-
-(∷ string=? (0 . (0 . 0)))
-(cudefine (string=? x y) (rnrs:string=? x y))
-
-(∷ string<? (0 . (0 . 0)))
-(cudefine (string<? x y) (rnrs:string<? x y))
-
-(∷ string>? (0 . (0 . 0)))
-(cudefine (string>? x y) (rnrs:string>? x y))
-
-(∷ string<=? (0 . (0 . 0)))
-(cudefine (string<=? x y) (rnrs:string<=? x y))
-
-(∷ string>=? (0 . (0 . 0)))
-(cudefine (string>=? x y) (rnrs:string>=? x y))
-
-(∷ string-append (0 . (0 . 0)))
-(cudefine (string-append x y) (rnrs:string-append x y))
-
-(∷ + (0 . (0 . 0)))
-(cudefine (+ x y) (rnrs:+ x y))
-
-(∷ - (0 . (0 . 0)))
-(cudefine (- x y) (rnrs:- x y))
-
-(∷ * (0 . (0 . 0)))
-(cudefine (* x y) (rnrs:* x y))
-
-(∷ / (0 . (0 . 0)))
-(cudefine (/ x y) (rnrs:/ x y))
-
-(∷ max (0 . (0 . 0)))
-(cudefine (max x y) (rnrs:max x y))
-
-(∷ min (0 . (0 . 0)))
-(cudefine (min x y) (rnrs:min x y))
-
-(∷ abs (0 . 0))
-(cudefine (abs x) (rnrs:abs x))
-
-(∷ truncate (0 . 0))
-(cudefine (truncate x) (rnrs:truncate x))
-
-(∷ floor (0 . 0))
-(cudefine (floor x) (rnrs:floor x))
-
-(∷ ceiling (0 . 0))
-(cudefine (ceiling x) (rnrs:ceiling x))
-
-(∷ round (0 . 0))
-(cudefine (round x) (rnrs:round x))
-
-(∷ div (0 . (0 . 0)))
-(cudefine (div x y) (rnrs:div x y))
-
-(∷ mod (0 . (0 . 0)))
-(cudefine (mod x y) (rnrs:mod x y))
-
-(∷ real-valued? (0 . 0))
-(cudefine (real-valued? x) (rnrs:real-valued? x))
-
-(∷ rational-valued? (0 . 0))
-(cudefine (rational-valued? x) (rnrs:rational-valued? x))
-
-(∷ integer-valued? (0 . 0))
-(cudefine (integer-valued? x) (rnrs:integer-valued? x))
-
-(∷ nan? (0 . 0))
-(cudefine (nan? x) (rnrs:nan? x))
-
-(∷ infinite? (0 . 0))
-(cudefine (infinite? x) (rnrs:infinite? x))
-
-(∷ finite? (0 . 0))
-(cudefine (finite? x) (rnrs:finite? x))
-
-(∷ fold ((0 . (0 . 0)) . (0 . (0 . 0))))
-(cudefine (fold f x xs)
-	  (srfi-1:fold
-	   (lambda (x prev)
-	     ((f x) prev))
-	   x xs))
-
-(∷ fold-right ((0 . (0 . 0)) . (0 . (0 . 0))))
-(cudefine (fold-right f x xs)
-	  (srfi-1:fold-right
-	   (lambda (x prev)
-	     ((f x) prev))
-	   x xs))
-
-(∷ reduce ((0 . (0 . 0)) . (0 . 0)))
-(cudefine (reduce f xs)
-	  (when (null? xs)
-	    (error "empty list"))
-	  (srfi-1:reduce
-	   (lambda (x prev)
-	     ((f x) prev))
-	   0
-	   xs))
-
-(∷ reduce-right ((0 . (0 . 0)) . (0 . 0)))
-(cudefine (reduce-right f xs)
-	  (when (null? xs)
-	    (error "empty list"))
-	  (srfi-1:reduce-right
-	   (lambda (x prev)
-	     ((f x) prev))
-	   0
-	   xs))
-
-(∷ map ((0 . 0) . (0 . 0)))
-(cudefine (map f xs) (srfi-1:map f xs))
-
-(∷ 1+ (0 . 0))
-(cudefine (1+ x) (guile:1+ x))
-
-(definec (identity x) x)
-(definec (∘ g f) (λc x (g (f x))))
-(definec (⊙ f g) (∘ g f))
-(definec (flip f) (λc y (λc x (f x y))))
diff --git a/boot.scm b/boot.scm
deleted file mode 100644
index 7b5a52a..0000000
--- a/boot.scm
+++ /dev/null
@@ -1,27 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define* (b #:optional test)
-  (load "misc.scm")
-  (load "curry.scm")
-  (load "compile-tree-il.scm")
-  (load "decompile-tree-il.scm")
-  (load "spec.scm")
-  (when test
-    (load "curry-tests.scm"))
-  (values))
-(b)
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
new file mode 100644
index 0000000..0c555ea
--- /dev/null
+++ b/build-aux/test-driver.scm
@@ -0,0 +1,179 @@
+;;;; test-driver.scm - Guile test driver for Automake testsuite harness
+
+(define script-version "2019-01-15.13") ;UTC
+
+;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co>
+;;;
+;;; This program is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;;; Commentary:
+;;;
+;;; This script provides a Guile test driver using the SRFI-64 Scheme API for
+;;; test suites.  SRFI-64 is distributed with Guile since version 2.0.9.
+;;;
+;;; This script is a lightly modified version of the orignal written by
+;;; Matthieu Lirzin.  The changes make it suitable for use as part of the
+;;; guile-hall infrastructure.
+;;;
+;;;; Code:
+
+(use-modules (ice-9 getopt-long)
+             (ice-9 pretty-print)
+             (srfi srfi-26)
+             (srfi srfi-64))
+
+(define (show-help)
+  (display "Usage:
+                         test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
+                         [--expect-failure={yes|no}] [--color-tests={yes|no}]
+                         [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--]
+               TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
+The '--test-name', '--log-file' and '--trs-file' options are mandatory.
+"))
+
+(define %options
+  '((test-name                  (value #t))
+    (log-file                   (value #t))
+    (trs-file                   (value #t))
+    (color-tests                (value #t))
+    (expect-failure             (value #t)) ;XXX: not implemented yet
+    (enable-hard-errors         (value #t)) ;not implemented in SRFI-64
+    (brief                      (value #t))
+    (help    (single-char #\h) (value #f))
+    (version (single-char #\V) (value #f))))
+
+(define (option->boolean options key)
+  "Return #t if the value associated with KEY in OPTIONS is 'yes'."
+  (and=> (option-ref options key #f) (cut string=? <> "yes")))
+
+(define* (test-display field value  #:optional (port (current-output-port))
+                       #:key pretty?)
+  "Display 'FIELD: VALUE\n' on PORT."
+  (if pretty?
+      (begin
+        (format port "~A:~%" field)
+        (pretty-print value port #:per-line-prefix "+ "))
+      (format port "~A: ~S~%" field value)))
+
+(define* (result->string symbol #:key colorize?)
+  "Return SYMBOL as an upper case string.  Use colors when COLORIZE is #t."
+  (let ((result (string-upcase (symbol->string symbol))))
+    (if colorize?
+        (string-append (case symbol
+                         ((pass)       "")  ;green
+                         ((xfail)      "")  ;light green
+                         ((skip)       "")  ;blue
+                         ((fail xpass) "")  ;red
+                         ((error)      "")) ;magenta
+                       result
+                       "")          ;no color
+        result)))
+
+(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port)
+  "Return an custom SRFI-64 test runner.  TEST-NAME is a string specifying the
+file name of the current the test.  COLOR? specifies whether to use colors,
+and BRIEF?, well, you know.  OUT-PORT and TRS-PORT must be output ports.  The
+current output port is supposed to be redirected to a '.log' file."
+
+  (define (test-on-test-begin-gnu runner)
+    ;; Procedure called at the start of an individual test case, before the
+    ;; test expression (and expected value) are evaluated.
+    (let ((result (cute assq-ref (test-result-alist runner) <>)))
+      (format #t "test-name: ~A~%" (result 'test-name))
+      (format #t "location: ~A~%"
+              (string-append (result 'source-file) ":"
+                             (number->string (result 'source-line))))
+      (test-display "source" (result 'source-form) #:pretty? #t)))
+
+  (define (test-on-test-end-gnu runner)
+    ;; Procedure called at the end of an individual test case, when the result
+    ;; of the test is available.
+    (let* ((results (test-result-alist runner))
+           (result? (cut assq <> results))
+           (result  (cut assq-ref results <>)))
+      (unless brief?
+        ;; Display the result of each test case on the console.
+        (format out-port "~A: ~A - ~A~%"
+                (result->string (test-result-kind runner) #:colorize? color?)
+                test-name (test-runner-test-name runner)))
+      (when (result? 'expected-value)
+        (test-display "expected-value" (result 'expected-value)))
+      (when (result? 'expected-error)
+        (test-display "expected-error" (result 'expected-error) #:pretty? #t))
+      (when (result? 'actual-value)
+        (test-display "actual-value" (result 'actual-value)))
+      (when (result? 'actual-error)
+        (test-display "actual-error" (result 'actual-error) #:pretty? #t))
+      (format #t "result: ~a~%" (result->string (result 'result-kind)))
+      (newline)
+      (format trs-port ":test-result: ~A ~A~%"
+              (result->string (test-result-kind runner))
+              (test-runner-test-name runner))))
+
+  (define (test-on-group-end-gnu runner)
+    ;; Procedure called by a 'test-end', including at the end of a test-group.
+    (let ((fail (or (positive? (test-runner-fail-count runner))
+                    (positive? (test-runner-xpass-count runner))))
+          (skip (or (positive? (test-runner-skip-count runner))
+                    (positive? (test-runner-xfail-count runner)))))
+      ;; XXX: The global results need some refinements for XPASS.
+      (format trs-port ":global-test-result: ~A~%"
+              (if fail "FAIL" (if skip "SKIP" "PASS")))
+      (format trs-port ":recheck: ~A~%"
+              (if fail "yes" "no"))
+      (format trs-port ":copy-in-global-log: ~A~%"
+              (if (or fail skip) "yes" "no"))
+      (when brief?
+        ;; Display the global test group result on the console.
+        (format out-port "~A: ~A~%"
+                (result->string (if fail 'fail (if skip 'skip 'pass))
+                                #:colorize? color?)
+                test-name))
+      #f))
+
+  (let ((runner (test-runner-null)))
+    (test-runner-on-test-begin! runner test-on-test-begin-gnu)
+    (test-runner-on-test-end! runner test-on-test-end-gnu)
+    (test-runner-on-group-end! runner test-on-group-end-gnu)
+    (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
+    runner))
+
+;;;
+;;; Entry point.
+;;;
+
+(define (main . args)
+  (let* ((opts   (getopt-long (command-line) %options))
+         (option (cut option-ref opts <> <>)))
+    (cond
+     ((option 'help #f)    (show-help))
+     ((option 'version #f) (format #t "test-driver.scm ~A" script-version))
+     (else
+      (let ((log (open-file (option 'log-file "") "w0"))
+            (trs (open-file (option 'trs-file "") "wl"))
+            (out (duplicate-port (current-output-port) "wl")))
+        (redirect-port log (current-output-port))
+        (redirect-port log (current-warning-port))
+        (redirect-port log (current-error-port))
+        (test-with-runner
+            (test-runner-gnu (option 'test-name #f)
+                             #:color? (option->boolean opts 'color-tests)
+                             #:brief? (option->boolean opts 'brief)
+                             #:out-port out #:trs-port trs)
+          (load-from-path (option 'test-name #f)))
+        (close-port log)
+        (close-port trs)
+        (close-port out))))
+    (exit 0)))
diff --git a/compile-tree-il.scm b/compile-tree-il.scm
deleted file mode 100644
index 9b1dfc6..0000000
--- a/compile-tree-il.scm
+++ /dev/null
@@ -1,42 +0,0 @@
-;;; Guile Scheme specification
-
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;;; This file has been modified by Vouivre Digital Corporation. The exact
-;;;; modifications can be seen in a shell using:
-;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 compile-tree-il.scm
-
-;;; Code:
-
-(define-module (language vouivre compile-tree-il)
-  #:use-module (language tree-il)
-  #:use-module (srfi srfi-71)
-  #:use-module (vouivre curry)
-  #:export (compile-tree-il))
-
-;;; environment := MODULE
-
-(define (compile-tree-il x e opts)
-  (save-module-excursion
-   (lambda ()
-     (set-current-module e)
-     ;; TODO: Why do we need to use `(@@ (vouivre curry) symtab)' here instead of
-     ;;       simply `symtab'? If we don't it always return an empty symtab.
-     (let ((t expr (expand (@@ (vouivre curry) symtab) (syntax->datum x))))
-       (let* ((x (macroexpand expr 'c '(compile load eval)))
-              (cenv (current-module)))
-	 (values x cenv cenv))))))
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..6f61cc2
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,39 @@
+dnl -*- Autoconf -*-
+
+AC_INIT(vouivre, 0.1.0)
+AC_SUBST(HVERSION, "\"0.1.0\"")
+AC_SUBST(AUTHOR, "\"Vouivre Digital Corporation\"")
+AC_SUBST(COPYRIGHT, "'(2023)")
+AC_SUBST(LICENSE, gpl3+)
+AC_CONFIG_SRCDIR(vouivre.scm)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects  color-tests parallel-tests -Woverride -Wno-portability])
+AM_SILENT_RULES([yes])
+
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+
+dnl Search for 'guile' and 'guild'.  This macro defines
+dnl 'GUILE_EFFECTIVE_VERSION'.
+GUILE_PKG([3.0 2.2 2.0])
+GUILE_PROGS
+GUILE_SITE_DIR
+if test "x$GUILD" = "x"; then
+   AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.])
+fi
+
+if test "$cross_compiling" != no; then
+   GUILE_TARGET="--target=$host_alias"
+   AC_SUBST([GUILE_TARGET])
+fi
+
+dnl Hall auto-generated guile-module dependencies
+
+
+dnl Installation directories for .scm and .go files.
+guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION"
+guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache"
+AC_SUBST([guilemoduledir])
+AC_SUBST([guileobjectdir])
+
+AC_OUTPUT
diff --git a/curry-tests.scm b/curry-tests.scm
deleted file mode 100644
index 46c1cb9..0000000
--- a/curry-tests.scm
+++ /dev/null
@@ -1,116 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre curry tests)
-  #:use-module (vouivre curry)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-64)
-  #:use-module (srfi srfi-71))
-
-(test-begin "curry")
-;; TODO: map the reduxtab to a bare version for unit-testing
-;; (test-assert
-;;     (lset=
-;;      'equal?
-;;      '((1 . (2 . 4)) (2 . 2) (3 . 2))
-;;      (compare
-;;       (parse '(1       . (2 . 3)))
-;;       (parse '((1 . 2) . (1 . 1))))))
-
-(define-syntax-rule (test-type given expected-bare)
-  (test-assert (equal-types? given (parse expected-bare))))
-
-(define (sym-sets symtab alist)
-  (fold (lambda (x prev)
-	  ((@@ (vouivre curry) sym-set) prev (car x) (cdr x)))
-	symtab alist))
-
-(let ((t e (expand '() '(λc x x))))
-  (test-type t '(1 . 1))
-  (test-equal '(lambda (x) x) e))
-(let ((t e (expand '() '(λc g (λc f (λc x (g (f x))))))))
-  (test-type t '((3 . 4) . ((2 . 3) . (2 . 4))))
-  (test-equal '(lambda (g) (lambda (f) (lambda (x) (g (f x))))) e))
-(let ((t e (expand '() '((λc x x) #t))))
-  (test-type t 0)
-  (test-equal #t (primitive-eval e)))
-(let ((bindings
-       (sym-sets
-	'()
-	`((id  . ,(parse '(1 . 1)))
-	  (∘   . ,(parse '((2 . 3) . ((1 . 2) . (1 . 3)))))
-	  (⊙   . ,(parse '((1 . 2) . ((2 . 3) . (1 . 3)))))
-	  (map . ,(parse '((0 . 0) . (0 . 0))))
-	  (+   . ,(parse '(0 . (0 . 0))))))))
-  (let ((t e (expand bindings '(∘ id id))))
-    (test-type t '(7 . 7))
-    (test-equal e '((∘ id) id)))
-  (let ((t e (expand bindings '((∘ id id) #t))))
-    (test-type t 0)
-    (test-equal e '(((∘ id) id) #t)))
-  (let ((t e (expand bindings '(∘ id id #t))))
-    (test-type t 0)
-    (test-equal e '(((∘ id) id) #t)))
-  (let ((t e (expand bindings '(λc f (∘ f)))))
-    (test-type t '((2 . 3) . ((1 . 2) . (1 . 3)))))
-  (let ((t e (expand bindings '(map (+ 1) '(1 2 3)))))
-    (test-type t 0)
-    (test-equal e '((map (+ 1)) '(1 2 3))))
-  (let ((t e (expand bindings '(∘ +))))
-    (test-type t '((1 . 0) . (1 . (0 . 0))))
-    (test-equal e '(∘ +)))
-  (let ((t e (expand bindings '((∘ +) (+ 1) 2 3))))
-    (test-type t 0)
-    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
-  (let ((t e (expand bindings '((∘ + (+ 1)) 2 3))))
-    (test-type t 0)
-    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
-  (let ((t e (expand bindings '(((∘ + (+ 1)) 2) 3))))
-    (test-type t 0)
-    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
-  (let ((t e (expand bindings '((∘ (∘ (+ 1)) +) 2 3))))
-    (test-type t 0)
-    (test-equal e '((((∘ (∘ (+ 1))) +) 2) 3)))
-  (let ((t e (expand bindings '((∘ (⊙ (+ 1)) +) 2 3))))
-    (test-type t 0)
-    (test-equal e '((((∘ (⊙ (+ 1))) +) 2) 3))))
-
-;;; interaction between typed and untyped (regular) scheme
-
-;; Untyped scheme produces untyped return.
-(let ((t e (expand '() '(+ 1 2 3))))
-  (test-type t #f)
-  (test-equal e '(+ 1 2 3)))
-
-(let ((bindings
-       (sym-sets
-	'()
-	`((* . ,(parse '(0 . (0 . 0))))))))
-  ;; Typed Scheme can be used by untyped Scheme...
-  (let ((t e (expand bindings '(+ 1 (* 2 3) 4))))
-    (test-type t #f)
-    (test-equal e '(+ 1 ((* 2) 3) 4)))
-
-  ;; ... although, sometimes, with terrible runtime consequences!
-  (let ((t e (expand bindings '(+ 1 (* 2) 3))))
-    (test-type t #f)
-    (test-equal e '(+ 1 (* 2) 3)))
-
-  ;; On the other hand, typed Scheme expects typed Scheme.
-  (test-error (expand bindings '(* 1 (+ 2 3)))))
-
-(test-end "curry")
diff --git a/curry.scm b/curry.scm
deleted file mode 100644
index f7d20fd..0000000
--- a/curry.scm
+++ /dev/null
@@ -1,465 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre curry)
-  #:use-module ((ice-9 curried-definitions) :prefix c)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 receive)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-64)
-  #:use-module (srfi srfi-71)
-  #:use-module (vouivre misc)
-  #:export
-  (curried-untyped-define
-   equal-types?
-   expand
-   parse
-   symtab
-   type-of
-   ∷))
-
-(define symtab '())
-
-(define-record-type node
-  (make-node content)
-  node?
-  (content node-content set-node-content!))
-
-(define (type-error n . args)
-  (let ((errors '((0 . TBD)
-		  (1 . INCOMPATIBLE)
-		  (2 . BAD-INPUT)
-		  (3 . BAD-APPLICATION)
-		  (4 . UNBOUND-SYMBOL)
-		  (5 . TYPE-EXPECT-TYPES))))
-    (apply error "type error" (assoc-ref errors n) args)))
-
-(define (zo? x)
-  "Predicate for the zero type."
-  (and (number? x) (zero? x)))
-
-(define (tv? x)
-  "Predicate for type variables."
-  (and (number? x) (positive? x) #t))
-
-;; Return a unique type variable.
-(define next
-  (let ((count 1))
-    (lambda ()
-      (set! count (1+ count))
-      (1- count))))
-
-(define (copy-tree node)
-  "Return a copy of the tree rooted in `node'."
-  (let ((x (node-content node)))
-    (if (pair? x)
-	(make-node (cons (copy-tree (car x))
-			 (copy-tree (cdr x))))
-	(make-node x))))
-
-(define (map-tree! proc nx)
-  "Map `proc' in-place over the content of the leaves of `nx'."
-  (let ((x (node-content nx)))
-    (if (pair? x)
-	(begin
-	  (map-tree! proc (car x))
-	  (map-tree! proc (cdr x)))
-	(set-node-content! nx (proc x)))
-    nx))
-
-(define (compare nx ny)
-  ""
-  (define (create-reduxtab m)
-    ;; Each `x' point (through `mx') to a list `ys' of elements `y' who
-    ;; themselves point (through `my') to lists of things equal to `x'.
-    ;; We unionize these, sort them, and, bind them as "things equal to `x'".
-    (let* ((mx (first m))
-	   (my (second m))
-	   (mxf (third m))
-	   (φ (lambda (x)
-		(assoc-ref mx x)))
-	   (φ* (lambda (y)
-		 (assoc-ref my y)))
-	   (Φ* (lambda (ys)
-		 (apply lset-union eq? (map φ* ys)))))
-      (append
-       (lset-difference
-	(lambda (x y) (eq? (car x) (car y)))
-	mxf mx)
-       (map
-	(match-lambda
-	  ((x . ys)
-	   (cons
-	    x
-	    (let ((new-x (first (sort-list (Φ* ys) <)))
-		  (fy (assoc-ref mxf x)))
-	      (if (and (zo? new-x) fy)
-		  (type-error 1 new-x fy)
-		  (if (not fy)
-		      new-x
-		      (node-content
-		       (map-tree!
-			(lambda (y)
-			  (first
-			   (sort-list
-			    (or (φ* y)
-				(list (next)))
-			    <)))
-			(copy-tree (make-node fy))))))))))
-	mx))))
-  (define (massoc m x y)
-    (define (assoc! m x y)
-      (assoc-set! m x (cons y (or (assoc-ref m x) '()))))
-    (list (if (and (not (pair? x))
-		   (not (pair? y)))
-	      (assoc! (first m) x y)
-	      (first m))
-	  (if (and (not (pair? x))
-		   (not (pair? y)))
-	      (assoc! (second m) y x)
-	      (second m))
-	  (if (not (pair? y))
-	      (third m)
-	      (if (assoc-ref (third m) x)
-		  (type-error 0 "type variable already a function")
-		  (assoc-set! (third m) x y)))))
-  (create-reduxtab
-   (let compare% ((m `(()
-		       ;; 0_x ≡ 0_y (though we only use 0y→0x).
-		       ;; Also, associations in an alist need to be mutable.
-		       (,(cons 0 '(0)))
-		       ()))
-		  (nx nx)
-		  (ny ny))
-     (let ((x (node-content nx))
-	   (y (node-content ny)))
-       (cond
-	;; same same
-	((eq? nx ny)
-	 m)
-	((and (not x) (not y))
-	 m)
-	((and (zo? x) (zo? y))
-	 m)
-	((and (tv? x) (tv? y))
-	 (massoc m x y))
-	((and (pair? x) (pair? y))
-	 (compare% (compare% m (car x) (car y))
-		   (cdr x) (cdr y)))
-	;; cases with #f
-	((and (zo? x) (not y))
-	 (set-node-content! ny x)
-	 m)
-	((and (zo? y) (not x))
-	 (set-node-content! nx y)
-	 m)
-	((and (tv? y) (not x))
-	 (let ((z (next)))
-	   (set-node-content! nx z)
-	   (massoc m y z)))
-	((and (tv? x) (not y))
-	 (let ((z (next)))
-	   (set-node-content! ny z)
-	   (massoc m x z)))
-	((and (pair? x) (not y))
-	 (set-node-content! ny x)
-	 m)
-	((and (pair? y) (not x))
-	 (type-error 0 nx ny))
-	;; cases with TVs
-	((and (tv? x) (zo? y))
-	 (massoc m x y))
-	((and (tv? y) (zo? x))
-	 (massoc m x y))
-	((and (tv? x) (pair? y))
-	 (massoc m x y))
-	((and (tv? y) (pair? x))
-	 (type-error 0 nx ny))
-	;; outright incompatible cases
-	((or (and (zo? x) (pair? y))
-	     (and (zo? y) (pair? x)))
-	 (type-error 1 x y))
-	;; bad input
-	(else
-	 (type-error 2 nx ny)))))))
-
-(define (reduce-tvs! reduxtab node)
-  (map-tree!
-   (lambda (x)
-     (if (number? x)
-	 (or (assoc-ref reduxtab x)
-	     x)
-	 x))
-   node))
-
-(define (rename-tvs! node)
-  (let ((mapping (cons '() #f)))
-    (map-tree!
-     (lambda (x)
-       (if (tv? x)
-	   (if-let (z (assoc-ref (car mapping) x))
-		   z
-		   (let ((z (next)))
-		     (set-car! mapping (assoc-set! (car mapping) x z))
-		     z))
-	   x))
-     node)))
-
-(define (apply-1 nx ny)
-  (let ((x (node-content nx))
-	(y (node-content ny)))
-    (cond
-     ((not x)
-      (set-node-content! nx (cons ny (make-node #f)))
-      (cdr (node-content nx)))
-     ((zo? x)
-      (type-error 3 x y))
-     ((tv? x)
-      (type-error 2 nx ny)
-      )
-     ((pair? x)
-      (reduce-tvs! (compare (car x) ny)
-		   (copy-tree (cdr x))))
-     (else
-      (type-error 2 nx ny)))))
-
-(define (var-list? lst)
-  "Predicate for valid macro variable lists."
-  (and (every symbol? lst)
-       (equal? lst (delete-duplicates lst))))
-
-(define (sym-set! symtab name value)
-  "Associate a type to a symbol in a symtab."
-  (let ((m (module-name (current-module))))
-    (assoc-set! symtab m
-		(assoc-set! (or (assoc-ref symtab m) '())
-			    name value))))
-
-(define (sym-set symtab sym value)
-  "Like `sym-set!' but returns a copy of the symtab."
-  (sym-set! (alist-copy symtab) sym value))
-
-(define (sym-ref symtab name)
-  "Reference a symbol in a symtab returning its type."
-  (let ((m (module-name (current-module))))
-    (assoc-ref (or (assoc-ref symtab m) '()) name)))
-
-(define (populate-tvs! node)
-  "Add (in-place) new type variables to empty nodes of a tree."
-  (map-tree!
-   (lambda (x)
-     (if (not x)
-	 (next)
-	 x))
-   node))
-
-(define (expand symtab expr)
-  "Type check an expression returning two values: its resulting type and an
-expansion where all applications of symbols present in the symtab are curried.
-Raise a type error if the expression is invalid."
-  (match expr
-    (('quote x)
-     (values
-      (make-node 0)
-      `',x))
-    (('λc (? symbol? var) body)
-     (let ((var-node (make-node #f)))
-       (let ((bodyt bodye (expand (sym-set symtab var var-node)
-				  body)))
-	 (unless bodyt
-	   (type-error 5 "in body of" `(λc ,var ,body)))
-	 (populate-tvs! var-node)
-	 (values
-	  (make-node
-	   (cons var-node bodyt))
-	  `(lambda (,var) ,bodye)))))
-    (('letrecc1 ((? symbol? name) expr) body)
-     (type-error 0 'letrecc1 name expr body))
-    (('cudefine name-vars body ..1)
-     (values
-      #f
-      `(cudefine ,name-vars ,@body)))
-    (('definec (? (lambda (x)
-		    (and
-		     (pair? x)
-		     (symbol? (car x))
-		     (var-list? (cdr x))))
-		  (name vars ..1))
-       body)
-     (expand
-      symtab
-      `(definec ,name
-	 ,(fold-right (lambda (x prev)
-			`(λc ,x ,prev))
-		      body vars))))
-    (('definec (? symbol? name) body)
-     (let ((t e (expand symtab body)))
-       (if (not t)
-	   (type-error 5 "in body of" `(definec ,name ,body))
-	   ;; We need to declare the type twice. Once, in `expand', to ensure
-	   ;; the type will be available in future `expand' calls. Second, in
-	   ;; the expanded expression, so that it gets compiled.
-	   (begin
-	     (∷% name t)
-	     (values
-	      #f
-	      `(begin
-		 ((@@ (vouivre curry) ∷%)
-		  ',name
-		  ((@ (vouivre curry) parse)
-		   ',(bare-type t)))
-		 (define ,name ,e)))))))
-    ((f)
-     (let ((t e (expand symtab f)))
-       (values
-	(if t
-	    (type-error 3 expr)
-	    #f)
-	`(,e))))
-    ((f as ..1)
-     (let ((ft fe (expand symtab f))
-	   (ats aes (unzip2
-		     (map
-		      (lambda (a)
-			(receive vals (expand symtab a) vals))
-		      as))))
-       (if (not ft)
-	   (values #f `(,fe ,@aes))
-	   (values
-	    (fold
-	     (lambda (at a prev)
-	       (apply-1 prev (or at (type-error 5 f a))))
-	     ft ats as)
-	    (fold
-	     (lambda (ae prev)
-	       (list prev ae))
-	     fe aes)))))
-    (x
-     (values
-      (if (symbol? x)
-	  (sym-ref symtab x)
-	  (make-node 0))
-      x))))
-
-(define (bare-type x)
-  "Return a type as tree s-expression without nodes."
-  (and=>
-   x
-   (lambda (node)
-     (let ((x (node-content node)))
-       (cond
-	((pair? x)
-	 (cons (bare-type (car x)) (bare-type (cdr x))))
-	(else x))))))
-
-(define* (pt node #:optional (port current-output-port))
-  "Print a tree to the given port in a cons cell format with '?' for empty
-nodes."
-  (format
-   port "~a~%"
-   (let pt% ((nx node))
-     (let ((x (node-content nx)))
-       (cond
-	((not x)
-	 "?")
-	((number? x)
-	 (number->string x))
-	((pair? x)
-	 (format #f "(~a . ~a)"
-		 (pt% (car x))
-		 (pt% (cdr x)))))))))
-
-(define (parse x)
-  "Parse a type from its cons cells representation to a tree."
-  (if (not x)
-      #f
-      (second
-       (let parse% ((tvs '())
-		    (x x))
-	 (cond
-	  ((eq? x '?)
-	   (list tvs (make-node #f)))
-	  ((zo? x)
-	   (list tvs (make-node 0)))
-	  ((tv? x)
-	   (if-let (z (assoc-ref tvs x))
-		   (list tvs (make-node z))
-		   (let ((tv (next)))
-		     (list (assoc-set! tvs x tv)
-			   (make-node tv)))))
-	  ((pair? x)
-	   (let* ((a (parse% tvs (car x)))
-		  (b (parse% (first a) (cdr x))))
-	     (list (first b) (make-node (cons (second a) (second b)))))))))))
-
-(define (equal-types? ta tb)
-  "Check the equality of two types."
-  (define (equal-types?% ta tb correspondances)
-    (let ((a (node-content ta))
-	  (b (node-content tb)))
-      (or
-       (eq? a b)
-       (let ((correspond?
-	      (lambda (tx ty correspondances)
-		(let ((x (node-content tx))
-		      (y (node-content ty)))
-		  (cond
-		   ((and (zo? x)
-			 (zo? y))
-		    correspondances)
-		   ((and (tv? x)
-			 (tv? y))
-		    (let ((xy (assoc-ref (car correspondances) x))
-			  (yx (assoc-ref (cdr correspondances) y)))
-		      (if (and (not xy) (not yx))
-			 (cons (assoc-set! (car correspondances) x y)
-			       (assoc-set! (cdr correspondances) y x))
-			 (and (eq? xy y) (eq? yx x) correspondances))))
-		   ((and (pair? x) (pair? y))
-		    (equal-types?% tx ty correspondances))
-		   (else #f))))))
-	 (match (list a b)
-	   (((a1 . a2) (b1 . b2))
-	    (and=>
-	     (correspond? a1 b1 correspondances)
-	     (lambda (correspondances)
-	       (correspond? a2 b2 correspondances))))
-	   (else #f))))))
-  (if (or (not ta) (not tb))
-      (eq? ta tb)
-      (and (equal-types?% ta tb '(() . ()))
-	   #t)))
-
-(define-syntax curried-untyped-define
-  (syntax-rules ()
-    ((_ (name var) body ...)
-     (cdefine (name var) body ...))
-    ((_ (name var1 var2 ...) body ...)
-     (curried-untyped-define ((name var1) var2 ...) body ...))))
-
-(define (∷% name type)
-  (set! symtab (sym-set! symtab name type)))
-
-(define-syntax-rule (∷ name type)
-  (∷% 'name (parse 'type)))
-
-(define* (type-of x #:optional port)
-  "Print the type of a declared symbol to the given port."
-  (if-let (x (expand symtab x))
-	  (pt x port)
-	  (format port "#f~%")))
diff --git a/decompile-tree-il.scm b/decompile-tree-il.scm
deleted file mode 100644
index 153bcd2..0000000
--- a/decompile-tree-il.scm
+++ /dev/null
@@ -1,800 +0,0 @@
-;;; Guile VM code converters
-
-;; Copyright (C) 2001, 2009, 2012, 2013 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;;; This file has been modified by Vouivre Digital Corporation. The exact
-;;;; modifications can be seen in a shell using:
-;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 decompile-tree-il.scm
-
-;;; Code:
-
-(define-module (language vouivre decompile-tree-il)
-  #:use-module (language tree-il)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 receive)
-  #:use-module (ice-9 vlist)
-  #:use-module (ice-9 match)
-  #:use-module (system base syntax)
-  #:export (decompile-tree-il))
-
-(define (decompile-tree-il e env opts)
-  (apply do-decompile e env opts))
-
-(define* (do-decompile e env
-                       #:key
-                       (use-derived-syntax? #t)
-                       (avoid-lambda? #t)
-                       (use-case? #t)
-                       (strip-numeric-suffixes? #f)
-                       #:allow-other-keys)
-
-  (receive (output-name-table occurrence-count-table)
-      (choose-output-names e use-derived-syntax? strip-numeric-suffixes?)
-
-    (define (output-name s)      (hashq-ref output-name-table s))
-    (define (occurrence-count s) (hashq-ref occurrence-count-table s))
-
-    (define (const x) (lambda (_) x))
-    (define (atom? x) (not (or (pair? x) (vector? x))))
-
-    (define (build-void) '(if #f #f))
-
-    (define (build-begin es)
-      (match es
-        (() (build-void))
-        ((e) e)
-        (_ `(begin ,@es))))
-
-    (define (build-lambda-body e)
-      (match e
-        (('let () body ...) body)
-        (('begin es ...) es)
-        (_ (list e))))
-
-    (define (build-begin-body e)
-      (match e
-        (('begin es ...) es)
-        (_ (list e))))
-
-    (define (build-define name e)
-      (match e
-        ((? (const avoid-lambda?)
-            ('lambda formals body ...))
-         `(define (,name ,@formals) ,@body))
-        ((? (const avoid-lambda?)
-            ('lambda* formals body ...))
-         `(define* (,name ,@formals) ,@body))
-        (_ `(define ,name ,e))))
-
-    (define (build-let names vals body)
-      (match `(let ,(map list names vals)
-                ,@(build-lambda-body body))
-        ((_ () e) e)
-        ((_ (b) ('let* (bs ...) body ...))
-         `(let* (,b ,@bs) ,@body))
-        ((? (const use-derived-syntax?)
-            (_ (b1) ('let (b2) body ...)))
-         `(let* (,b1 ,b2) ,@body))
-        (e e)))
-
-    (define (build-letrec in-order? names vals body)
-      (match `(,(if in-order? 'letrec* 'letrec)
-               ,(map list names vals)
-               ,@(build-lambda-body body))
-        ((_ () e) e)
-        ((_ () body ...) `(let () ,@body))
-        ((_ ((name ('lambda (formals ...) body ...)))
-            (name args ...))
-         (=> failure)
-         (if (= (length formals) (length args))
-             `(let ,name ,(map list formals args) ,@body)
-             (failure)))
-        ((? (const avoid-lambda?)
-            ('letrec* _ body ...))
-         `(let ()
-            ,@(map build-define names vals)
-            ,@body))
-        (e e)))
-
-    (define (build-if test consequent alternate)
-      (match alternate
-        (('if #f _) `(if ,test ,consequent))
-        (_ `(if ,test ,consequent ,alternate))))
-
-    (define (build-and xs)
-      (match xs
-        (() #t)
-        ((x) x)
-        (_ `(and ,@xs))))
-
-    (define (build-or xs)
-      (match xs
-        (() #f)
-        ((x) x)
-        (_ `(or ,@xs))))
-
-    (define (case-test-var test)
-      (match test
-        (('memv (? atom? v) ('quote (datums ...)))
-         v)
-        (('eqv? (? atom? v) ('quote datum))
-         v)
-        (_ #f)))
-
-    (define (test->datums v test)
-      (match (cons v test)
-        ((v 'memv v ('quote (xs ...)))
-         xs)
-        ((v 'eqv? v ('quote x))
-         (list x))
-        (_ #f)))
-
-    (define (build-else-tail e)
-      (match e
-        (('if #f _) '())
-        (('and xs ... x) `((,(build-and xs) ,@(build-begin-body x))
-                           (else #f)))
-        (_ `((else ,@(build-begin-body e))))))
-
-    (define (build-cond-else-tail e)
-      (match e
-        (('cond clauses ...) clauses)
-        (_ (build-else-tail e))))
-
-    (define (build-case-else-tail v e)
-      (match (cons v e)
-        ((v 'case v clauses ...)
-         clauses)
-        ((v 'if ('memv v ('quote (xs ...))) consequent . alternate*)
-         `((,xs ,@(build-begin-body consequent))
-           ,@(build-case-else-tail v (build-begin alternate*))))
-        ((v 'if ('eqv? v ('quote x)) consequent . alternate*)
-         `(((,x) ,@(build-begin-body consequent))
-           ,@(build-case-else-tail v (build-begin alternate*))))
-        (_ (build-else-tail e))))
-
-    (define (clauses+tail clauses)
-      (match clauses
-        ((cs ... (and c ('else . _))) (values cs (list c)))
-        (_ (values clauses '()))))
-
-    (define (build-cond tests consequents alternate)
-      (case (length tests)
-        ((0) alternate)
-        ((1) (build-if (car tests) (car consequents) alternate))
-        (else `(cond ,@(map (lambda (test consequent)
-                              `(,test ,@(build-begin-body consequent)))
-                            tests consequents)
-                     ,@(build-cond-else-tail alternate)))))
-
-    (define (build-cond-or-case tests consequents alternate)
-      (if (not use-case?)
-          (build-cond tests consequents alternate)
-          (let* ((v (and (not (null? tests))
-                         (case-test-var (car tests))))
-                 (datum-lists (take-while identity
-                                          (map (cut test->datums v <>)
-                                               tests)))
-                 (n (length datum-lists))
-                 (tail (build-case-else-tail v (build-cond
-                                                (drop tests n)
-                                                (drop consequents n)
-                                                alternate))))
-            (receive (clauses tail) (clauses+tail tail)
-              (let ((n (+ n (length clauses)))
-                    (datum-lists (append datum-lists
-                                         (map car clauses)))
-                    (consequents (append consequents
-                                         (map build-begin
-                                              (map cdr clauses)))))
-                (if (< n 2)
-                    (build-cond tests consequents alternate)
-                    `(case ,v
-                       ,@(map cons datum-lists (map build-begin-body
-                                                    (take consequents n)))
-                       ,@tail)))))))
-
-    (define (recurse e)
-
-      (define (recurse-body e)
-        (build-lambda-body (recurse e)))
-
-      (record-case e
-        ((<void>)
-         (build-void))
-
-        ((<const> exp)
-         (if (and (self-evaluating? exp) (not (vector? exp)))
-             exp
-             `(quote ,exp)))
-
-        ((<seq> head tail)
-         (build-begin (cons (recurse head)
-                            (build-begin-body
-                             (recurse tail)))))
-
-        ((<call> proc args)
-         (match `(,(recurse proc) ,@(map recurse args))
-           ((('lambda (formals ...) body ...) args ...)
-            (=> failure)
-            (if (= (length formals) (length args))
-                (build-let formals args (build-begin body))
-                (failure)))
-           (e e)))
-
-        ((<primcall> name args)
-         `(,name ,@(map recurse args)))
-
-        ((<primitive-ref> name)
-         name)
-
-        ((<lexical-ref> gensym)
-         (output-name gensym))
-
-        ((<lexical-set> gensym exp)
-         `(set! ,(output-name gensym) ,(recurse exp)))
-
-        ((<module-ref> mod name public?)
-         `(,(if public? '@ '@@) ,mod ,name))
-
-        ((<module-set> mod name public? exp)
-         `(set! (,(if public? '@ '@@) ,mod ,name) ,(recurse exp)))
-
-        ((<toplevel-ref> name)
-         name)
-
-        ((<toplevel-set> name exp)
-         `(set! ,name ,(recurse exp)))
-
-        ((<toplevel-define> name exp)
-         (build-define name (recurse exp)))
-
-        ((<lambda> meta body)
-         (if body
-             (let ((body (recurse body))
-                   (doc (assq-ref meta 'documentation)))
-               (if (not doc)
-                   body
-                   (match body
-                     (('lambda formals body ...)
-                      `(lambda ,formals ,doc ,@body))
-                     (('lambda* formals body ...)
-                      `(lambda* ,formals ,doc ,@body))
-                     (('case-lambda (formals body ...) clauses ...)
-                      `(case-lambda (,formals ,doc ,@body) ,@clauses))
-                     (('case-lambda* (formals body ...) clauses ...)
-                      `(case-lambda* (,formals ,doc ,@body) ,@clauses))
-                     (e e))))
-             '(case-lambda)))
-
-        ((<lambda-case> req opt rest kw inits gensyms body alternate)
-         (let ((names (map output-name gensyms)))
-           (cond
-            ((and (not opt) (not kw) (not alternate))
-             `(lambda ,(if rest (apply cons* names) names)
-                ,@(recurse-body body)))
-            ((and (not opt) (not kw))
-             (let ((alt-expansion (recurse alternate))
-                   (formals (if rest (apply cons* names) names)))
-               (case (car alt-expansion)
-                 ((lambda)
-                  `(case-lambda (,formals ,@(recurse-body body))
-                                ,(cdr alt-expansion)))
-                 ((lambda*)
-                  `(case-lambda* (,formals ,@(recurse-body body))
-                                 ,(cdr alt-expansion)))
-                 ((case-lambda)
-                  `(case-lambda (,formals ,@(recurse-body body))
-                                ,@(cdr alt-expansion)))
-                 ((case-lambda*)
-                  `(case-lambda* (,formals ,@(recurse-body body))
-                                 ,@(cdr alt-expansion))))))
-            (else
-             (let* ((alt-expansion (and alternate (recurse alternate)))
-                    (nreq (length req))
-                    (nopt (if opt (length opt) 0))
-                    (restargs (if rest (list-ref names (+ nreq nopt)) '()))
-                    (reqargs (list-head names nreq))
-                    (optargs (if opt
-                                 `(#:optional
-                                   ,@(map list
-                                          (list-head (list-tail names nreq) nopt)
-                                          (map recurse
-                                               (list-head inits nopt))))
-                                 '()))
-                    (kwargs (if kw
-                                `(#:key
-                                  ,@(map list
-                                         (map output-name (map caddr (cdr kw)))
-                                         (map recurse
-                                              (list-tail inits nopt))
-                                         (map car (cdr kw)))
-                                  ,@(if (car kw)
-                                        '(#:allow-other-keys)
-                                        '()))
-                                '()))
-                    (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs)))
-               (if (not alt-expansion)
-                   `(lambda* ,formals ,@(recurse-body body))
-                   (case (car alt-expansion)
-                     ((lambda lambda*)
-                      `(case-lambda* (,formals ,@(recurse-body body))
-                                     ,(cdr alt-expansion)))
-                     ((case-lambda case-lambda*)
-                      `(case-lambda* (,formals ,@(recurse-body body))
-                                     ,@(cdr alt-expansion))))))))))
-
-        ((<conditional> test consequent alternate)
-         (define (simplify-test e)
-           (match e
-             (('if ('eqv? (? atom? v) ('quote a)) #t ('eqv? v ('quote b)))
-              `(memv ,v '(,a ,b)))
-             (('if ('eqv? (? atom? v) ('quote a)) #t ('memv v ('quote (bs ...))))
-              `(memv ,v '(,a ,@bs)))
-             (('case (? atom? v)
-                ((datum) #t) ...
-                ('else ('eqv? v ('quote last-datum))))
-              `(memv ,v '(,@datum ,last-datum)))
-             (_ e)))
-         (match `(if ,(simplify-test (recurse test))
-                     ,(recurse consequent)
-                     ,@(if (void? alternate) '()
-                           (list (recurse alternate))))
-           (('if test ('if ('and xs ...) consequent))
-            (build-if (build-and (cons test xs))
-                      consequent
-                      (build-void)))
-           ((? (const use-derived-syntax?)
-               ('if test1 ('if test2 consequent)))
-            (build-if (build-and (list test1 test2))
-                      consequent
-                      (build-void)))
-           (('if (? atom? x) x ('or ys ...))
-            (build-or (cons x ys)))
-           ((? (const use-derived-syntax?)
-               ('if (? atom? x) x y))
-            (build-or (list x y)))
-           (('if test consequent)
-            `(if ,test ,consequent))
-           (('if test ('and xs ...) #f)
-            (build-and (cons test xs)))
-           ((? (const use-derived-syntax?)
-               ('if test consequent #f))
-            (build-and (list test consequent)))
-           ((? (const use-derived-syntax?)
-               ('if test1 consequent1
-                    ('if test2 consequent2 . alternate*)))
-            (build-cond-or-case (list test1 test2)
-                                (list consequent1 consequent2)
-                                (build-begin alternate*)))
-           (('if test consequent ('cond clauses ...))
-            `(cond (,test ,@(build-begin-body consequent))
-                   ,@clauses))
-           (('if ('memv (? atom? v) ('quote (xs ...))) consequent
-                 ('case v clauses ...))
-            `(case ,v (,xs ,@(build-begin-body consequent))
-                   ,@clauses))
-           (('if ('eqv? (? atom? v) ('quote x)) consequent
-                 ('case v clauses ...))
-            `(case ,v ((,x) ,@(build-begin-body consequent))
-                   ,@clauses))
-           (e e)))
-
-        ((<let> gensyms vals body)
-         (match (build-let (map output-name gensyms)
-                           (map recurse vals)
-                           (recurse body))
-           (('let ((v e)) ('or v xs ...))
-            (=> failure)
-            (if (and (not (null? gensyms))
-                     (= 3 (occurrence-count (car gensyms))))
-                `(or ,e ,@xs)
-                (failure)))
-           (('let ((v e)) ('case v clauses ...))
-            (=> failure)
-            (if (and (not (null? gensyms))
-                     ;; FIXME: This fails if any of the 'memv's were
-                     ;; optimized into multiple 'eqv?'s, because the
-                     ;; occurrence count will be higher than we expect.
-                     (= (occurrence-count (car gensyms))
-                        (1+ (length (clauses+tail clauses)))))
-                `(case ,e ,@clauses)
-                (failure)))
-           (e e)))
-
-        ((<letrec> in-order? gensyms vals body)
-         (build-letrec in-order?
-                       (map output-name gensyms)
-                       (map recurse vals)
-                       (recurse body)))
-
-        ((<fix> gensyms vals body)
-         ;; not a typo, we really do translate back to letrec. use letrec* since it
-         ;; doesn't matter, and the naive letrec* transformation does not require an
-         ;; inner let.
-         (build-letrec #t
-                       (map output-name gensyms)
-                       (map recurse vals)
-                       (recurse body)))
-
-        ((<let-values> exp body)
-         `(call-with-values (lambda () ,@(recurse-body exp))
-            ,(recurse (make-lambda #f '() body))))
-
-        ((<prompt> escape-only? tag body handler)
-         `(call-with-prompt
-           ,(recurse tag)
-           ,(if escape-only?
-                `(lambda () ,(recurse body))
-                (recurse body))
-           ,(recurse handler)))
-
-
-        ((<abort> tag args tail)
-         `(apply abort ,(recurse tag) ,@(map recurse args)
-                 ,(recurse tail)))))
-    (values (recurse e) env)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Algorithm for choosing better variable names
-;; ============================================
-;;
-;; First we perform an analysis pass, collecting the following
-;; information:
-;;
-;; * For each gensym: how many occurrences will occur in the output?
-;;
-;; * For each gensym A: which gensyms does A conflict with?  Gensym A
-;;   and gensym B conflict if they have the same base name (usually the
-;;   same as the source name, but see below), and if giving them the
-;;   same name would cause a bad variable reference due to unintentional
-;;   variable capture.
-;;
-;; The occurrence counter is indexed by gensym and is global (within each
-;; invocation of the algorithm), implemented using a hash table.  We also
-;; keep a global mapping from gensym to source name as provided by the
-;; binding construct (we prefer not to trust the source names in the
-;; lexical ref or set).
-;;
-;; As we recurse down into lexical binding forms, we keep track of a
-;; mapping from base name to an ordered list of bindings, innermost
-;; first.  When we encounter a variable occurrence, we increment the
-;; counter, look up the base name (preferring not to trust the 'name' in
-;; the lexical ref or set), and then look up the bindings currently in
-;; effect for that base name.  Hopefully our gensym will be the first
-;; (innermost) binding.  If not, we register a conflict between the
-;; referenced gensym and the other bound gensyms with the same base name
-;; that shadow the binding we want.  These are simply the gensyms on the
-;; binding list that come before our gensym.
-;;
-;; Top-level bindings are treated specially.  Whenever top-level
-;; references are found, they conflict with every lexical binding
-;; currently in effect with the same base name.  They are guaranteed to
-;; be assigned to their source names.  For purposes of recording
-;; conflicts (which are normally keyed on gensyms) top-level identifiers
-;; are assigned a pseudo-gensym that is an interned pair of the form
-;; (top-level . <name>).  This allows them to be compared using 'eq?'
-;; like other gensyms.
-;;
-;; The base name is normally just the source name.  However, if the
-;; source name has a suffix of the form "-N" (where N is a positive
-;; integer without leading zeroes), then we strip that suffix (multiple
-;; times if necessary) to form the base name.  We must do this because
-;; we add suffixes of that form in order to resolve conflicts, and we
-;; must ensure that only identifiers with the same base name can
-;; possibly conflict with each other.
-;;
-;; XXX FIXME: Currently, primitives are treated exactly like top-level
-;; bindings.  This handles conflicting lexical bindings properly, but
-;; does _not_ handle the case where top-level bindings conflict with the
-;; needed primitives.
-;;
-;; Also note that this requires that 'choose-output-names' be kept in
-;; sync with 'tree-il->scheme'.  Primitives that are introduced by
-;; 'tree-il->scheme' must be anticipated by 'choose-output-name'.
-;;
-;; We also ensure that lexically-bound identifiers found in operator
-;; position will never be assigned one of the standard primitive names.
-;; This is needed because 'tree-il->scheme' recognizes primitive names
-;; in operator position and assumes that they have the standard
-;; bindings.
-;;
-;;
-;; How we assign an output name to each gensym
-;; ===========================================
-;;
-;; We process the gensyms in order of decreasing occurrence count, with
-;; each gensym choosing the best output name possible, as long as it
-;; isn't the same name as any of the previously-chosen output names of
-;; conflicting gensyms.
-;;
-
-
-;;
-;; 'choose-output-names' analyzes the top-level form e, chooses good
-;; variable names that are as close as possible to the source names,
-;; and returns two values:
-;;
-;;  * a hash table mapping gensym to output name
-;;  * a hash table mapping gensym to number of occurrences
-;;
-(define choose-output-names
-  (let ()
-    (define primitive?
-      ;; This is a list of primitives that 'tree-il->scheme' assumes
-      ;; will have the standard bindings when found in operator
-      ;; position.
-      (let* ((primitives '(if quote @ @@ set! define define*
-                              begin let let* letrec letrec*
-                              and or cond case
-                              lambda lambda* case-lambda case-lambda*
-                              apply call-with-values dynamic-wind
-                              with-fluids fluid-ref fluid-set!
-                              call-with-prompt abort memv eqv?))
-             (table (make-hash-table (length primitives))))
-        (for-each (cut hashq-set! table <> #t) primitives)
-        (lambda (name) (hashq-ref table name))))
-
-    ;; Repeatedly strip suffix of the form "-N", where N is a string
-    ;; that could be produced by number->string given a positive
-    ;; integer.  In other words, the first digit of N may not be 0.
-    (define compute-base-name
-      (let ((digits (string->char-set "0123456789")))
-        (define (base-name-string str)
-          (let ((i (string-skip-right str digits)))
-            (if (and i (< (1+ i) (string-length str))
-                     (eq? #\- (string-ref str i))
-                     (not (eq? #\0 (string-ref str (1+ i)))))
-                (base-name-string (substring str 0 i))
-                str)))
-        (lambda (sym)
-          (string->symbol (base-name-string (symbol->string sym))))))
-
-    ;; choose-output-names
-    (lambda (e use-derived-syntax? strip-numeric-suffixes?)
-
-      (define lexical-gensyms '())
-
-      (define top-level-intern!
-        (let ((table (make-hash-table)))
-          (lambda (name)
-            (let ((h (hashq-create-handle! table name #f)))
-              (or (cdr h) (begin (set-cdr! h (cons 'top-level name))
-                                 (cdr h)))))))
-      (define (top-level? s) (pair? s))
-      (define (top-level-name s) (cdr s))
-
-      (define occurrence-count-table (make-hash-table))
-      (define (occurrence-count s) (or (hashq-ref occurrence-count-table s) 0))
-      (define (increment-occurrence-count! s)
-        (let ((h (hashq-create-handle! occurrence-count-table s 0)))
-          (if (zero? (cdr h))
-              (set! lexical-gensyms (cons s lexical-gensyms)))
-          (set-cdr! h (1+ (cdr h)))))
-
-      (define base-name
-        (let ((table (make-hash-table)))
-          (lambda (name)
-            (let ((h (hashq-create-handle! table name #f)))
-              (or (cdr h) (begin (set-cdr! h (compute-base-name name))
-                                 (cdr h)))))))
-
-      (define source-name-table (make-hash-table))
-      (define (set-source-name! s name)
-        (if (not (top-level? s))
-            (let ((name (if strip-numeric-suffixes?
-                            (base-name name)
-                            name)))
-              (hashq-set! source-name-table s name))))
-      (define (source-name s)
-        (if (top-level? s)
-            (top-level-name s)
-            (hashq-ref source-name-table s)))
-
-      (define conflict-table (make-hash-table))
-      (define (conflicts s) (or (hashq-ref conflict-table s) '()))
-      (define (add-conflict! a b)
-        (define (add! a b)
-          (if (not (top-level? a))
-              (let ((h (hashq-create-handle! conflict-table a '())))
-                (if (not (memq b (cdr h)))
-                    (set-cdr! h (cons b (cdr h)))))))
-        (add! a b)
-        (add! b a))
-
-      (let recurse-with-bindings ((e e) (bindings vlist-null))
-        (let recurse ((e e))
-
-          ;; We call this whenever we encounter a top-level ref or set
-          (define (top-level name)
-            (let ((bname (base-name name)))
-              (let ((s (top-level-intern! name))
-                    (conflicts (vhash-foldq* cons '() bname bindings)))
-                (for-each (cut add-conflict! s <>) conflicts))))
-
-          ;; We call this whenever we encounter a primitive reference.
-          ;; We must also call it for every primitive that might be
-          ;; inserted by 'tree-il->scheme'.  It is okay to call this
-          ;; even when 'tree-il->scheme' will not insert the named
-          ;; primitive; the worst that will happen is for a lexical
-          ;; variable of the same name to be renamed unnecessarily.
-          (define (primitive name) (top-level name))
-
-          ;; We call this whenever we encounter a lexical ref or set.
-          (define (lexical s)
-            (increment-occurrence-count! s)
-            (let ((conflicts
-                   (take-while
-                    (lambda (s*) (not (eq? s s*)))
-                    (reverse! (vhash-foldq* cons
-                                            '()
-                                            (base-name (source-name s))
-                                            bindings)))))
-              (for-each (cut add-conflict! s <>) conflicts)))
-
-          (record-case e
-            ((<void>)  (primitive 'if)) ; (if #f #f)
-            ((<const>) (primitive 'quote))
-
-            ((<call> proc args)
-             (if (lexical-ref? proc)
-                 (let* ((gensym (lexical-ref-gensym proc))
-                        (name (source-name gensym)))
-                   ;; If the operator position contains a bare variable
-                   ;; reference with the same source name as a standard
-                   ;; primitive, we must ensure that it will be given a
-                   ;; different name, so that 'tree-il->scheme' will not
-                   ;; misinterpret the resulting expression.
-                   (if (primitive? name)
-                       (add-conflict! gensym (top-level-intern! name)))))
-             (recurse proc)
-             (for-each recurse args))
-
-            ((<primitive-ref> name) (primitive name))
-            ((<primcall> name args) (primitive name) (for-each recurse args))
-
-            ((<lexical-ref> gensym) (lexical gensym))
-            ((<lexical-set> gensym exp)
-             (primitive 'set!) (lexical gensym) (recurse exp))
-
-            ((<module-ref> public?) (primitive (if public? '@ '@@)))
-            ((<module-set> public? exp)
-             (primitive 'set!) (primitive (if public? '@ '@@)) (recurse exp))
-
-            ((<toplevel-ref> name) (top-level name))
-            ((<toplevel-set> name exp)
-             (primitive 'set!) (top-level name) (recurse exp))
-            ((<toplevel-define> name exp) (top-level name) (recurse exp))
-
-            ((<conditional> test consequent alternate)
-             (cond (use-derived-syntax?
-                    (primitive 'and) (primitive 'or)
-                    (primitive 'cond) (primitive 'case)
-                    (primitive 'else) (primitive '=>)))
-             (primitive 'if)
-             (recurse test) (recurse consequent) (recurse alternate))
-
-            ((<seq> head tail)
-             (primitive 'begin) (recurse head) (recurse tail))
-
-            ((<lambda> body)
-             (if body (recurse body) (primitive 'case-lambda)))
-
-            ((<lambda-case> req opt rest kw inits gensyms body alternate)
-             (primitive 'lambda)
-             (cond ((or opt kw alternate)
-                    (primitive 'lambda*)
-                    (primitive 'case-lambda)
-                    (primitive 'case-lambda*)))
-             (primitive 'let)
-             (if use-derived-syntax? (primitive 'let*))
-             (let* ((names (append req (or opt '()) (if rest (list rest) '())
-                                   (map cadr (if kw (cdr kw) '()))))
-                    (base-names (map base-name names))
-                    (body-bindings
-                     (fold vhash-consq bindings base-names gensyms)))
-               (for-each increment-occurrence-count! gensyms)
-               (for-each set-source-name! gensyms names)
-               (for-each recurse inits)
-               (recurse-with-bindings body body-bindings)
-               (if alternate (recurse alternate))))
-
-            ((<let> names gensyms vals body)
-             (primitive 'let)
-             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
-             (for-each increment-occurrence-count! gensyms)
-             (for-each set-source-name! gensyms names)
-             (for-each recurse vals)
-             (recurse-with-bindings
-              body (fold vhash-consq bindings (map base-name names) gensyms)))
-
-            ((<letrec> in-order? names gensyms vals body)
-             (primitive 'let)
-             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
-             (primitive (if in-order? 'letrec* 'letrec))
-             (for-each increment-occurrence-count! gensyms)
-             (for-each set-source-name! gensyms names)
-             (let* ((base-names (map base-name names))
-                    (bindings (fold vhash-consq bindings base-names gensyms)))
-               (for-each (cut recurse-with-bindings <> bindings) vals)
-               (recurse-with-bindings body bindings)))
-
-            ((<fix> names gensyms vals body)
-             (primitive 'let)
-             (primitive 'letrec*)
-             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
-             (for-each increment-occurrence-count! gensyms)
-             (for-each set-source-name! gensyms names)
-             (let* ((base-names (map base-name names))
-                    (bindings (fold vhash-consq bindings base-names gensyms)))
-               (for-each (cut recurse-with-bindings <> bindings) vals)
-               (recurse-with-bindings body bindings)))
-
-            ((<let-values> exp body)
-             (primitive 'call-with-values)
-             (recurse exp) (recurse body))
-
-            ((<prompt> tag body handler)
-             (primitive 'call-with-prompt)
-             (recurse tag) (recurse body) (recurse handler))
-
-            ((<abort> tag args tail)
-             (primitive 'apply)
-             (primitive 'abort)
-             (recurse tag) (for-each recurse args) (recurse tail)))))
-
-      (let ()
-        (define output-name-table (make-hash-table))
-        (define (set-output-name! s name)
-          (hashq-set! output-name-table s name))
-        (define (output-name s)
-          (if (top-level? s)
-              (top-level-name s)
-              (hashq-ref output-name-table s)))
-
-        (define sorted-lexical-gensyms
-          (sort-list lexical-gensyms
-                     (lambda (a b) (> (occurrence-count a)
-                                      (occurrence-count b)))))
-
-        (for-each (lambda (s)
-                    (set-output-name!
-                     s
-                     (let ((the-conflicts (conflicts s))
-                           (the-source-name (source-name s)))
-                       (define (not-yet-taken? name)
-                         (not (any (lambda (s*)
-                                     (and=> (output-name s*)
-                                            (cut eq? name <>)))
-                                   the-conflicts)))
-                       (if (not-yet-taken? the-source-name)
-                           the-source-name
-                           (let ((prefix (string-append
-                                          (symbol->string the-source-name)
-                                          "-")))
-                             (let loop ((i 1) (name the-source-name))
-                               (if (not-yet-taken? name)
-                                   name
-                                   (loop (+ i 1)
-                                         (string->symbol
-                                          (string-append
-                                           prefix
-                                           (number->string i)))))))))))
-                  sorted-lexical-gensyms)
-        (values output-name-table occurrence-count-table)))))
diff --git a/doc/vouivre.texi b/doc/vouivre.texi
new file mode 100644
index 0000000..099f512
--- /dev/null
+++ b/doc/vouivre.texi
@@ -0,0 +1,60 @@
+\input texinfo
+@c -*-texinfo-*-
+
+@c %**start of header
+@setfilename vouivre.info
+@documentencoding UTF-8
+@settitle Vouivre Reference Manual
+@c %**end of header
+
+@include version.texi
+
+@copying
+Copyright @copyright{} 2023 Vouivre Digital Corporation
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.  A
+copy of the license is included in the section entitled ``GNU Free
+Documentation License''.
+@end copying
+
+@dircategory The Algorithmic Language Scheme
+@direntry
+* Vouivre: (vouivre).   
+@end direntry
+
+@titlepage
+@title The Vouivre Manual
+@author Vouivre Digital Corporation
+
+@page
+@vskip 0pt plus 1filll
+Edition @value{EDITION} @*
+@value{UPDATED} @*
+
+@insertcopying
+@end titlepage
+
+@contents
+
+@c *********************************************************************
+@node Top
+@top Vouivre
+
+This document describes Vouivre version @value{VERSION}.
+
+@menu
+* Introduction::                Why Vouivre?
+@end menu
+
+@c *********************************************************************
+@node Introduction
+@chapter Introduction
+
+INTRODUCTION HERE
+
+This documentation is a stub.
+
+@bye
diff --git a/examples/base.scm b/examples/base.scm
new file mode 100644
index 0000000..90a88a8
--- /dev/null
+++ b/examples/base.scm
@@ -0,0 +1,611 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre base)
+  #:use-module ((guile) #:select (1+) #:prefix guile:)
+  #:use-module ((rnrs base) #:prefix rnrs:)
+  #:use-module ((srfi srfi-1) #:prefix srfi-1:)
+  #:use-module (vouivre curry)
+  #:use-module ((vouivre autodiff) #:prefix v:)
+  #:export
+  (∘
+   ⊙
+   flip
+   fdiff
+   rdiff)
+  #:replace
+  (boolean?
+   not
+   symbol?
+   symbol->string
+   string->symbol
+   char?
+   char=?
+   char<?
+   char>?
+   char<=?
+   char>=?
+   integer->char
+   char->integer
+   list?
+   null?
+   pair?
+   cons
+   car
+   cdr
+   caar
+   cadr
+   cdar
+   cddr
+   caaar
+   cadar
+   cdaar
+   caddr
+   cdadr
+   cddar
+   cdddr
+   caaaar
+   caaadr
+   caadar
+   cadaar
+   cdaaar
+   cddaar
+   cdadar
+   cdaadr
+   cadadr
+   caaddr
+   caddar
+   cadddr
+   cdaddr
+   cddadr
+   cdddar
+   cddddr
+   number?
+   string?
+   procedure?
+   eq?
+   eqv?
+   equal?
+   symbol=?
+   complex?
+   real-part
+   imag-part
+   make-rectangular
+   make-polar
+   magnitude
+   angle
+   sqrt
+   exp
+   expt
+   log
+   sin
+   cos
+   tan
+   asin
+   acos
+   atan
+   real?
+   rational?
+   numerator
+   denominator
+   rationalize
+   exact?
+   inexact?
+   integer?
+   odd?
+   even?
+   gcd
+   lcm
+   exact-integer-sqrt
+   =
+   <
+   >
+   <=
+   >=
+   zero?
+   positive?
+   negative?
+   length
+   list-ref
+   list-tail
+   append
+   reverse
+   number->string
+   string->number
+   make-string
+   list->string
+   string->list
+   string-length
+   string-ref
+   string-copy
+   substring
+   string=?
+   string<?
+   string>?
+   string<=?
+   string>=?
+   string-append
+   +
+   -
+   *
+   /
+   max
+   min
+   abs
+   truncate
+   floor
+   ceiling
+   round
+   div
+   mod
+   real-valued?
+   rational-valued?
+   integer-valued?
+   nan?
+   infinite?
+   finite?
+   fold
+   fold-right
+   reduce
+   reduce-right
+   map
+   1+
+   identity))
+
+;; abbreviation
+(define-syntax cudefine (identifier-syntax curried-untyped-define))
+
+(∷ boolean? (0 . 0))
+(cudefine (boolean? x) (rnrs:boolean? x))
+
+(∷ not (0 . 0))
+(cudefine (not x) (rnrs:not x))
+
+(∷ symbol? (0 . 0))
+(cudefine (symbol? x) (rnrs:symbol? x))
+
+(∷ symbol->string (0 . 0))
+(cudefine (symbol->string x) (rnrs:symbol->string x))
+
+(∷ string->symbol (0 . 0))
+(cudefine (string->symbol x) (rnrs:string->symbol x))
+
+(∷ char? (0 . 0))
+(cudefine (char? x) (rnrs:char? x))
+
+(∷ char=? (0 . (0 . 0)))
+(cudefine (char=? x y) (rnrs:char=? x y))
+
+(∷ char<? (0 . (0 . 0)))
+(cudefine (char<? x y) (rnrs:char<? x y))
+
+(∷ char>? (0 . (0 . 0)))
+(cudefine (char>? x y) (rnrs:char>? x y))
+
+(∷ char<=? (0 . (0 . 0)))
+(cudefine (char<=? x y) (rnrs:char<=? x y))
+
+(∷ char>=? (0 . (0 . 0)))
+(cudefine (char>=? x y) (rnrs:char>=? x y))
+
+(∷ integer->char (0 . 0))
+(cudefine (integer->char x) (rnrs:integer->char x))
+
+(∷ char->integer (0 . 0))
+(cudefine (char->integer x) (rnrs:char->integer x))
+
+(∷ list? (0 . 0))
+(cudefine (list? x) (rnrs:list? x))
+
+(∷ null? (0 . 0))
+(cudefine (null? x) (rnrs:null? x))
+
+(∷ pair? (0 . 0))
+(cudefine (pair? x) (rnrs:pair? x))
+
+(∷ cons (0 . (0 . 0)))
+(cudefine (cons x y) (rnrs:cons x y))
+
+(∷ car (0 . 0))
+(cudefine (car x) (rnrs:car x))
+
+(∷ cdr (0 . 0))
+(cudefine (cdr x) (rnrs:cdr x))
+
+(∷ caar (0 . 0))
+(cudefine (caar x) (rnrs:caar x))
+
+(∷ cadr (0 . 0))
+(cudefine (cadr x) (rnrs:cadr x))
+
+(∷ cdar (0 . 0))
+(cudefine (cdar x) (rnrs:cdar x))
+
+(∷ cddr (0 . 0))
+(cudefine (cddr x) (rnrs:cddr x))
+
+(∷ caaar (0 . 0))
+(cudefine (caaar x) (rnrs:caaar x))
+
+(∷ caadr (0 . 0))
+(cudefine (caadr x) (rnrs:caadr x))
+
+(∷ cadar (0 . 0))
+(cudefine (cadar x) (rnrs:cadar x))
+
+(∷ cdaar (0 . 0))
+(cudefine (cdaar x) (rnrs:cdaar x))
+
+(∷ caddr (0 . 0))
+(cudefine (caddr x) (rnrs:caddr x))
+
+(∷ cdadr (0 . 0))
+(cudefine (cdadr x) (rnrs:cdadr x))
+
+(∷ cddar (0 . 0))
+(cudefine (cddar x) (rnrs:cddar x))
+
+(∷ cdddr (0 . 0))
+(cudefine (cdddr x) (rnrs:cdddr x))
+
+(∷ caaaar (0 . 0))
+(cudefine (caaaar x) (rnrs:caaaar x))
+
+(∷ caaadr (0 . 0))
+(cudefine (caaadr x) (rnrs:caaadr x))
+
+(∷ caadar (0 . 0))
+(cudefine (caadar x) (rnrs:caadar x))
+
+(∷ cadaar (0 . 0))
+(cudefine (cadaar x) (rnrs:cadaar x))
+
+(∷ cdaaar (0 . 0))
+(cudefine (cdaaar x) (rnrs:cdaaar x))
+
+(∷ cddaar (0 . 0))
+(cudefine (cddaar x) (rnrs:cddaar x))
+
+(∷ cdadar (0 . 0))
+(cudefine (cdadar x) (rnrs:cdadar x))
+
+(∷ cdaadr (0 . 0))
+(cudefine (cdaadr x) (rnrs:cdaadr x))
+
+(∷ cadadr (0 . 0))
+(cudefine (cadadr x) (rnrs:cadadr x))
+
+(∷ caaddr (0 . 0))
+(cudefine (caaddr x) (rnrs:caaddr x))
+
+(∷ caddar (0 . 0))
+(cudefine (caddar x) (rnrs:caddar x))
+
+(∷ cadddr (0 . 0))
+(cudefine (cadddr x) (rnrs:cadddr x))
+
+(∷ cdaddr (0 . 0))
+(cudefine (cdaddr x) (rnrs:cdaddr x))
+
+(∷ cddadr (0 . 0))
+(cudefine (cddadr x) (rnrs:cddadr x))
+
+(∷ cdddar (0 . 0))
+(cudefine (cdddar x) (rnrs:cdddar x))
+
+(∷ cddddr (0 . 0))
+(cudefine (cddddr x) (rnrs:cddddr x))
+
+(∷ number? (0 . 0))
+(cudefine (number? x) (rnrs:number? x))
+
+(∷ string? (0 . 0))
+(cudefine (string? x) (rnrs:string? x))
+
+(∷ procedure? (0 . 0))
+(cudefine (procedure? x) (rnrs:procedure? x))
+
+(∷ eq? (0 . (0 . 0)))
+(cudefine (eq? x y) (rnrs:eq? x y))
+
+(∷ eqv? (0 . (0 . 0)))
+(cudefine (eqv? x y) (rnrs:eqv? x y))
+
+(∷ equal? (0 . (0 . 0)))
+(cudefine (equal? x y) (rnrs:equal? x y))
+
+(∷ symbol=? (0 . (0 . 0)))
+(cudefine (symbol=? x y) (rnrs:symbol=? x y))
+
+(∷ complex? (0 . 0))
+(cudefine (complex? x) (rnrs:complex? x))
+
+(∷ real-part (0 . 0))
+(cudefine (real-part x) (rnrs:real-part x))
+
+(∷ imag-part (0 . 0))
+(cudefine (imag-part x) (rnrs:imag-part x))
+
+(∷ make-rectangular (0 . (0 . 0)))
+(cudefine (make-rectangular x y) (rnrs:make-rectangular x y))
+
+(∷ make-polar (0 . (0 . 0)))
+(cudefine (make-polar x y) (rnrs:make-polar x y))
+
+(∷ magnitude (0 . 0))
+(cudefine (magnitude x) (rnrs:magnitude x))
+
+(∷ angle (0 . 0))
+(cudefine (angle x) (rnrs:angle x))
+
+(∷ sqrt (0 . 0))
+(cudefine (sqrt x) (rnrs:sqrt x))
+
+(∷ exp (0 . 0))
+(cudefine (exp x) (rnrs:exp x))
+
+(∷ expt (0 . (0 . 0)))
+(cudefine (expt x y) (rnrs:expt x y))
+
+(∷ log (0 . 0))
+(cudefine (log x) (rnrs:log x))
+
+(∷ sin (0 . 0))
+(cudefine (sin x) (v:sin x))
+
+(∷ cos (0 . 0))
+(cudefine (cos x) (rnrs:cos x))
+
+(∷ tan (0 . 0))
+(cudefine (tan x) (rnrs:tan x))
+
+(∷ asin (0 . 0))
+(cudefine (asin x) (rnrs:asin x))
+
+(∷ acos (0 . 0))
+(cudefine (acos x) (rnrs:acos x))
+
+(∷ atan (0 . 0))
+(cudefine (atan x) (rnrs:atan x))
+
+(∷ real? (0 . 0))
+(cudefine (real? x) (rnrs:real? x))
+
+(∷ rational? (0 . 0))
+(cudefine (rational? x) (rnrs:rational? x))
+
+(∷ numerator (0 . 0))
+(cudefine (numerator x) (rnrs:numerator x))
+
+(∷ denominator (0 . 0))
+(cudefine (denominator x) (rnrs:denominator x))
+
+(∷ rationalize (0 . (0 . 0)))
+(cudefine (rationalize x eps) (rnrs:rationalize x eps))
+
+(∷ exact? (0 . 0))
+(cudefine (exact? x) (rnrs:exact? x))
+
+(∷ inexact? (0 . 0))
+(cudefine (inexact? x) (rnrs:inexact? x))
+
+(∷ integer? (0 . 0))
+(cudefine (integer? x) (rnrs:integer? x))
+
+(∷ odd? (0 . 0))
+(cudefine (odd? x) (rnrs:odd? x))
+
+(∷ even? (0 . 0))
+(cudefine (even? x) (rnrs:even? x))
+
+(∷ gcd (0 . (0 . 0)))
+(cudefine (gcd x y) (rnrs:gcd x y))
+
+(∷ lcm (0 . (0 . 0)))
+(cudefine (lcm x y) (rnrs:lcm x y))
+
+(∷ exact-integer-sqrt (0 . 0))
+(cudefine (exact-integer-sqrt x) (rnrs:exact-integer-sqrt x))
+
+(∷ = (0 . (0 . 0)))
+(cudefine (= x y) (rnrs:= x y))
+
+(∷ < (0 . (0 . 0)))
+(cudefine (< x y) (rnrs:< x y))
+
+(∷ > (0 . (0 . 0)))
+(cudefine (> x y) (rnrs:> x y))
+
+(∷ <= (0 . (0 . 0)))
+(cudefine (<= x y) (rnrs:<= x y))
+
+(∷ >= (0 . (0 . 0)))
+(cudefine (>= x y) (rnrs:>= x y))
+
+(∷ zero? (0 . 0))
+(cudefine (zero? x) (rnrs:zero? x))
+
+(∷ positive? (0 . 0))
+(cudefine (positive? x) (rnrs:positive? x))
+
+(∷ negative? (0 . 0))
+(cudefine (negative? x) (rnrs:negative? x))
+
+(∷ length (0 . 0))
+(cudefine (length x) (rnrs:length x))
+
+(∷ list-ref (0 . (0 . 0)))
+(cudefine (list-ref lst k) (rnrs:list-ref lst k))
+
+(∷ list-tail (0 . (0 . 0)))
+(cudefine (list-tail lst k) (rnrs:list-tail lst k))
+
+(∷ append (0 . (0 . 0)))
+(cudefine (append x y) (rnrs:append x y))
+
+(∷ reverse (0 . 0))
+(cudefine (reverse x) (rnrs:reverse x))
+
+(∷ number->string (0 . (0 . 0)))
+(cudefine (number->string n radix) (rnrs:number->string n radix))
+
+(∷ string->number (0 . (0 . 0)))
+(cudefine (string->number str radix) (rnrs:string->number str radix))
+
+(∷ make-string (0 . (0 . 0)))
+(cudefine (make-string k char) (rnrs:make-string k char))
+
+(∷ list->string (0 . 0))
+(cudefine (list->string x) (rnrs:list->string x))
+
+(∷ string->list (0 . (0 . (0 . 0))))
+(cudefine (string->list str start end) (rnrs:string->list str start end))
+
+(∷ string-length (0 . 0))
+(cudefine (string-length x) (rnrs:string-length x))
+
+(∷ string-ref (0 . (0 . 0)))
+(cudefine (string-ref str k) (rnrs:string-ref str k))
+
+(∷ string-copy (0 . (0 . (0 . 0))))
+(cudefine (string-copy str start end) (rnrs:string-copy str start end))
+
+(∷ substring (0 . (0 . (0 . 0))))
+(cudefine (substring str start end) (rnrs:substring str start end))
+
+(∷ string=? (0 . (0 . 0)))
+(cudefine (string=? x y) (rnrs:string=? x y))
+
+(∷ string<? (0 . (0 . 0)))
+(cudefine (string<? x y) (rnrs:string<? x y))
+
+(∷ string>? (0 . (0 . 0)))
+(cudefine (string>? x y) (rnrs:string>? x y))
+
+(∷ string<=? (0 . (0 . 0)))
+(cudefine (string<=? x y) (rnrs:string<=? x y))
+
+(∷ string>=? (0 . (0 . 0)))
+(cudefine (string>=? x y) (rnrs:string>=? x y))
+
+(∷ string-append (0 . (0 . 0)))
+(cudefine (string-append x y) (rnrs:string-append x y))
+
+(∷ + (0 . (0 . 0)))
+(cudefine (+ x y) (rnrs:+ x y))
+
+(∷ - (0 . (0 . 0)))
+(cudefine (- x y) (rnrs:- x y))
+
+(∷ * (0 . (0 . 0)))
+(cudefine (* x y) (rnrs:* x y))
+
+(∷ / (0 . (0 . 0)))
+(cudefine (/ x y) (rnrs:/ x y))
+
+(∷ max (0 . (0 . 0)))
+(cudefine (max x y) (rnrs:max x y))
+
+(∷ min (0 . (0 . 0)))
+(cudefine (min x y) (rnrs:min x y))
+
+(∷ abs (0 . 0))
+(cudefine (abs x) (rnrs:abs x))
+
+(∷ truncate (0 . 0))
+(cudefine (truncate x) (rnrs:truncate x))
+
+(∷ floor (0 . 0))
+(cudefine (floor x) (rnrs:floor x))
+
+(∷ ceiling (0 . 0))
+(cudefine (ceiling x) (rnrs:ceiling x))
+
+(∷ round (0 . 0))
+(cudefine (round x) (rnrs:round x))
+
+(∷ div (0 . (0 . 0)))
+(cudefine (div x y) (rnrs:div x y))
+
+(∷ mod (0 . (0 . 0)))
+(cudefine (mod x y) (rnrs:mod x y))
+
+(∷ real-valued? (0 . 0))
+(cudefine (real-valued? x) (rnrs:real-valued? x))
+
+(∷ rational-valued? (0 . 0))
+(cudefine (rational-valued? x) (rnrs:rational-valued? x))
+
+(∷ integer-valued? (0 . 0))
+(cudefine (integer-valued? x) (rnrs:integer-valued? x))
+
+(∷ nan? (0 . 0))
+(cudefine (nan? x) (rnrs:nan? x))
+
+(∷ infinite? (0 . 0))
+(cudefine (infinite? x) (rnrs:infinite? x))
+
+(∷ finite? (0 . 0))
+(cudefine (finite? x) (rnrs:finite? x))
+
+(∷ fold ((0 . (0 . 0)) . (0 . (0 . 0))))
+(cudefine (fold f x xs)
+	  (srfi-1:fold
+	   (lambda (x prev)
+	     ((f x) prev))
+	   x xs))
+
+(∷ fold-right ((0 . (0 . 0)) . (0 . (0 . 0))))
+(cudefine (fold-right f x xs)
+	  (srfi-1:fold-right
+	   (lambda (x prev)
+	     ((f x) prev))
+	   x xs))
+
+(∷ reduce ((0 . (0 . 0)) . (0 . 0)))
+(cudefine (reduce f xs)
+	  (when (null? xs)
+	    (error "empty list"))
+	  (srfi-1:reduce
+	   (lambda (x prev)
+	     ((f x) prev))
+	   0
+	   xs))
+
+(∷ reduce-right ((0 . (0 . 0)) . (0 . 0)))
+(cudefine (reduce-right f xs)
+	  (when (null? xs)
+	    (error "empty list"))
+	  (srfi-1:reduce-right
+	   (lambda (x prev)
+	     ((f x) prev))
+	   0
+	   xs))
+
+(∷ map ((0 . 0) . (0 . 0)))
+(cudefine (map f xs) (srfi-1:map f xs))
+
+(∷ 1+ (0 . 0))
+(cudefine (1+ x) (guile:1+ x))
+
+(definec (identity x) x)
+(definec (∘ g f) (λc x (g (f x))))
+(definec (⊙ f g) (∘ g f))
+(definec (flip f) (λc y (λc x (f x y))))
+
+(define fdiff v:fdiff)
+(define rdiff v:rdiff)
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..ee041ad
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,36 @@
+(use-modules
+ (guix packages)
+ ((guix licenses) #:prefix license:)
+ (guix download)
+ (guix gexp)
+ (guix build-system gnu)
+ (gnu packages)
+ (gnu packages autotools)
+ (gnu packages guile)
+ (gnu packages guile-xyz)
+ (gnu packages pkg-config)
+ (gnu packages texinfo)
+ (srfi srfi-1))
+
+(package
+ (name "vouivre")
+ (version "0.1.0")
+ (source
+  (local-file
+   (dirname (current-filename))
+   #:recursive?
+   #t
+   #:select?
+   (lambda (file stat)
+     (not (any (lambda (my-string) (string-contains file my-string))
+               (list ".git" ".dir-locals.el" "guix.scm"))))))
+ (build-system gnu-build-system)
+ (arguments `())
+ (native-inputs (list autoconf automake pkg-config texinfo))
+ (inputs (list guile-3.0))
+ (propagated-inputs (list))
+ (synopsis "")
+ (description "")
+ (home-page "https://vouivredigital.com")
+ (license license:gpl3+))
+
diff --git a/hall.scm b/hall.scm
new file mode 100644
index 0000000..2679954
--- /dev/null
+++ b/hall.scm
@@ -0,0 +1,69 @@
+(hall-description
+ (name "vouivre")
+ (prefix "")
+ (version "0.1.0")
+ (author "Vouivre Digital Corporation")
+ (email "admin@vouivredigital.com")
+ (copyright (2023))
+ (synopsis "")
+ (description "")
+ (home-page "https://vouivredigital.com")
+ (license gpl3+)
+ (dependencies `())
+ (skip ())
+ (features ((guix #f) (native-language-support #f) (licensing #f)))
+ (files (libraries
+         ((scheme-file "vouivre")
+          (directory
+           "language"
+           ((directory
+             "vouivre"
+             ((scheme-file "decompile-tree-il")
+              (scheme-file "spec")
+              (scheme-file "compile-tree-il")))))
+          (directory
+           "vouivre"
+           ((scheme-file "hconfig")
+            (scheme-file "curry")
+            (scheme-file "autodiff")
+            (scheme-file "misc")
+            (scheme-file "promises")
+            (scheme-file "mnist")))))
+        (tests ((directory
+                 "tests"
+                 ((scheme-file "curry") (scheme-file "autodiff")))))
+        (programs ((directory "scripts" ())
+		   (directory "examples" ((scheme-file "example")
+					  (scheme-file "base")))))
+        (documentation
+         ((org-file "README")
+          (symlink "README" "README.org")
+          (text-file "HACKING")
+          (text-file "COPYING")
+	  (text-file "COPYING.LESSER")
+          (directory
+           "doc"
+           ((info-file "vouivre")
+            (info-file "version")
+            (texi-file "version")
+            (text-file ".dirstamp")
+            (texi-file "vouivre")
+            (text-file "stamp-vti")))
+	  (text-file "LICENSE")
+          (text-file "NEWS")
+          (text-file "AUTHORS")
+          (text-file "ChangeLog")))
+        (infrastructure
+         ((scheme-file "guix")
+          (text-file ".gitignore")
+          (scheme-file "hall")
+          (directory
+           "build-aux"
+           ((tex-file "texinfo")
+            (text-file "mdate-sh")
+            (scheme-file "test-driver")
+            (text-file "missing")
+            (text-file "install-sh")))
+          (autoconf-file "configure")
+          (in-file "pre-inst-env")
+          (automake-file "Makefile")))))
diff --git a/language/vouivre/compile-tree-il.scm b/language/vouivre/compile-tree-il.scm
new file mode 100644
index 0000000..9b1dfc6
--- /dev/null
+++ b/language/vouivre/compile-tree-il.scm
@@ -0,0 +1,42 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; This file has been modified by Vouivre Digital Corporation. The exact
+;;;; modifications can be seen in a shell using:
+;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 compile-tree-il.scm
+
+;;; Code:
+
+(define-module (language vouivre compile-tree-il)
+  #:use-module (language tree-il)
+  #:use-module (srfi srfi-71)
+  #:use-module (vouivre curry)
+  #:export (compile-tree-il))
+
+;;; environment := MODULE
+
+(define (compile-tree-il x e opts)
+  (save-module-excursion
+   (lambda ()
+     (set-current-module e)
+     ;; TODO: Why do we need to use `(@@ (vouivre curry) symtab)' here instead of
+     ;;       simply `symtab'? If we don't it always return an empty symtab.
+     (let ((t expr (expand (@@ (vouivre curry) symtab) (syntax->datum x))))
+       (let* ((x (macroexpand expr 'c '(compile load eval)))
+              (cenv (current-module)))
+	 (values x cenv cenv))))))
diff --git a/language/vouivre/decompile-tree-il.scm b/language/vouivre/decompile-tree-il.scm
new file mode 100644
index 0000000..153bcd2
--- /dev/null
+++ b/language/vouivre/decompile-tree-il.scm
@@ -0,0 +1,800 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001, 2009, 2012, 2013 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; This file has been modified by Vouivre Digital Corporation. The exact
+;;;; modifications can be seen in a shell using:
+;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 decompile-tree-il.scm
+
+;;; Code:
+
+(define-module (language vouivre decompile-tree-il)
+  #:use-module (language tree-il)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (system base syntax)
+  #:export (decompile-tree-il))
+
+(define (decompile-tree-il e env opts)
+  (apply do-decompile e env opts))
+
+(define* (do-decompile e env
+                       #:key
+                       (use-derived-syntax? #t)
+                       (avoid-lambda? #t)
+                       (use-case? #t)
+                       (strip-numeric-suffixes? #f)
+                       #:allow-other-keys)
+
+  (receive (output-name-table occurrence-count-table)
+      (choose-output-names e use-derived-syntax? strip-numeric-suffixes?)
+
+    (define (output-name s)      (hashq-ref output-name-table s))
+    (define (occurrence-count s) (hashq-ref occurrence-count-table s))
+
+    (define (const x) (lambda (_) x))
+    (define (atom? x) (not (or (pair? x) (vector? x))))
+
+    (define (build-void) '(if #f #f))
+
+    (define (build-begin es)
+      (match es
+        (() (build-void))
+        ((e) e)
+        (_ `(begin ,@es))))
+
+    (define (build-lambda-body e)
+      (match e
+        (('let () body ...) body)
+        (('begin es ...) es)
+        (_ (list e))))
+
+    (define (build-begin-body e)
+      (match e
+        (('begin es ...) es)
+        (_ (list e))))
+
+    (define (build-define name e)
+      (match e
+        ((? (const avoid-lambda?)
+            ('lambda formals body ...))
+         `(define (,name ,@formals) ,@body))
+        ((? (const avoid-lambda?)
+            ('lambda* formals body ...))
+         `(define* (,name ,@formals) ,@body))
+        (_ `(define ,name ,e))))
+
+    (define (build-let names vals body)
+      (match `(let ,(map list names vals)
+                ,@(build-lambda-body body))
+        ((_ () e) e)
+        ((_ (b) ('let* (bs ...) body ...))
+         `(let* (,b ,@bs) ,@body))
+        ((? (const use-derived-syntax?)
+            (_ (b1) ('let (b2) body ...)))
+         `(let* (,b1 ,b2) ,@body))
+        (e e)))
+
+    (define (build-letrec in-order? names vals body)
+      (match `(,(if in-order? 'letrec* 'letrec)
+               ,(map list names vals)
+               ,@(build-lambda-body body))
+        ((_ () e) e)
+        ((_ () body ...) `(let () ,@body))
+        ((_ ((name ('lambda (formals ...) body ...)))
+            (name args ...))
+         (=> failure)
+         (if (= (length formals) (length args))
+             `(let ,name ,(map list formals args) ,@body)
+             (failure)))
+        ((? (const avoid-lambda?)
+            ('letrec* _ body ...))
+         `(let ()
+            ,@(map build-define names vals)
+            ,@body))
+        (e e)))
+
+    (define (build-if test consequent alternate)
+      (match alternate
+        (('if #f _) `(if ,test ,consequent))
+        (_ `(if ,test ,consequent ,alternate))))
+
+    (define (build-and xs)
+      (match xs
+        (() #t)
+        ((x) x)
+        (_ `(and ,@xs))))
+
+    (define (build-or xs)
+      (match xs
+        (() #f)
+        ((x) x)
+        (_ `(or ,@xs))))
+
+    (define (case-test-var test)
+      (match test
+        (('memv (? atom? v) ('quote (datums ...)))
+         v)
+        (('eqv? (? atom? v) ('quote datum))
+         v)
+        (_ #f)))
+
+    (define (test->datums v test)
+      (match (cons v test)
+        ((v 'memv v ('quote (xs ...)))
+         xs)
+        ((v 'eqv? v ('quote x))
+         (list x))
+        (_ #f)))
+
+    (define (build-else-tail e)
+      (match e
+        (('if #f _) '())
+        (('and xs ... x) `((,(build-and xs) ,@(build-begin-body x))
+                           (else #f)))
+        (_ `((else ,@(build-begin-body e))))))
+
+    (define (build-cond-else-tail e)
+      (match e
+        (('cond clauses ...) clauses)
+        (_ (build-else-tail e))))
+
+    (define (build-case-else-tail v e)
+      (match (cons v e)
+        ((v 'case v clauses ...)
+         clauses)
+        ((v 'if ('memv v ('quote (xs ...))) consequent . alternate*)
+         `((,xs ,@(build-begin-body consequent))
+           ,@(build-case-else-tail v (build-begin alternate*))))
+        ((v 'if ('eqv? v ('quote x)) consequent . alternate*)
+         `(((,x) ,@(build-begin-body consequent))
+           ,@(build-case-else-tail v (build-begin alternate*))))
+        (_ (build-else-tail e))))
+
+    (define (clauses+tail clauses)
+      (match clauses
+        ((cs ... (and c ('else . _))) (values cs (list c)))
+        (_ (values clauses '()))))
+
+    (define (build-cond tests consequents alternate)
+      (case (length tests)
+        ((0) alternate)
+        ((1) (build-if (car tests) (car consequents) alternate))
+        (else `(cond ,@(map (lambda (test consequent)
+                              `(,test ,@(build-begin-body consequent)))
+                            tests consequents)
+                     ,@(build-cond-else-tail alternate)))))
+
+    (define (build-cond-or-case tests consequents alternate)
+      (if (not use-case?)
+          (build-cond tests consequents alternate)
+          (let* ((v (and (not (null? tests))
+                         (case-test-var (car tests))))
+                 (datum-lists (take-while identity
+                                          (map (cut test->datums v <>)
+                                               tests)))
+                 (n (length datum-lists))
+                 (tail (build-case-else-tail v (build-cond
+                                                (drop tests n)
+                                                (drop consequents n)
+                                                alternate))))
+            (receive (clauses tail) (clauses+tail tail)
+              (let ((n (+ n (length clauses)))
+                    (datum-lists (append datum-lists
+                                         (map car clauses)))
+                    (consequents (append consequents
+                                         (map build-begin
+                                              (map cdr clauses)))))
+                (if (< n 2)
+                    (build-cond tests consequents alternate)
+                    `(case ,v
+                       ,@(map cons datum-lists (map build-begin-body
+                                                    (take consequents n)))
+                       ,@tail)))))))
+
+    (define (recurse e)
+
+      (define (recurse-body e)
+        (build-lambda-body (recurse e)))
+
+      (record-case e
+        ((<void>)
+         (build-void))
+
+        ((<const> exp)
+         (if (and (self-evaluating? exp) (not (vector? exp)))
+             exp
+             `(quote ,exp)))
+
+        ((<seq> head tail)
+         (build-begin (cons (recurse head)
+                            (build-begin-body
+                             (recurse tail)))))
+
+        ((<call> proc args)
+         (match `(,(recurse proc) ,@(map recurse args))
+           ((('lambda (formals ...) body ...) args ...)
+            (=> failure)
+            (if (= (length formals) (length args))
+                (build-let formals args (build-begin body))
+                (failure)))
+           (e e)))
+
+        ((<primcall> name args)
+         `(,name ,@(map recurse args)))
+
+        ((<primitive-ref> name)
+         name)
+
+        ((<lexical-ref> gensym)
+         (output-name gensym))
+
+        ((<lexical-set> gensym exp)
+         `(set! ,(output-name gensym) ,(recurse exp)))
+
+        ((<module-ref> mod name public?)
+         `(,(if public? '@ '@@) ,mod ,name))
+
+        ((<module-set> mod name public? exp)
+         `(set! (,(if public? '@ '@@) ,mod ,name) ,(recurse exp)))
+
+        ((<toplevel-ref> name)
+         name)
+
+        ((<toplevel-set> name exp)
+         `(set! ,name ,(recurse exp)))
+
+        ((<toplevel-define> name exp)
+         (build-define name (recurse exp)))
+
+        ((<lambda> meta body)
+         (if body
+             (let ((body (recurse body))
+                   (doc (assq-ref meta 'documentation)))
+               (if (not doc)
+                   body
+                   (match body
+                     (('lambda formals body ...)
+                      `(lambda ,formals ,doc ,@body))
+                     (('lambda* formals body ...)
+                      `(lambda* ,formals ,doc ,@body))
+                     (('case-lambda (formals body ...) clauses ...)
+                      `(case-lambda (,formals ,doc ,@body) ,@clauses))
+                     (('case-lambda* (formals body ...) clauses ...)
+                      `(case-lambda* (,formals ,doc ,@body) ,@clauses))
+                     (e e))))
+             '(case-lambda)))
+
+        ((<lambda-case> req opt rest kw inits gensyms body alternate)
+         (let ((names (map output-name gensyms)))
+           (cond
+            ((and (not opt) (not kw) (not alternate))
+             `(lambda ,(if rest (apply cons* names) names)
+                ,@(recurse-body body)))
+            ((and (not opt) (not kw))
+             (let ((alt-expansion (recurse alternate))
+                   (formals (if rest (apply cons* names) names)))
+               (case (car alt-expansion)
+                 ((lambda)
+                  `(case-lambda (,formals ,@(recurse-body body))
+                                ,(cdr alt-expansion)))
+                 ((lambda*)
+                  `(case-lambda* (,formals ,@(recurse-body body))
+                                 ,(cdr alt-expansion)))
+                 ((case-lambda)
+                  `(case-lambda (,formals ,@(recurse-body body))
+                                ,@(cdr alt-expansion)))
+                 ((case-lambda*)
+                  `(case-lambda* (,formals ,@(recurse-body body))
+                                 ,@(cdr alt-expansion))))))
+            (else
+             (let* ((alt-expansion (and alternate (recurse alternate)))
+                    (nreq (length req))
+                    (nopt (if opt (length opt) 0))
+                    (restargs (if rest (list-ref names (+ nreq nopt)) '()))
+                    (reqargs (list-head names nreq))
+                    (optargs (if opt
+                                 `(#:optional
+                                   ,@(map list
+                                          (list-head (list-tail names nreq) nopt)
+                                          (map recurse
+                                               (list-head inits nopt))))
+                                 '()))
+                    (kwargs (if kw
+                                `(#:key
+                                  ,@(map list
+                                         (map output-name (map caddr (cdr kw)))
+                                         (map recurse
+                                              (list-tail inits nopt))
+                                         (map car (cdr kw)))
+                                  ,@(if (car kw)
+                                        '(#:allow-other-keys)
+                                        '()))
+                                '()))
+                    (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs)))
+               (if (not alt-expansion)
+                   `(lambda* ,formals ,@(recurse-body body))
+                   (case (car alt-expansion)
+                     ((lambda lambda*)
+                      `(case-lambda* (,formals ,@(recurse-body body))
+                                     ,(cdr alt-expansion)))
+                     ((case-lambda case-lambda*)
+                      `(case-lambda* (,formals ,@(recurse-body body))
+                                     ,@(cdr alt-expansion))))))))))
+
+        ((<conditional> test consequent alternate)
+         (define (simplify-test e)
+           (match e
+             (('if ('eqv? (? atom? v) ('quote a)) #t ('eqv? v ('quote b)))
+              `(memv ,v '(,a ,b)))
+             (('if ('eqv? (? atom? v) ('quote a)) #t ('memv v ('quote (bs ...))))
+              `(memv ,v '(,a ,@bs)))
+             (('case (? atom? v)
+                ((datum) #t) ...
+                ('else ('eqv? v ('quote last-datum))))
+              `(memv ,v '(,@datum ,last-datum)))
+             (_ e)))
+         (match `(if ,(simplify-test (recurse test))
+                     ,(recurse consequent)
+                     ,@(if (void? alternate) '()
+                           (list (recurse alternate))))
+           (('if test ('if ('and xs ...) consequent))
+            (build-if (build-and (cons test xs))
+                      consequent
+                      (build-void)))
+           ((? (const use-derived-syntax?)
+               ('if test1 ('if test2 consequent)))
+            (build-if (build-and (list test1 test2))
+                      consequent
+                      (build-void)))
+           (('if (? atom? x) x ('or ys ...))
+            (build-or (cons x ys)))
+           ((? (const use-derived-syntax?)
+               ('if (? atom? x) x y))
+            (build-or (list x y)))
+           (('if test consequent)
+            `(if ,test ,consequent))
+           (('if test ('and xs ...) #f)
+            (build-and (cons test xs)))
+           ((? (const use-derived-syntax?)
+               ('if test consequent #f))
+            (build-and (list test consequent)))
+           ((? (const use-derived-syntax?)
+               ('if test1 consequent1
+                    ('if test2 consequent2 . alternate*)))
+            (build-cond-or-case (list test1 test2)
+                                (list consequent1 consequent2)
+                                (build-begin alternate*)))
+           (('if test consequent ('cond clauses ...))
+            `(cond (,test ,@(build-begin-body consequent))
+                   ,@clauses))
+           (('if ('memv (? atom? v) ('quote (xs ...))) consequent
+                 ('case v clauses ...))
+            `(case ,v (,xs ,@(build-begin-body consequent))
+                   ,@clauses))
+           (('if ('eqv? (? atom? v) ('quote x)) consequent
+                 ('case v clauses ...))
+            `(case ,v ((,x) ,@(build-begin-body consequent))
+                   ,@clauses))
+           (e e)))
+
+        ((<let> gensyms vals body)
+         (match (build-let (map output-name gensyms)
+                           (map recurse vals)
+                           (recurse body))
+           (('let ((v e)) ('or v xs ...))
+            (=> failure)
+            (if (and (not (null? gensyms))
+                     (= 3 (occurrence-count (car gensyms))))
+                `(or ,e ,@xs)
+                (failure)))
+           (('let ((v e)) ('case v clauses ...))
+            (=> failure)
+            (if (and (not (null? gensyms))
+                     ;; FIXME: This fails if any of the 'memv's were
+                     ;; optimized into multiple 'eqv?'s, because the
+                     ;; occurrence count will be higher than we expect.
+                     (= (occurrence-count (car gensyms))
+                        (1+ (length (clauses+tail clauses)))))
+                `(case ,e ,@clauses)
+                (failure)))
+           (e e)))
+
+        ((<letrec> in-order? gensyms vals body)
+         (build-letrec in-order?
+                       (map output-name gensyms)
+                       (map recurse vals)
+                       (recurse body)))
+
+        ((<fix> gensyms vals body)
+         ;; not a typo, we really do translate back to letrec. use letrec* since it
+         ;; doesn't matter, and the naive letrec* transformation does not require an
+         ;; inner let.
+         (build-letrec #t
+                       (map output-name gensyms)
+                       (map recurse vals)
+                       (recurse body)))
+
+        ((<let-values> exp body)
+         `(call-with-values (lambda () ,@(recurse-body exp))
+            ,(recurse (make-lambda #f '() body))))
+
+        ((<prompt> escape-only? tag body handler)
+         `(call-with-prompt
+           ,(recurse tag)
+           ,(if escape-only?
+                `(lambda () ,(recurse body))
+                (recurse body))
+           ,(recurse handler)))
+
+
+        ((<abort> tag args tail)
+         `(apply abort ,(recurse tag) ,@(map recurse args)
+                 ,(recurse tail)))))
+    (values (recurse e) env)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Algorithm for choosing better variable names
+;; ============================================
+;;
+;; First we perform an analysis pass, collecting the following
+;; information:
+;;
+;; * For each gensym: how many occurrences will occur in the output?
+;;
+;; * For each gensym A: which gensyms does A conflict with?  Gensym A
+;;   and gensym B conflict if they have the same base name (usually the
+;;   same as the source name, but see below), and if giving them the
+;;   same name would cause a bad variable reference due to unintentional
+;;   variable capture.
+;;
+;; The occurrence counter is indexed by gensym and is global (within each
+;; invocation of the algorithm), implemented using a hash table.  We also
+;; keep a global mapping from gensym to source name as provided by the
+;; binding construct (we prefer not to trust the source names in the
+;; lexical ref or set).
+;;
+;; As we recurse down into lexical binding forms, we keep track of a
+;; mapping from base name to an ordered list of bindings, innermost
+;; first.  When we encounter a variable occurrence, we increment the
+;; counter, look up the base name (preferring not to trust the 'name' in
+;; the lexical ref or set), and then look up the bindings currently in
+;; effect for that base name.  Hopefully our gensym will be the first
+;; (innermost) binding.  If not, we register a conflict between the
+;; referenced gensym and the other bound gensyms with the same base name
+;; that shadow the binding we want.  These are simply the gensyms on the
+;; binding list that come before our gensym.
+;;
+;; Top-level bindings are treated specially.  Whenever top-level
+;; references are found, they conflict with every lexical binding
+;; currently in effect with the same base name.  They are guaranteed to
+;; be assigned to their source names.  For purposes of recording
+;; conflicts (which are normally keyed on gensyms) top-level identifiers
+;; are assigned a pseudo-gensym that is an interned pair of the form
+;; (top-level . <name>).  This allows them to be compared using 'eq?'
+;; like other gensyms.
+;;
+;; The base name is normally just the source name.  However, if the
+;; source name has a suffix of the form "-N" (where N is a positive
+;; integer without leading zeroes), then we strip that suffix (multiple
+;; times if necessary) to form the base name.  We must do this because
+;; we add suffixes of that form in order to resolve conflicts, and we
+;; must ensure that only identifiers with the same base name can
+;; possibly conflict with each other.
+;;
+;; XXX FIXME: Currently, primitives are treated exactly like top-level
+;; bindings.  This handles conflicting lexical bindings properly, but
+;; does _not_ handle the case where top-level bindings conflict with the
+;; needed primitives.
+;;
+;; Also note that this requires that 'choose-output-names' be kept in
+;; sync with 'tree-il->scheme'.  Primitives that are introduced by
+;; 'tree-il->scheme' must be anticipated by 'choose-output-name'.
+;;
+;; We also ensure that lexically-bound identifiers found in operator
+;; position will never be assigned one of the standard primitive names.
+;; This is needed because 'tree-il->scheme' recognizes primitive names
+;; in operator position and assumes that they have the standard
+;; bindings.
+;;
+;;
+;; How we assign an output name to each gensym
+;; ===========================================
+;;
+;; We process the gensyms in order of decreasing occurrence count, with
+;; each gensym choosing the best output name possible, as long as it
+;; isn't the same name as any of the previously-chosen output names of
+;; conflicting gensyms.
+;;
+
+
+;;
+;; 'choose-output-names' analyzes the top-level form e, chooses good
+;; variable names that are as close as possible to the source names,
+;; and returns two values:
+;;
+;;  * a hash table mapping gensym to output name
+;;  * a hash table mapping gensym to number of occurrences
+;;
+(define choose-output-names
+  (let ()
+    (define primitive?
+      ;; This is a list of primitives that 'tree-il->scheme' assumes
+      ;; will have the standard bindings when found in operator
+      ;; position.
+      (let* ((primitives '(if quote @ @@ set! define define*
+                              begin let let* letrec letrec*
+                              and or cond case
+                              lambda lambda* case-lambda case-lambda*
+                              apply call-with-values dynamic-wind
+                              with-fluids fluid-ref fluid-set!
+                              call-with-prompt abort memv eqv?))
+             (table (make-hash-table (length primitives))))
+        (for-each (cut hashq-set! table <> #t) primitives)
+        (lambda (name) (hashq-ref table name))))
+
+    ;; Repeatedly strip suffix of the form "-N", where N is a string
+    ;; that could be produced by number->string given a positive
+    ;; integer.  In other words, the first digit of N may not be 0.
+    (define compute-base-name
+      (let ((digits (string->char-set "0123456789")))
+        (define (base-name-string str)
+          (let ((i (string-skip-right str digits)))
+            (if (and i (< (1+ i) (string-length str))
+                     (eq? #\- (string-ref str i))
+                     (not (eq? #\0 (string-ref str (1+ i)))))
+                (base-name-string (substring str 0 i))
+                str)))
+        (lambda (sym)
+          (string->symbol (base-name-string (symbol->string sym))))))
+
+    ;; choose-output-names
+    (lambda (e use-derived-syntax? strip-numeric-suffixes?)
+
+      (define lexical-gensyms '())
+
+      (define top-level-intern!
+        (let ((table (make-hash-table)))
+          (lambda (name)
+            (let ((h (hashq-create-handle! table name #f)))
+              (or (cdr h) (begin (set-cdr! h (cons 'top-level name))
+                                 (cdr h)))))))
+      (define (top-level? s) (pair? s))
+      (define (top-level-name s) (cdr s))
+
+      (define occurrence-count-table (make-hash-table))
+      (define (occurrence-count s) (or (hashq-ref occurrence-count-table s) 0))
+      (define (increment-occurrence-count! s)
+        (let ((h (hashq-create-handle! occurrence-count-table s 0)))
+          (if (zero? (cdr h))
+              (set! lexical-gensyms (cons s lexical-gensyms)))
+          (set-cdr! h (1+ (cdr h)))))
+
+      (define base-name
+        (let ((table (make-hash-table)))
+          (lambda (name)
+            (let ((h (hashq-create-handle! table name #f)))
+              (or (cdr h) (begin (set-cdr! h (compute-base-name name))
+                                 (cdr h)))))))
+
+      (define source-name-table (make-hash-table))
+      (define (set-source-name! s name)
+        (if (not (top-level? s))
+            (let ((name (if strip-numeric-suffixes?
+                            (base-name name)
+                            name)))
+              (hashq-set! source-name-table s name))))
+      (define (source-name s)
+        (if (top-level? s)
+            (top-level-name s)
+            (hashq-ref source-name-table s)))
+
+      (define conflict-table (make-hash-table))
+      (define (conflicts s) (or (hashq-ref conflict-table s) '()))
+      (define (add-conflict! a b)
+        (define (add! a b)
+          (if (not (top-level? a))
+              (let ((h (hashq-create-handle! conflict-table a '())))
+                (if (not (memq b (cdr h)))
+                    (set-cdr! h (cons b (cdr h)))))))
+        (add! a b)
+        (add! b a))
+
+      (let recurse-with-bindings ((e e) (bindings vlist-null))
+        (let recurse ((e e))
+
+          ;; We call this whenever we encounter a top-level ref or set
+          (define (top-level name)
+            (let ((bname (base-name name)))
+              (let ((s (top-level-intern! name))
+                    (conflicts (vhash-foldq* cons '() bname bindings)))
+                (for-each (cut add-conflict! s <>) conflicts))))
+
+          ;; We call this whenever we encounter a primitive reference.
+          ;; We must also call it for every primitive that might be
+          ;; inserted by 'tree-il->scheme'.  It is okay to call this
+          ;; even when 'tree-il->scheme' will not insert the named
+          ;; primitive; the worst that will happen is for a lexical
+          ;; variable of the same name to be renamed unnecessarily.
+          (define (primitive name) (top-level name))
+
+          ;; We call this whenever we encounter a lexical ref or set.
+          (define (lexical s)
+            (increment-occurrence-count! s)
+            (let ((conflicts
+                   (take-while
+                    (lambda (s*) (not (eq? s s*)))
+                    (reverse! (vhash-foldq* cons
+                                            '()
+                                            (base-name (source-name s))
+                                            bindings)))))
+              (for-each (cut add-conflict! s <>) conflicts)))
+
+          (record-case e
+            ((<void>)  (primitive 'if)) ; (if #f #f)
+            ((<const>) (primitive 'quote))
+
+            ((<call> proc args)
+             (if (lexical-ref? proc)
+                 (let* ((gensym (lexical-ref-gensym proc))
+                        (name (source-name gensym)))
+                   ;; If the operator position contains a bare variable
+                   ;; reference with the same source name as a standard
+                   ;; primitive, we must ensure that it will be given a
+                   ;; different name, so that 'tree-il->scheme' will not
+                   ;; misinterpret the resulting expression.
+                   (if (primitive? name)
+                       (add-conflict! gensym (top-level-intern! name)))))
+             (recurse proc)
+             (for-each recurse args))
+
+            ((<primitive-ref> name) (primitive name))
+            ((<primcall> name args) (primitive name) (for-each recurse args))
+
+            ((<lexical-ref> gensym) (lexical gensym))
+            ((<lexical-set> gensym exp)
+             (primitive 'set!) (lexical gensym) (recurse exp))
+
+            ((<module-ref> public?) (primitive (if public? '@ '@@)))
+            ((<module-set> public? exp)
+             (primitive 'set!) (primitive (if public? '@ '@@)) (recurse exp))
+
+            ((<toplevel-ref> name) (top-level name))
+            ((<toplevel-set> name exp)
+             (primitive 'set!) (top-level name) (recurse exp))
+            ((<toplevel-define> name exp) (top-level name) (recurse exp))
+
+            ((<conditional> test consequent alternate)
+             (cond (use-derived-syntax?
+                    (primitive 'and) (primitive 'or)
+                    (primitive 'cond) (primitive 'case)
+                    (primitive 'else) (primitive '=>)))
+             (primitive 'if)
+             (recurse test) (recurse consequent) (recurse alternate))
+
+            ((<seq> head tail)
+             (primitive 'begin) (recurse head) (recurse tail))
+
+            ((<lambda> body)
+             (if body (recurse body) (primitive 'case-lambda)))
+
+            ((<lambda-case> req opt rest kw inits gensyms body alternate)
+             (primitive 'lambda)
+             (cond ((or opt kw alternate)
+                    (primitive 'lambda*)
+                    (primitive 'case-lambda)
+                    (primitive 'case-lambda*)))
+             (primitive 'let)
+             (if use-derived-syntax? (primitive 'let*))
+             (let* ((names (append req (or opt '()) (if rest (list rest) '())
+                                   (map cadr (if kw (cdr kw) '()))))
+                    (base-names (map base-name names))
+                    (body-bindings
+                     (fold vhash-consq bindings base-names gensyms)))
+               (for-each increment-occurrence-count! gensyms)
+               (for-each set-source-name! gensyms names)
+               (for-each recurse inits)
+               (recurse-with-bindings body body-bindings)
+               (if alternate (recurse alternate))))
+
+            ((<let> names gensyms vals body)
+             (primitive 'let)
+             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+             (for-each increment-occurrence-count! gensyms)
+             (for-each set-source-name! gensyms names)
+             (for-each recurse vals)
+             (recurse-with-bindings
+              body (fold vhash-consq bindings (map base-name names) gensyms)))
+
+            ((<letrec> in-order? names gensyms vals body)
+             (primitive 'let)
+             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+             (primitive (if in-order? 'letrec* 'letrec))
+             (for-each increment-occurrence-count! gensyms)
+             (for-each set-source-name! gensyms names)
+             (let* ((base-names (map base-name names))
+                    (bindings (fold vhash-consq bindings base-names gensyms)))
+               (for-each (cut recurse-with-bindings <> bindings) vals)
+               (recurse-with-bindings body bindings)))
+
+            ((<fix> names gensyms vals body)
+             (primitive 'let)
+             (primitive 'letrec*)
+             (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+             (for-each increment-occurrence-count! gensyms)
+             (for-each set-source-name! gensyms names)
+             (let* ((base-names (map base-name names))
+                    (bindings (fold vhash-consq bindings base-names gensyms)))
+               (for-each (cut recurse-with-bindings <> bindings) vals)
+               (recurse-with-bindings body bindings)))
+
+            ((<let-values> exp body)
+             (primitive 'call-with-values)
+             (recurse exp) (recurse body))
+
+            ((<prompt> tag body handler)
+             (primitive 'call-with-prompt)
+             (recurse tag) (recurse body) (recurse handler))
+
+            ((<abort> tag args tail)
+             (primitive 'apply)
+             (primitive 'abort)
+             (recurse tag) (for-each recurse args) (recurse tail)))))
+
+      (let ()
+        (define output-name-table (make-hash-table))
+        (define (set-output-name! s name)
+          (hashq-set! output-name-table s name))
+        (define (output-name s)
+          (if (top-level? s)
+              (top-level-name s)
+              (hashq-ref output-name-table s)))
+
+        (define sorted-lexical-gensyms
+          (sort-list lexical-gensyms
+                     (lambda (a b) (> (occurrence-count a)
+                                      (occurrence-count b)))))
+
+        (for-each (lambda (s)
+                    (set-output-name!
+                     s
+                     (let ((the-conflicts (conflicts s))
+                           (the-source-name (source-name s)))
+                       (define (not-yet-taken? name)
+                         (not (any (lambda (s*)
+                                     (and=> (output-name s*)
+                                            (cut eq? name <>)))
+                                   the-conflicts)))
+                       (if (not-yet-taken? the-source-name)
+                           the-source-name
+                           (let ((prefix (string-append
+                                          (symbol->string the-source-name)
+                                          "-")))
+                             (let loop ((i 1) (name the-source-name))
+                               (if (not-yet-taken? name)
+                                   name
+                                   (loop (+ i 1)
+                                         (string->symbol
+                                          (string-append
+                                           prefix
+                                           (number->string i)))))))))))
+                  sorted-lexical-gensyms)
+        (values output-name-table occurrence-count-table)))))
diff --git a/language/vouivre/spec.scm b/language/vouivre/spec.scm
new file mode 100644
index 0000000..a07f7c1
--- /dev/null
+++ b/language/vouivre/spec.scm
@@ -0,0 +1,68 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2021 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;;; This file has been modified by Vouivre Digital Corporation. The exact
+;;;; modifications can be seen in a shell using:
+;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 spec.scm
+
+;;; Code:
+
+(define-module (language vouivre spec)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (language vouivre compile-tree-il)
+  #:use-module (language vouivre decompile-tree-il)
+  #:use-module (vouivre curry)
+  #:export (vouivre))
+
+;;;
+;;; Language definition
+;;;
+
+(define-language vouivre
+  #:title	"Vouivre"
+  #:reader      (lambda (port env)
+                  ;; Use the binding of current-reader from the environment.
+                  ;; FIXME: Handle `read-options' as well?
+                  ((or (and=> (and=> (module-variable env 'current-reader)
+                                     variable-ref)
+                              fluid-ref)
+                       read-syntax)
+                   port))
+
+  #:compilers   `((tree-il . ,compile-tree-il))
+  #:decompilers `((tree-il . ,decompile-tree-il))
+  #:evaluator	(lambda (x module) (primitive-eval x))
+  #:printer	write
+  #:make-default-environment
+                (lambda ()
+                  ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
+                  ;; `fluid-set!', etc. don't have any effect in the current environment.
+                  (let ((m (make-fresh-user-module)))
+                    ;; Provide a separate `current-reader' fluid so that
+                    ;; compile-time changes to `current-reader' are
+                    ;; limited to the current compilation unit.
+                    (module-define! m 'current-reader (make-fluid))
+
+                    ;; Default to `simple-format', as is the case until
+                    ;; (ice-9 format) is loaded.  This allows
+                    ;; compile-time warnings to be emitted when using
+                    ;; unsupported options.
+                    (module-set! m 'format simple-format)
+
+                    m)))
diff --git a/misc.scm b/misc.scm
deleted file mode 100644
index accc3ba..0000000
--- a/misc.scm
+++ /dev/null
@@ -1,99 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre misc)
-  #:use-module (ice-9 arrays)
-  #:use-module (srfi srfi-1)
-  #:export
-  (array-map
-   array-map-indexed
-   flip
-   for-indices-in-range
-   if-let
-   ifn
-   list-zeros
-   map-indexed
-   produce-array
-   produce-typed-array))
-
-(define (flip f)
-  "Returns a procedure behaving as `f', but with arguments taken in reverse
-order."
-  (lambda args
-    (apply f (reverse args))))
-
-(define-syntax if-let
-  (syntax-rules ()
-    [(_ (x test) consequent alternate)
-     (let ([x test])
-       (if x consequent alternate))]
-    [(_ (x test) consequent)
-     (let ([x test])
-       (if x consequent))]))
-
-(define-syntax ifn
-  (syntax-rules ()
-    [(_ test alternate consequent)
-     (if test consequent alternate)]
-    [(_ test alternate)
-     (if (not test) alternate)]))
-
-(define (list-zeros n)
-  (list-tabulate n (lambda _ 0)))
-
-(define (map-indexed f . lists)
-  "Like `map' but the last argument of `f' is passed the corresponding index."
-  (apply map f (append lists (list (list-tabulate (length (car lists))
-						  identity)))))
-
-(define (for-indices-in-range f starts ends)
-  (define (for-indices-in-range% f indices starts ends)
-    (if (null? starts)
-	(apply f (reverse indices))
-	(do ((i (car starts) (1+ i)))
-	    ((= i (car ends)))
-	  (for-indices-in-range%
-	   f
-           (cons i indices)
-           (cdr starts)
-           (cdr ends)))))
-  (for-indices-in-range% f '() starts ends))
-
-;;;; array utilities
-
-(define (produce-typed-array f type . dims)
-  (let ((a (apply make-typed-array type *unspecified* dims)))
-    (array-index-map! a f)
-    a))
-
-(define (produce-array f . dims)
-  (apply produce-typed-array f #t dims))
-
-(define (array-map proc array . more)
-  (let ((x (array-copy array)))
-    (apply array-map! x proc array more)
-    x))
-
-(define (array-map-indexed proc array)
-  (let ((x (array-copy array)))
-    (array-index-map!
-     x
-     (lambda indices
-       (apply proc
-	      (apply array-ref array indices)
-	      indices)))
-    x))
diff --git a/mnist.scm b/mnist.scm
deleted file mode 100644
index eabbe5e..0000000
--- a/mnist.scm
+++ /dev/null
@@ -1,95 +0,0 @@
-;;;; Copyright (C) 2023 Vouivre Digital Corporation
-;;;;
-;;;; This file is part of Vouivre.
-;;;;
-;;;; Vouivre is free software: you can redistribute it and/or
-;;;; modify it under the terms of the GNU General Public
-;;;; License as published by the Free Software Foundation, either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; Vouivre is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;;; General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public
-;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
-
-(define-module (vouivre mnist)
-  #:use-module (guix build download)
-  #:use-module (guix build utils)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (rnrs bytevectors)
-  #:use-module (srfi srfi-1)
-  #:use-module (vouivre misc)
-  #:use-module (web uri)
-  #:export (load-mnist))
-
-;; NOTE: The directory and url must not include any trailing '/' character.
-(define directory "mnist")
-(define url "http://yann.lecun.com/exdb/mnist")
-(define trn-imgs-fname "train-images-idx3-ubyte")
-(define trn-lbls-fname "train-labels-idx1-ubyte")
-
-(define (exists? fname)
-  "Return `#t' if the file with the given name exists and `#f' otherwise."
-  (catch 'system-error
-    (lambda ()
-      (with-input-from-file fname
-	(lambda () #t)
-	#:binary #t))
-    (lambda _ #f)))
-
-(define (load-mnist nb-items download?)
-  "Return the given number of data points from the MNIST dataset downloading it
-if needed and requested in the ./mnist directory.
-
-The data is a cons cell containing an array (nb-items, height, width) of
-training images and an array (nb-items) of corresponding labels."
-  (define (read-uint bytes)
-    (bytevector-uint-ref (get-bytevector-n (current-input-port)
-					   bytes)
-			 0
-			 (endianness big)
-			 bytes))  
-  (apply
-   cons
-   (map
-    (lambda (base-name magic rank)
-      (let ((fname (string-append directory "/" base-name)))
-	(let redo ((download? download?))
-	  (if (exists? fname)
-	      (with-input-from-file fname
-		(lambda ()
-		  (when (not (= magic (read-uint 4)))
-		    (error "Unsupported file magic number."))
-		  (let* ((n (min nb-items (read-uint 4)))
-			 (dims (list-tabulate rank (lambda (x) (read-uint 4))))
-			 (n-dims (apply * n dims))
-			 (a (apply make-typed-array 'u8 0 n dims))
-			 (ac (array-contents a)))
-		    (let lp ((i 0))
-		      (if (= i n-dims)
-			  a
-			  (begin
-			    (array-set! ac (read-uint 1) i)
-			    (lp (1+ i)))))))
-		#:binary #t)
-	      (ifn download?
-		   (error (string-append "The MNIST dataset doesn't exist. If you tried with `download?' to `#t' already, to no avail, you can download the files manually from " url ", and extract them to a \"mnist\" directory at the root of the project. You can also file a bug report."))
-		   (let ((gzname (string-append fname ".gz")))
-		     (invoke "mkdir" "-p" directory)
-		     (call-with-output-file gzname
-		       (lambda (port)
-			 (put-bytevector
-			  port
-			  (get-bytevector-all
-			   (http-fetch
-			    (string->uri
-			     (string-append url "/" base-name ".gz"))))))
-		       #:binary #t)
-		     (invoke "gunzip" gzname)
-		     (redo #f)))))))
-    (list trn-imgs-fname trn-lbls-fname)
-    (list 2051 2049)
-    (list 2 0))))
diff --git a/pre-inst-env.in b/pre-inst-env.in
new file mode 100644
index 0000000..31c499d
--- /dev/null
+++ b/pre-inst-env.in
@@ -0,0 +1,13 @@
+#!/bin/sh
+
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
+
+GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
+GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
+export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
+
+PATH="$abs_top_builddir/scripts:$PATH"
+export PATH
+
+exec "$@"
diff --git a/promises.scm b/promises.scm
deleted file mode 100644
index f3cd1e5..0000000
--- a/promises.scm
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms
-
-;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
-;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
-
-;; Permission is hereby granted, free of charge, to any person
-;; obtaining a copy of this software and associated documentation
-;; files (the "Software"), to deal in the Software without
-;; restriction, including without limitation the rights to use, copy,
-;; modify, merge, publish, distribute, sublicense, and/or sell copies
-;; of the Software, and to permit persons to whom the Software is
-;; furnished to do so, subject to the following conditions:
-
-;; The above copyright notice and this permission notice shall be
-;; included in all copies or substantial portions of the Software.
-
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-;; SOFTWARE.
-
-;; This file has been modified by Vouivre Digital Corporation. The exact
-;; modifications can be seen in a shell using:
-;; $ git diff b4695cd888df6511915262884d2ce317156f92e8 promises.scm
-
-;;; Commentary:
-
-;; This is the code of the reference implementation of SRFI-45, modified
-;; to use SRFI-9 and to add 'promise?' to the list of exports.
-
-;; This module is documented in the Guile Reference Manual.
-
-;;; Code:
-
-(define-module (vouivre promises)
-  #:export (*promises* reset-promises)
-  #:replace (delay force)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu))
-
-(define *promises* (make-parameter #f))
-
-(define-record-type promise (make-promise val) promise?
-  (val promise-val promise-val-set!))
-
-(define-record-type value (make-value tag proc rec) value?
-  (tag value-tag value-tag-set!)
-  (proc value-proc value-proc-set!)
-  (rec value-rec value-rec-set!))
-
-(define-syntax-rule (lazy exp)
-  (let ((proc (lambda () exp)))
-    (make-promise (make-value 'lazy proc proc))))
-
-(define (eager x)
-  (make-promise (make-value 'eager x #f)))
-
-(define-syntax-rule (delay exp)
-  (let ((promise (lazy (eager exp)))
-	(promises-ptr (*promises*)))
-    (set-car! promises-ptr (cons promise (car promises-ptr)))
-    promise))
-
-(define (force promise)
-  (let ((content (promise-val promise)))
-    (case (value-tag content)
-      ((eager)
-       (value-proc content))
-      ((lazy)
-       (let* ((promise* ((value-proc content)))
-              (content  (promise-val promise)))	   ; *
-         (unless (eqv? 'eager (value-tag content)) ; *
-           (value-tag-set! content (value-tag (promise-val promise*)))
-           (value-proc-set! content (value-proc (promise-val promise*)))
-           (promise-val-set! promise* content))
-         (force promise))))))
-;; (*) These two lines re-fetch and check the original promise in case
-;;     the first line of the let* caused it to be forced.  For an example
-;;     where this happens, see reentrancy test 3 below.
-
-(define (reset-promises promises)
-  (unless (null? promises)
-    (let ((v (promise-val (car promises))))
-      (when (value-rec v)
-	(value-proc-set! v (value-rec v))
-	(value-tag-set! v 'lazy))
-      (reset-promises (cdr promises)))))
-
-(define* (promise-visit promise #:key on-eager on-lazy)
-  (define content (promise-val promise))
-  (case (value-tag content)
-    ((eager) (on-eager (value-proc content)))
-    ((lazy)  (on-lazy (value-proc content)))))
-
-(set-record-type-printer! promise
-  (lambda (promise port)
-    (promise-visit promise
-      #:on-eager (lambda (value)
-                   (format port "#<promise = ~s>" value))
-      #:on-lazy  (lambda (proc)
-                   (format port "#<promise => ~s>" proc)))))
diff --git a/spec.scm b/spec.scm
deleted file mode 100644
index a07f7c1..0000000
--- a/spec.scm
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; Guile Scheme specification
-
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2021 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;;; This file has been modified by Vouivre Digital Corporation. The exact
-;;;; modifications can be seen in a shell using:
-;;;; $ git diff 5226e2890df9a25bd1d33514ff67539da7794905 spec.scm
-
-;;; Code:
-
-(define-module (language vouivre spec)
-  #:use-module (system base compile)
-  #:use-module (system base language)
-  #:use-module (language vouivre compile-tree-il)
-  #:use-module (language vouivre decompile-tree-il)
-  #:use-module (vouivre curry)
-  #:export (vouivre))
-
-;;;
-;;; Language definition
-;;;
-
-(define-language vouivre
-  #:title	"Vouivre"
-  #:reader      (lambda (port env)
-                  ;; Use the binding of current-reader from the environment.
-                  ;; FIXME: Handle `read-options' as well?
-                  ((or (and=> (and=> (module-variable env 'current-reader)
-                                     variable-ref)
-                              fluid-ref)
-                       read-syntax)
-                   port))
-
-  #:compilers   `((tree-il . ,compile-tree-il))
-  #:decompilers `((tree-il . ,decompile-tree-il))
-  #:evaluator	(lambda (x module) (primitive-eval x))
-  #:printer	write
-  #:make-default-environment
-                (lambda ()
-                  ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
-                  ;; `fluid-set!', etc. don't have any effect in the current environment.
-                  (let ((m (make-fresh-user-module)))
-                    ;; Provide a separate `current-reader' fluid so that
-                    ;; compile-time changes to `current-reader' are
-                    ;; limited to the current compilation unit.
-                    (module-define! m 'current-reader (make-fluid))
-
-                    ;; Default to `simple-format', as is the case until
-                    ;; (ice-9 format) is loaded.  This allows
-                    ;; compile-time warnings to be emitted when using
-                    ;; unsupported options.
-                    (module-set! m 'format simple-format)
-
-                    m)))
diff --git a/tests/autodiff.scm b/tests/autodiff.scm
new file mode 100644
index 0000000..ef638ff
--- /dev/null
+++ b/tests/autodiff.scm
@@ -0,0 +1,368 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre autodiff tests)
+  #:use-module ((vouivre autodiff) #:prefix v:)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (vouivre misc)
+  #:export
+  (apply-diff
+   a~
+   const-generator
+   differentiable-func-generator
+   lambda-const-call
+   ndiff
+   n~
+   random-array
+   random-array-shape
+   random-func1
+   random-func2
+   random-func2-rank&dims>0
+   random-input
+   random-list-element
+   random-non-empty-array
+   random-shape
+   random-shared
+   random-shared-array-rank&dims>0
+   random-shared-contractible
+   with-generators
+   ~))
+
+(define f1s (list v:abs v:cos v:exp v:identity v:sin))
+(define f2s (list v:+ v:- v:* v:max v:min))
+
+(define (with-generators% generators equal proc1 proc2 . more)
+  "Check that all procedures return the same value according to `equal' when
+evaluated on arguments produced by the generators (the number of generators
+being the number of arguments to each procedure."
+  (let ((times 100)
+	(procs (cons proc1 (cons proc2 more))))
+    (call/cc
+     (lambda (break)
+       (do ((i 0 (1+ i)))
+	   ((= i times) #t)
+	 (let ((zs (map-in-order (lambda (g) (g)) generators)))
+	   (with-exception-handler
+	       (lambda (e)
+		 (break #f zs))
+	     (lambda ()
+	       (let* ((rs (map (lambda (f) (apply f zs)) procs))
+		      (head (car rs)))
+		 (unless (every (lambda (x) (equal x head))
+				(cdr rs))
+		   (break #f zs rs))))
+	     #:unwind? #t)))))))
+
+(define-syntax-rule (with-generators (g1 g2 ...) equal expected given more ...)
+  (with-generators% (list g1 g2 ...) equal expected given more ...))
+
+(define (lambda-const-call f . consts)
+  (lambda _
+    (apply f consts)))
+
+(define* (random-array-shape
+	  #:optional (min-rank 0) (max-rank 5) (min-dim 0) (max-dim 5))
+  (list-tabulate (+ min-rank (random (- max-rank min-rank)))
+		 (lambda _ (+ min-dim (random (- max-dim min-dim))))))
+
+(define (random-shape)
+  (if (= 0 (random 2))
+      0
+      (random-array-shape)))
+
+(define* (random-array #:optional shape)
+  (apply produce-typed-array
+	 (lambda _ (random:uniform))
+	 v:*atype* (or shape (random-array-shape))))
+
+(define (random-non-empty-array)
+  "Random array of at least one element."
+  (random-array (random-array-shape 0 5 1 5)))
+
+(define* (random-input #:optional shape)
+  (let ((shape (or shape (random-shape))))
+    (if (eq? 0 shape)
+	(random:uniform)
+	(random-array shape))))
+
+(define (random-shared)
+  (let ((shape (random-shape)))
+    (values
+     (lambda ()
+       (random-input shape))
+     (lambda ()
+       (let ((x (random-input
+		 (random-list-element
+		  (list 0 (if (list? shape)
+			      shape
+			      (random-shape)))))))
+	 (set! shape (random-shape))
+	 x)))))
+
+(define (random-shared-array-rank&dims>0)
+  (let ((shape (random-array-shape 1 5 1 5)))
+    (values
+     (lambda ()
+       (random-array shape))
+     (lambda ()
+       (let ((x (random-array shape)))
+	 (set! shape (random-array-shape 1 5 1 5))
+	 x)))))
+
+(define (random-list-element lst)
+  (list-ref lst (random (length lst))))
+
+(define (const-generator generator)
+  (lambda ()
+    generator))
+
+(define (differentiable-func-generator lst . input-generators)
+  (lambda ()
+    (random-list-element
+     (cons
+      (apply
+       lambda-const-call
+       (random-list-element lst)
+       (map (lambda (g) (g))
+	    input-generators))
+      lst))))
+
+(define random-func1
+  (differentiable-func-generator f1s random-input))
+(define random-func2
+  (receive (gx gy) (random-shared)
+    (differentiable-func-generator f2s gx gy)))
+
+(define* (n~ x y #:optional (error 1e-4))
+  (and
+   (>= y (- x error))
+   (<= y (+ x error))))
+
+(define* (a~ x y #:optional (error 1e-4))
+  (and
+   (equal? (array-dimensions x)
+	   (array-dimensions y))
+   (call/cc
+    (lambda (break)
+      (array-for-each
+       (lambda (x y)
+	 (unless (~ x y error)
+	   (break #f)))
+       x y)
+      #t))))
+
+(define* (~ x y #:optional (error 1e-4))
+  (cond
+   ((and (number? x) (number? y))
+    (n~ x y error))
+   ((and (array? x) (array? y))
+    (a~ x y error))
+   (else #f)))
+
+(define* (ndiff f #:optional (axis 0) (step 1e-6))
+  "Differentiation using a numerical centered difference approximation."
+  (define (axis-add xs dh . indices)
+    "Add `dh' to the number or array at the given `axis' of `xs',
+and, when it's an array, at the given index."
+    (map-indexed
+     (lambda (x i)
+       (ifn (= i axis)
+	    x
+	    (if (number? x)
+		(+ x dh)
+		(array-map-indexed
+		 (lambda (x . indices_)
+		   (ifn (equal? indices indices_)
+			x
+			(+ x dh)))
+		 x))))
+     xs))
+  (lambda xs
+    ;; We need the output shape and the input shape along the
+    ;; differentiated axis.
+    (let ((fxs (apply f xs))
+	  (x (list-ref xs axis)))
+      (cond
+       ((and (number? fxs)
+	     (number? x))
+	(/ (- (apply f (axis-add xs step))
+	      (apply f (axis-add xs (- step))))
+	   (* 2 step)))
+       ((and (number? fxs)
+	     (array? x))
+	(apply
+	 produce-typed-array
+	 (lambda indices
+	   (/ (- (apply f (apply axis-add xs step indices))
+		 (apply f (apply axis-add xs (- step) indices)))
+	      (* 2 step)))
+	 v:*atype*
+	 (array-dimensions x)))
+       ((and (array? fxs)
+	     (number? x))
+	((v:extend /)
+	 ((v:extend -)
+	  (apply f (axis-add xs step))
+	  (apply f (axis-add xs (- step))))
+	 (* 2 step)))
+       ((and (array? fxs)
+	     (array? x))
+	(let ((a (apply
+		  make-typed-array v:*atype* *unspecified*
+		  (append (array-dimensions fxs)
+			  (array-dimensions x)))))
+	  (for-indices-in-range
+	   (lambda indices-in
+	     (let ((dfxs ((v:extend /)
+			  ((v:extend -)
+			   (apply f (apply axis-add xs step indices-in))
+			   (apply f (apply axis-add xs (- step) indices-in)))
+			  (* 2 step))))
+	       (for-indices-in-range
+		(lambda indices-out
+		  (apply
+		   array-set!
+		   a
+		   (apply array-ref dfxs indices-out)
+		   (append indices-out indices-in)))
+		(list-zeros (array-rank fxs))
+		(array-dimensions fxs))))
+	   (list-zeros (array-rank x))
+	   (array-dimensions x))
+	  a))))))
+
+(define* (apply-diff differentiator #:optional (axis 0))
+  "Apply a differentiator (`ndiff', `fdiff', `rdiff') to a function and its
+arguments (this is a convenience function)."
+  (lambda (f . args)
+    (apply (differentiator f axis) args)))
+
+(test-begin "autodiff")
+
+;; not differentiating
+(test-assert (with-generators (random-input) ~ (v:extend identity) v:identity))
+(test-assert (with-generators (random-input) ~ (v:extend exp) v:exp))
+(test-assert
+    (receive (gx gy) (random-shared)
+      (with-generators (gx gy) ~ (v:extend *) v:*)))
+
+;; differentiation in one variable
+(test-assert
+    (with-generators
+     (random-func1 random-input)
+     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
+
+;; `v:mean' only takes non-empty arrays so we treat it separately
+(test-assert
+    (with-generators
+     ((differentiable-func-generator (list v:mean) random-non-empty-array)
+      random-non-empty-array)
+     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
+
+;; differentiation in two variables
+(test-assert
+    (receive (gx gy) (random-shared)
+      (with-generators
+       (random-func2 gx gy)
+       ~ (apply-diff ndiff 0) (apply-diff v:fdiff 0) (apply-diff v:rdiff 0))))
+(test-assert
+    (receive (gx gy) (random-shared)
+      (with-generators
+       (random-func2 gx gy)
+       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
+
+;; `v:amap2' only takes arrays of rank > 0 and batch-size > 0 so we treat it
+;; separately
+(define random-func2-rank&dims>0
+  (receive (gx gy) (random-shared-array-rank&dims>0)
+    (differentiable-func-generator f2s gx gy)))
+(test-assert
+    (receive (gx gy) (random-shared-array-rank&dims>0)
+      (with-generators
+       ((const-generator v:amap2) random-func2-rank&dims>0 gx gy)
+       ;; NOTE: for `v:amap2' the differentiable axes are 1 and 2.
+       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
+(test-assert
+    (receive (gx gy) (random-shared-array-rank&dims>0)
+      (with-generators
+       ((const-generator v:amap2) random-func2-rank&dims>0 gx gy)
+       ~ (apply-diff ndiff 2) (apply-diff v:fdiff 2) (apply-diff v:rdiff 2))))
+(let* ((z #(1 2 3))
+       (f (lambda (a)
+	    (v:amap2 (lambda (x y)
+		       (v:* a a))
+		     #(10 20 30)
+		     #(40 50 60))))
+       (e ((ndiff f) z)))
+  (test-assert (~ e ((v:fdiff f) z)))
+  (test-assert (~ e ((v:rdiff f) z))))
+
+;; `v:adot'
+(define (random-shared-contractible)
+  "Returns three generators: the first two generate arrays that are contractible
+according to the number generated by the third one."
+  (let* ((n (random 5))
+	 (sa (random-array-shape n))
+	 (sb (append (reverse (take (reverse sa)
+				    n))
+		     (random-array-shape 0 (- 5 n)))))
+    (values
+     (lambda ()
+       (random-array sa))
+     (lambda ()
+       (random-array sb))
+     (lambda ()
+       (let ((tmp n))
+	 (set! n (random 5))
+	 (set! sa (random-array-shape n))
+	 (set! sb (append (reverse (take (reverse sa)
+					 n))
+			  (random-array-shape 0 (- 5 n))))
+	 tmp)))))
+(test-assert
+    (receive (gx gy gz) (random-shared-contractible)
+      (with-generators
+       ((const-generator v:adot) gx gy gz)
+       ~ (apply-diff ndiff 0) (apply-diff v:fdiff 0) (apply-diff v:rdiff 0))))
+(test-assert
+    (receive (gx gy gz) (random-shared-contractible)
+      (with-generators
+       ((const-generator v:adot) gx gy gz)
+       ~ (apply-diff ndiff 1) (apply-diff v:fdiff 1) (apply-diff v:rdiff 1))))
+
+;; let binding re-entry
+(test-assert
+    (with-generators
+     ((const-generator
+       (lambda (x)
+	 (let ((c (v:maximum x)))
+	   (v:+ c (v:- x c)))))
+      random-non-empty-array)
+     ~ (apply-diff ndiff) (apply-diff v:fdiff) (apply-diff v:rdiff)))
+
+;; chain rule
+(test-assert
+    (with-generators
+     (random-func1 random-func1 random-input)
+     ~
+     (lambda (f g x) ((ndiff (compose f g)) x))
+     (lambda (f g x) ((v:fdiff (compose f g)) x))
+     (lambda (f g x) ((v:rdiff (compose f g)) x))))
+
+(test-end "autodiff")
diff --git a/tests/curry.scm b/tests/curry.scm
new file mode 100644
index 0000000..46c1cb9
--- /dev/null
+++ b/tests/curry.scm
@@ -0,0 +1,116 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre curry tests)
+  #:use-module (vouivre curry)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71))
+
+(test-begin "curry")
+;; TODO: map the reduxtab to a bare version for unit-testing
+;; (test-assert
+;;     (lset=
+;;      'equal?
+;;      '((1 . (2 . 4)) (2 . 2) (3 . 2))
+;;      (compare
+;;       (parse '(1       . (2 . 3)))
+;;       (parse '((1 . 2) . (1 . 1))))))
+
+(define-syntax-rule (test-type given expected-bare)
+  (test-assert (equal-types? given (parse expected-bare))))
+
+(define (sym-sets symtab alist)
+  (fold (lambda (x prev)
+	  ((@@ (vouivre curry) sym-set) prev (car x) (cdr x)))
+	symtab alist))
+
+(let ((t e (expand '() '(λc x x))))
+  (test-type t '(1 . 1))
+  (test-equal '(lambda (x) x) e))
+(let ((t e (expand '() '(λc g (λc f (λc x (g (f x))))))))
+  (test-type t '((3 . 4) . ((2 . 3) . (2 . 4))))
+  (test-equal '(lambda (g) (lambda (f) (lambda (x) (g (f x))))) e))
+(let ((t e (expand '() '((λc x x) #t))))
+  (test-type t 0)
+  (test-equal #t (primitive-eval e)))
+(let ((bindings
+       (sym-sets
+	'()
+	`((id  . ,(parse '(1 . 1)))
+	  (∘   . ,(parse '((2 . 3) . ((1 . 2) . (1 . 3)))))
+	  (⊙   . ,(parse '((1 . 2) . ((2 . 3) . (1 . 3)))))
+	  (map . ,(parse '((0 . 0) . (0 . 0))))
+	  (+   . ,(parse '(0 . (0 . 0))))))))
+  (let ((t e (expand bindings '(∘ id id))))
+    (test-type t '(7 . 7))
+    (test-equal e '((∘ id) id)))
+  (let ((t e (expand bindings '((∘ id id) #t))))
+    (test-type t 0)
+    (test-equal e '(((∘ id) id) #t)))
+  (let ((t e (expand bindings '(∘ id id #t))))
+    (test-type t 0)
+    (test-equal e '(((∘ id) id) #t)))
+  (let ((t e (expand bindings '(λc f (∘ f)))))
+    (test-type t '((2 . 3) . ((1 . 2) . (1 . 3)))))
+  (let ((t e (expand bindings '(map (+ 1) '(1 2 3)))))
+    (test-type t 0)
+    (test-equal e '((map (+ 1)) '(1 2 3))))
+  (let ((t e (expand bindings '(∘ +))))
+    (test-type t '((1 . 0) . (1 . (0 . 0))))
+    (test-equal e '(∘ +)))
+  (let ((t e (expand bindings '((∘ +) (+ 1) 2 3))))
+    (test-type t 0)
+    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
+  (let ((t e (expand bindings '((∘ + (+ 1)) 2 3))))
+    (test-type t 0)
+    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
+  (let ((t e (expand bindings '(((∘ + (+ 1)) 2) 3))))
+    (test-type t 0)
+    (test-equal e '((((∘ +) (+ 1)) 2) 3)))
+  (let ((t e (expand bindings '((∘ (∘ (+ 1)) +) 2 3))))
+    (test-type t 0)
+    (test-equal e '((((∘ (∘ (+ 1))) +) 2) 3)))
+  (let ((t e (expand bindings '((∘ (⊙ (+ 1)) +) 2 3))))
+    (test-type t 0)
+    (test-equal e '((((∘ (⊙ (+ 1))) +) 2) 3))))
+
+;;; interaction between typed and untyped (regular) scheme
+
+;; Untyped scheme produces untyped return.
+(let ((t e (expand '() '(+ 1 2 3))))
+  (test-type t #f)
+  (test-equal e '(+ 1 2 3)))
+
+(let ((bindings
+       (sym-sets
+	'()
+	`((* . ,(parse '(0 . (0 . 0))))))))
+  ;; Typed Scheme can be used by untyped Scheme...
+  (let ((t e (expand bindings '(+ 1 (* 2 3) 4))))
+    (test-type t #f)
+    (test-equal e '(+ 1 ((* 2) 3) 4)))
+
+  ;; ... although, sometimes, with terrible runtime consequences!
+  (let ((t e (expand bindings '(+ 1 (* 2) 3))))
+    (test-type t #f)
+    (test-equal e '(+ 1 (* 2) 3)))
+
+  ;; On the other hand, typed Scheme expects typed Scheme.
+  (test-error (expand bindings '(* 1 (+ 2 3)))))
+
+(test-end "curry")
diff --git a/vouivre.scm b/vouivre.scm
new file mode 100644
index 0000000..e69de29
diff --git a/vouivre/autodiff.scm b/vouivre/autodiff.scm
new file mode 100644
index 0000000..d243107
--- /dev/null
+++ b/vouivre/autodiff.scm
@@ -0,0 +1,876 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre autodiff)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (vouivre misc)
+  #:use-module (vouivre promises)
+  #:export
+  (*atype*
+   adot
+   amap2
+   contract-arrays
+   differentiable-wrapper
+   dot
+   do-times
+   ewise1
+   ewise2
+   extend
+   fdiff
+   rdiff
+   make-batch
+   make-internal
+   maximum
+   mean
+   rank-of
+   sum)
+  #:replace
+  ((i:sqrt . sqrt)
+   (i:exp . exp)
+   (i:expt . expt)
+   (i:log . log)
+   (i:sin . sin)
+   (i:cos . cos)
+   (i:tan . tan)
+   (i:+ . +)
+   (i:- . -)
+   (i:* . *)
+   (i:/ . /)
+   (i:max . max)
+   (i:min . min)
+   (i:abs . abs)
+   (i:identity . identity)
+   (i:array-ref . array-ref)
+   (i:array-cell-ref . array-cell-ref))
+  #:re-export
+  (fold
+   reduce))
+
+;;;; array utilities
+
+(define (rel->abs indices dimensions)
+  (let rec ((s 0)
+	    (p 1)
+	    (is (reverse indices))
+	    (ds (reverse dimensions)))
+    (if (null? is)
+	s
+	(rec (+ s (* p (car is)))
+	     (* p (car ds))
+	     (cdr is)
+	     (cdr ds)))))
+
+(define(do-times n proc)
+  (let rec ((i 0))
+    (unless (= i n)
+      (proc i)
+      (rec (1+ i)))))
+
+(define (contract-arrays a b n)
+  (let* ((dims-a (array-dimensions a))
+	 (dims-b (array-dimensions b))
+	 (free-dims-a (take dims-a (- (array-rank a) n)))
+	 (free-dims-b (drop dims-b n))
+	 (bound-dims (take dims-b n))
+	 (n-free-dims-a (apply * free-dims-a))
+	 (n-free-dims-b (apply * free-dims-b))
+	 (n-bound-dims (apply * bound-dims))
+	 (s 0)
+	 (r (apply make-typed-array *atype* *unspecified* (append free-dims-a
+								  free-dims-b)))
+	 (ac (array-contents a))
+	 (bc (array-contents b))
+	 (rc (array-contents r)))
+    (do-times
+     n-free-dims-a
+     (lambda (i)
+       (let ((i-k (* n-bound-dims i))
+	     (i-j (* n-free-dims-b i)))
+	 (do-times
+	  n-free-dims-b
+	  (lambda (j)
+	    (set! s 0)
+	    (do-times
+	     n-bound-dims
+	     (lambda (k)
+	       (set! s (+ s (* (array-ref ac (+ i-k k))
+			       (array-ref bc (+ (* n-free-dims-b k) j)))))))
+	    (array-set! rc s (+ i-j j)))))))
+    r))
+
+;;;; utilities that work on both numbers and arrays
+
+(define (extend f)
+  "Extend a function of one or more scalars to apply to numbers/arrays
+element-wise. All arrays must have the same dimension."
+  (define (apply-elemwise f indices args)
+    (apply f (map (lambda (x)
+		    (if (number? x)
+			x
+			(apply array-ref x indices)))
+		  args)))
+  (lambda xs
+    (if-let (x (find array? xs))
+	    (apply
+	     produce-typed-array
+	     (lambda is
+	       (apply-elemwise f is xs))
+	     *atype*
+	     (array-dimensions x))
+	    (apply f xs))))
+
+(define (dot x y n)
+  (cond
+   ((and (number? x) (number? y))
+    (* x y))
+   ((and (array? x) (array? y))
+    (contract-arrays x y n))
+   ((and (array? x) (number? y))
+    ((extend *) x y))
+   ((and (number? x) (array? y))
+    ((extend *) x y))
+   (else (error "can't dot because of invalid types or ranks" x y n))))
+
+(define (rank-of x)
+  (if (number? x)
+      0
+      (array-rank x)))
+
+;;;; differentiation
+
+(define-record-type internal
+  (make-internal forward jacobian)
+  internal?
+  (forward internal-forward)
+  (jacobian internal-jacobian))
+
+;;(define *atype* 'f32)
+(define *atype* #t)
+(define *differentiation-mode* (make-parameter #f))
+(define *n-y-dims* (make-parameter #f))
+(define *j* (make-parameter #f))
+
+(define-syntax-rule (w/j val body ...)
+  (parameterize ((*j* val))
+    body ...))
+
+(define (wrap axis)
+  (lambda (x i)
+    (if (= i axis)
+	(make-internal x 'input)
+	x)))
+
+(define (unwrap-fwd x)
+  (if (internal? x)
+      (internal-forward x)
+      x))
+
+(define (unwrap-jac x)
+  (if (internal? x)
+      (internal-jacobian x)
+      x))
+
+(define (dims-of x)
+  (if (number? x)
+      '()
+      (array-dimensions x)))
+
+(define (add dst-buf src-buf n-dims)
+  (do-times
+   n-dims
+   (lambda (i)
+     (array-set!
+      dst-buf
+      (+ (array-ref dst-buf i)
+	 (array-ref src-buf i))
+      i)))
+  dst-buf)
+
+(define (movg dst-buf n-dst-dims generator naked-inputs data j)
+  (do-times
+   n-dst-dims
+   (lambda (i)
+     (array-set!
+      dst-buf
+      (apply generator naked-inputs i j data)
+      i)))
+  dst-buf)
+
+(define (addg dst-buf n-dst-dims generator naked-inputs data j)
+  (do-times
+   n-dst-dims
+   (lambda (i)
+     (array-set!
+      dst-buf
+      (+ (array-ref dst-buf i)
+	 (apply generator naked-inputs i j data))
+      i)))
+  dst-buf)
+
+(define (movc dst-buf n-dst-dims src-buf n-src-dims
+	      generator naked-inputs data)
+  "Contract the Jacobian column produced by the generator with the source buffer
+storing the result in the destination buffer."
+  (let ((s 0))
+    (do-times
+     n-dst-dims
+     (lambda (i)
+       (set! s 0)
+       (do-times
+	n-src-dims
+	(lambda (k)
+	  (set! s (+ s (* (apply generator naked-inputs i k data)
+			  (array-ref src-buf k))))))
+       (array-set! dst-buf s i))))
+  dst-buf)
+
+(define (addc dst-buf n-dst-dims src-buf n-src-dims
+	      generator naked-inputs data)
+  "Contract the Jacobian column produced by the generator with the source buffer
+adding the result to the destination buffer."
+  (let ((s 0))
+    (do-times
+     n-dst-dims
+     (lambda (i)
+       (set! s (array-ref dst-buf i))
+       (do-times
+	n-src-dims
+	(lambda (k)
+	  (set! s (+ s (* (apply generator naked-inputs i k data)
+			  (array-ref src-buf k))))))
+       (array-set! dst-buf s i))))
+  dst-buf)
+
+(define (transpose-generator generator)
+  (lambda (xs i j . data)
+    (apply generator xs j i data)))
+
+(define* (fdiff f #:optional (axis 0))
+  (lambda xs
+    (parameterize (((@@ (vouivre autodiff) *differentiation-mode*) 'fwd)
+		   ((@@ (vouivre autodiff) *promises*) (cons '() #f)))
+      (let* ((internal (apply f (map-indexed (wrap axis) xs)))
+	     (fx (internal-forward internal))
+	     (y (list-ref xs axis))  ; variable to differentiate w.r.t
+	     (pre-Jx (internal-jacobian internal))
+	     (Jx (cond
+		  ;; TODO: implement 'input case and test 'zero and 'input
+		  ((eq? pre-Jx 'zero)
+		   (lambda (j)
+		     (lambda (i)
+		       0)))
+		  ((eq? pre-Jx 'input)
+		   (error "TBD."))
+		  (else
+		   (lambda (j)
+		     (reset-promises (car (*promises*)))
+		     (let ((column-jac (w/j j (force pre-Jx))))
+		       (lambda (i)
+			 (array-ref column-jac i))))))))
+	(cond
+	 ((and (number? fx) (number? y))
+	  ((Jx 0) 0))
+	 ((and (number? fx) (array? y))
+	  (let* ((y-dims (array-dimensions y))
+		 (a (apply make-array *unspecified* y-dims))
+		 (ac (array-contents a)))
+	    (do-times
+	     (apply * y-dims)
+	     (lambda (j)
+	       (array-set! ac ((Jx j) 0)
+			   j)))
+	    a))
+	 ((and (array? fx) (number? y))
+	  (let* ((fx-dims (array-dimensions fx))
+		 (a (apply make-array *unspecified* fx-dims))
+		 (ac (array-contents a))
+		 (Jx (Jx 0)))
+	    (do-times
+	     (apply * fx-dims)
+	     (lambda (i)
+	       (array-set! ac (Jx i)
+			   i)))
+	    a))
+	 (else
+	  (let* ((fx-dims (array-dimensions fx))
+		 (y-dims (array-dimensions y))
+		 (n-fx-dims (apply * fx-dims))
+		 (n-y-dims (apply * y-dims))
+		 (a (apply make-array *unspecified* (append fx-dims y-dims)))
+		 (ac (array-contents a)))
+	    (do-times
+	     n-y-dims
+	     (lambda (j)
+	       (let ((Jx (Jx j)))
+		 (do-times
+		  n-fx-dims
+		  (lambda (i)
+		    (array-set! ac (Jx i)
+				(+ j (* n-y-dims i))))))))
+	    a)))))))
+
+(define* (rdiff f #:optional (axis 0))
+  (lambda xs
+    (parameterize (((@@ (vouivre autodiff) *differentiation-mode*) 'rev)
+		   ((@@ (vouivre autodiff) *promises*) (cons '() #f)))
+      (let* ((internal (apply f (map-indexed (wrap axis) xs)))
+	     (fx (internal-forward internal))
+	     (y (list-ref xs axis))  ; variable to differentiate w.r.t
+	     (y-dims (dims-of y))
+	     (pre-Jx (internal-jacobian internal))
+	     (Jx (cond
+		  ;; TODO: implement 'input case and test 'zero and 'input
+		  ((eq? pre-Jx 'zero)
+		   (lambda (i)
+		     (lambda (j)
+		       0)))
+		  ((eq? pre-Jx 'input)
+		   (error "TBD."))
+		  (else
+		   (let ((pre-Jx (pre-Jx #f)))
+		     (lambda (i)
+		       (let ((row-jac (pre-Jx i)))
+			 (lambda (j)
+			   (array-ref row-jac j)))))))))
+	(parameterize ((*n-y-dims* (apply * y-dims)))
+	  (cond
+	   ((and (number? fx) (number? y))
+	    ((Jx 0) 0))
+	   ((and (number? fx) (array? y))
+	    (let* ((a (apply make-array *unspecified* y-dims))
+		   (ac (array-contents a))
+		   (Jx (Jx 0)))
+	      (do-times
+	       (*n-y-dims*)
+	       (lambda (j)
+		 (array-set! ac (Jx j)
+			     j)))
+	      a))
+	   ((and (array? fx) (number? y))
+	    (let* ((fx-dims (array-dimensions fx))
+		   (a (apply make-array *unspecified* fx-dims))
+		   (ac (array-contents a)))
+	      (do-times
+	       (apply * fx-dims)
+	       (lambda (i)
+		 (array-set! ac ((Jx i) 0)
+			     i)))
+	      a))
+	   (else
+	    (let* ((fx-dims (array-dimensions fx))
+		   (n-fx-dims (apply * fx-dims))
+		   (a (apply make-array *unspecified* (append fx-dims y-dims)))
+		   (ac (array-contents a)))
+	      (do-times
+	       n-fx-dims
+	       (lambda (i)
+		 (let ((Jx (Jx i)))
+		   (do-times
+		    (*n-y-dims*)
+		    (lambda (j)
+		      (array-set! ac (Jx j)
+				  (+ j (* (*n-y-dims*) i))))))))
+	      a))))))))
+
+;; In the comment that follows:
+;;
+;; `n' is the number of arguments to `proc'.
+;; `generators is not a `Vec' but a `List' we only use the former to illustrate
+;; its length.
+;; `X1', ..., `Xn' are the types of inputs and thus `Array's of some dimension.
+;; `I' is the type of multi-indices indexing the output of `function'.
+;; `J' is the type of multi-indices indexing the input array being differentiated.
+;; `|I|' (resp. `|J|') is the type of absolute indices of `I' (resp. `J').
+;; `Array I' is the type of arrays indexed by multi-indices of `I'.
+;; `[X]' means that `X' is boxed in an internal as when returned by
+;;       `differentiable-wrapper' with the array being `X' and the promise that
+;;       given a |J| we will get the change of `X' with a change of the
+;;       the differentiated argument at multi-index `J'.
+;; (∷ (→ (Vec n (→ X1 ... Xn |I| |J| Number))
+;;       (→ X1 ... Xn (Array I))*
+;;       [X1] ... [Xn]
+;;       (Internal (Array I) (Promise |J| (Array |I|)))))
+;;
+;; (*) We extend this definition to allow `proc' to be a list of procedures
+;;     the head of which is as described above and the remaining elements
+;;     are procedures of the same arguments but returning values that are
+;;     then fed as extra data to the generators.
+;;
+;; NOTE: In cases where an argument isn't meant to be differentiable its
+;;       corresponding generator should be `#f'.
+(define (differentiable-wrapper generators proc* arg . more)
+  (define (precompute-data naked-args)
+    (if (procedure? proc*)
+	'()
+	(map (lambda (g)
+	       (apply g naked-args))
+	     (cdr proc*))))
+  (let* ((args (cons arg more))
+	 (proc (if (procedure? proc*)
+		   proc*
+		   (car proc*)))
+	 (naked-args (map unwrap-fwd args))
+	 (out (apply proc naked-args)))
+    (case (*differentiation-mode*)
+      ((#f)
+       out)
+      ((fwd)
+       (let* ((data (precompute-data naked-args))
+	      (n-out-dims (apply * (dims-of out)))
+	      (buf (make-array *unspecified* n-out-dims)))
+	 (make-internal
+	  out
+	  (fold
+	   (lambda (generator arg prev)
+	     (if (or (not (internal? arg))
+		     (eq? 'zero (internal-jacobian arg)))
+		 prev
+		 (let ((Jx (internal-jacobian arg))
+		       (n-fwd-dims (apply * (dims-of (unwrap-fwd arg)))))
+		   (if (eq? Jx 'input)
+		       (if (eq? prev 'zero)
+			   (delay
+			     (movg buf n-out-dims
+				   generator naked-args data (*j*)))
+			   (delay
+			     (addg (force prev) n-out-dims
+				   generator naked-args data (*j*))))
+		       (if (eq? prev 'zero)
+			   (delay
+			     (movc buf n-out-dims (force Jx) n-fwd-dims
+				   generator naked-args data))
+			   (delay
+			     (addc (force prev) n-out-dims
+				   (force Jx) n-fwd-dims
+				   generator naked-args data)))))))
+	   'zero generators args))))
+      ((rev)
+       (let ((data (precompute-data naked-args))
+	     (n-out-dims (apply * (dims-of out))))
+	 (make-internal
+	  out
+	  (fold
+	   (lambda (generator arg prev)
+	     (let ((generator (transpose-generator generator)))
+	       (if (or (not (internal? arg))
+		       (eq? 'zero (internal-jacobian arg)))
+		   prev
+		   (let* ((Jx (internal-jacobian arg))
+			  (n-fwd-dims (apply * (dims-of (unwrap-fwd arg)))))
+		     (if (eq? Jx 'input)
+			 (if (eq? prev 'zero)
+			     (lambda (buf?)
+			       (let ((dst-buf (make-array *unspecified*
+							  n-fwd-dims)))
+				 (if buf?
+				     (lambda (buf)
+				       (movc dst-buf n-fwd-dims
+					     buf n-out-dims
+					     generator naked-args data))
+				     (lambda (i)
+				       (movg dst-buf n-fwd-dims
+					     generator naked-args data
+					     i)))))
+			     (lambda (buf?)
+			       (let ((prev (prev buf?)))
+				 (if buf?
+				     (lambda (buf)
+				       (addc (prev buf) n-fwd-dims
+					     buf n-out-dims
+					     generator naked-args data))
+				     (lambda (i)
+				       (addg (prev i) n-fwd-dims
+					     generator naked-args data
+					     i))))))
+			 (if (eq? prev 'zero)
+			     (lambda (buf?)
+			       (let ((Jx (Jx #t))
+				     (dst-buf (make-array *unspecified*
+							  n-fwd-dims)))
+				 (if buf?
+				     (lambda (buf)
+				       (Jx
+					(movc dst-buf n-fwd-dims buf
+					      n-out-dims
+					      generator naked-args data)))
+				     (lambda (i)
+				       (Jx
+					(movg dst-buf n-fwd-dims
+					      generator naked-args data
+					      i))))))
+			     (lambda (buf?)
+			       (let ((prev (prev buf?))
+				     (Jx (Jx #t))
+				     (dst-buf (make-array *unspecified*
+							  n-fwd-dims)))
+				 (if buf?
+				     (lambda (buf)
+				       (add (prev buf)
+					    (Jx
+					     (movc dst-buf n-fwd-dims
+						   buf n-out-dims
+						   generator naked-args data))
+					    (*n-y-dims*)))
+				     (lambda (i)
+				       (add (prev i)
+					    (Jx
+					     (movg dst-buf n-fwd-dims
+						   generator naked-args data
+						   i))
+					    (*n-y-dims*))))))))))))
+	   'zero generators args)))))))
+
+(define (ewise1 f)
+  (lambda (xs i j)
+    (let ((x (car xs)))
+      (if (number? x)
+	  (f x)
+	  (ifn (= i j)
+	       0
+	       (f (array-ref (array-contents x)
+			     j)))))))
+
+(define (ewise2 proc axis)
+  (lambda (xs i j)
+    (let ((x (car xs))
+	  (y (cadr xs)))
+      (cond
+       ((and (number? x) (number? y))
+	(proc x y))
+       ((and (number? x) (array? y))
+	(if (= axis 0)
+	    (proc x (array-ref (array-contents y)
+			       i))
+	    (ifn (= i j)
+		 0
+		 (proc x (array-ref (array-contents y)
+				    j)))))
+       ((and (array? x) (number? y))
+	(if (= axis 1)
+	    (proc (array-ref (array-contents x)
+			     i)
+		  y)
+	    (ifn (= i j)
+		 0
+		 (proc (array-ref (array-contents x)
+				  j)
+		       y))))
+       (else
+	(ifn (= i j)
+	     0
+	     (proc (array-ref (array-contents x)
+			      j)
+		   (array-ref (array-contents y)
+			      j))))))))
+
+(define (i:identity x)
+  "Differentiable identity."
+  (differentiable-wrapper
+   (list (ewise1 (lambda _ 1)))
+   identity
+   x))
+
+(define (i:sqrt x)
+  "Differentiable square root."
+  (differentiable-wrapper
+   (list (ewise1 (lambda (x) (/ 1 2 (sqrt x)))))
+   (extend sqrt)
+   x))
+
+(define (i:exp x)
+  "Differentiable exponential."
+  (differentiable-wrapper
+   (list (ewise1 exp))
+   (extend exp)
+   x))
+
+(define (i:expt x y)
+  "Differentiable power."
+  (differentiable-wrapper
+   (list (ewise2 (lambda (x y) (* y (expt x (1- y)))) 0)
+	 (ewise2 (lambda (x y) (* (expt x y) (log x))) 1))
+   (extend expt)
+   x y))
+
+(define (i:log x)
+  "Differentiable logarithm."
+  (differentiable-wrapper
+   (list (ewise1 (lambda (x) (/ x))))
+   (extend log)
+   x))
+
+(define (i:sin x)
+  "Differentiable sine."
+  (differentiable-wrapper
+   (list (ewise1 cos))
+   (extend sin)
+   x))
+
+(define (i:cos x)
+  "Differentiable cosine."
+  (differentiable-wrapper
+   (list (ewise1 (lambda (x) (- (sin x)))))
+   (extend cos)
+   x))
+
+(define (i:tan x)
+  "Differentiable tangent."
+  (differentiable-wrapper
+   (list (ewise1 (lambda (x) (/ (expt (cos x) 2)))))
+   (extend tan)
+   x))
+
+(define (i:+ x y)
+  "Differentiable element-wise addition."
+  (differentiable-wrapper
+   (list
+    (ewise2 (lambda _ +1) 0)
+    (ewise2 (lambda _ +1) 1))
+   (extend +)
+   x y))
+
+(define (i:- x y)
+  "Differentiable element-wise subtraction."
+  (differentiable-wrapper
+   (list
+    (ewise2 (lambda _ +1) 0)
+    (ewise2 (lambda _ -1) 1))
+   (extend -)
+   x y))
+
+(define (i:* x y)
+  "Differentiable element-wise multiplication."
+  (differentiable-wrapper
+   (list
+    (ewise2 (lambda (x y) y) 0)
+    (ewise2 (lambda (x y) x) 1))
+   (extend *)
+   x y))
+
+(define (i:/ x y)
+  "Differentiable element-wise division."
+  (differentiable-wrapper
+   (list
+    (ewise2 (lambda (x y) (/ y)) 0)
+    (ewise2 (lambda (x y) (- (/ x y y))) 1))
+   (extend /)
+   x y))
+
+(define (i:max x y)
+  "Differentiable element-wise maximum."
+  (define (dmax x y)
+    (cond
+     ((> x y)
+      1)
+     ((= x y)
+      1/2)
+     (else
+      0)))
+  (differentiable-wrapper
+   (list
+    (ewise2 dmax 0)
+    (ewise2 (flip dmax) 1))
+   (extend max)
+   x y))
+
+(define (i:min x y)
+  "Differentiable element-wise minimum."
+  (define (dmin x y)
+    (cond
+     ((< x y)
+      1)
+     ((= x y)
+      1/2)
+     (else
+      0)))
+  (differentiable-wrapper
+   (list
+    (ewise2 dmin 0)
+    (ewise2 (flip dmin) 1))
+   (extend min)
+   x y))
+
+(define (i:abs x)
+  "Differentiable absolute."
+  (differentiable-wrapper
+   (list (ewise1 (lambda (x)
+		   (cond ((> x 0)
+			  +1)
+			 ((= x 0)
+			  1/2)
+			 ((< x 0)
+			  -1)))))
+   (extend abs)
+   x))
+
+(define (mean x)
+  "Differentiable mean on arrays."
+  (differentiable-wrapper
+   (list
+    (lambda (xs i j one-over-n)
+      one-over-n))
+   (let ((n 0))
+     (list
+      (lambda (x)
+	(let ((sum 0))
+	  (array-for-each
+	   (lambda (x)
+	     (set! sum (+ sum x))
+	     (set! n (1+ n)))
+	   x)
+	  (/ sum n)))
+      (lambda _ (/ n))))
+   x))
+
+(define (i:array-ref x . indices)
+  "Differentiable array-ref w.r.t `x'."
+  (apply
+   differentiable-wrapper
+   (cons
+    (lambda (xs i j abs-index)
+      (if (= j abs-index)
+	  1
+	  0))
+    (map not indices))
+   (list
+    array-ref
+    (lambda (x . indices)
+      (rel->abs indices (array-dimensions x))))
+   x indices))
+
+(define (i:array-cell-ref x . indices)
+  (apply
+   differentiable-wrapper
+   (cons
+    (lambda (xs i j abs-index n-rst-dims)
+      (receive (j-ref j-rst) (euclidean/ j n-rst-dims)
+	(if (and (= j-ref abs-index)
+		 (= j-rst i))
+	    1
+	    0)))
+    (map not indices))
+   (list
+    array-cell-ref
+    (lambda (x . indices)
+      (rel->abs indices (take (array-dimensions x)
+			      (length indices))))
+    (lambda (x . indices)
+      (apply * (drop (array-dimensions x)
+		     (length indices)))))
+   x indices))
+
+(define (make-batch elem . more)
+  (let ((batch-size (1+ (length more))))
+    (apply
+     differentiable-wrapper
+     (list-tabulate
+      batch-size
+      (lambda (b)
+	(lambda (xs i j n-rest-dims)
+	  (receive (i-batch i-rest) (euclidean/ i n-rest-dims)
+	    (if (and (= i-batch b)
+		     (= i-rest j))
+		1
+		0
+		)))))
+     (list
+      (lambda (elem . more)
+	(let ((a (apply make-typed-array *atype* *unspecified* batch-size
+			(dims-of elem))))
+	  (for-each
+	   (lambda (x b)
+	     (array-cell-set! a x b))
+	   (cons elem more)
+	   (list-tabulate batch-size identity))
+	  a))
+      (lambda (elem . more)
+	(apply * (dims-of elem))))
+     elem more)))
+
+(define (maximum x)
+  "Differentiable maximum on arrays."
+  (differentiable-wrapper
+   (list
+    (lambda (xs i j max-index)
+      (if (= j max-index)
+	  1
+	  0)))
+   (let ((max-index 'TBD))
+     (list
+      (lambda (x)
+	(let ((m (- (inf)))
+	      (i 0))
+	  (array-for-each
+	   (lambda (x)
+	     (when (< m x)
+	       (set! m x)
+	       (set! max-index i))
+	     (set! i (1+ i)))
+	   x)
+	  m))
+      (lambda _ max-index)))
+   x))
+
+(define (sum x)
+  "Differentiable sum on arrays."
+  (differentiable-wrapper
+   (list (lambda _ 1))
+   (lambda (x)
+     (let ((sum 0))
+       (array-for-each
+	(lambda (x)
+	  (set! sum (+ sum x)))
+	x)
+       sum))
+   x))
+
+(define (adot x y n)
+  (differentiable-wrapper
+   (list
+    (lambda (xs i j n-free-dims-y n-bound-dims)
+      (receive (i-x i-y) (euclidean/ i n-free-dims-y)
+	(receive (j-free j-bound) (euclidean/ j n-bound-dims)
+	  (ifn (= i-x j-free)
+	       0
+	       (array-ref (array-contents (cadr xs))
+			  (+ i-y (* n-free-dims-y j-bound)))))))
+    (lambda (xs i j n-free-dims-y n-bound-dims)
+      (receive (i-x i-y) (euclidean/ i n-free-dims-y)
+	(receive (j-bound j-free) (euclidean/ j n-free-dims-y)
+	  (ifn (= i-y j-free)
+	       0
+	       (array-ref (array-contents (car xs))
+			  (+ j-bound (* n-bound-dims i-x)))))))
+    #f)
+   (list
+    contract-arrays
+    (lambda (x y n)
+      (apply * (drop (array-dimensions y)
+		     n)))
+    (lambda (x y n)
+      (apply * (take (array-dimensions y)
+		     n))))
+   x y n))
+
+(define (amap2 f x y)
+  (apply make-batch
+	 (list-tabulate (car (dims-of (unwrap-fwd x)))
+			(lambda (b)
+			  (f (i:array-cell-ref x b)
+			     (i:array-cell-ref y b))))))
diff --git a/vouivre/curry.scm b/vouivre/curry.scm
new file mode 100644
index 0000000..f7d20fd
--- /dev/null
+++ b/vouivre/curry.scm
@@ -0,0 +1,465 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre curry)
+  #:use-module ((ice-9 curried-definitions) :prefix c)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
+  #:use-module (vouivre misc)
+  #:export
+  (curried-untyped-define
+   equal-types?
+   expand
+   parse
+   symtab
+   type-of
+   ∷))
+
+(define symtab '())
+
+(define-record-type node
+  (make-node content)
+  node?
+  (content node-content set-node-content!))
+
+(define (type-error n . args)
+  (let ((errors '((0 . TBD)
+		  (1 . INCOMPATIBLE)
+		  (2 . BAD-INPUT)
+		  (3 . BAD-APPLICATION)
+		  (4 . UNBOUND-SYMBOL)
+		  (5 . TYPE-EXPECT-TYPES))))
+    (apply error "type error" (assoc-ref errors n) args)))
+
+(define (zo? x)
+  "Predicate for the zero type."
+  (and (number? x) (zero? x)))
+
+(define (tv? x)
+  "Predicate for type variables."
+  (and (number? x) (positive? x) #t))
+
+;; Return a unique type variable.
+(define next
+  (let ((count 1))
+    (lambda ()
+      (set! count (1+ count))
+      (1- count))))
+
+(define (copy-tree node)
+  "Return a copy of the tree rooted in `node'."
+  (let ((x (node-content node)))
+    (if (pair? x)
+	(make-node (cons (copy-tree (car x))
+			 (copy-tree (cdr x))))
+	(make-node x))))
+
+(define (map-tree! proc nx)
+  "Map `proc' in-place over the content of the leaves of `nx'."
+  (let ((x (node-content nx)))
+    (if (pair? x)
+	(begin
+	  (map-tree! proc (car x))
+	  (map-tree! proc (cdr x)))
+	(set-node-content! nx (proc x)))
+    nx))
+
+(define (compare nx ny)
+  ""
+  (define (create-reduxtab m)
+    ;; Each `x' point (through `mx') to a list `ys' of elements `y' who
+    ;; themselves point (through `my') to lists of things equal to `x'.
+    ;; We unionize these, sort them, and, bind them as "things equal to `x'".
+    (let* ((mx (first m))
+	   (my (second m))
+	   (mxf (third m))
+	   (φ (lambda (x)
+		(assoc-ref mx x)))
+	   (φ* (lambda (y)
+		 (assoc-ref my y)))
+	   (Φ* (lambda (ys)
+		 (apply lset-union eq? (map φ* ys)))))
+      (append
+       (lset-difference
+	(lambda (x y) (eq? (car x) (car y)))
+	mxf mx)
+       (map
+	(match-lambda
+	  ((x . ys)
+	   (cons
+	    x
+	    (let ((new-x (first (sort-list (Φ* ys) <)))
+		  (fy (assoc-ref mxf x)))
+	      (if (and (zo? new-x) fy)
+		  (type-error 1 new-x fy)
+		  (if (not fy)
+		      new-x
+		      (node-content
+		       (map-tree!
+			(lambda (y)
+			  (first
+			   (sort-list
+			    (or (φ* y)
+				(list (next)))
+			    <)))
+			(copy-tree (make-node fy))))))))))
+	mx))))
+  (define (massoc m x y)
+    (define (assoc! m x y)
+      (assoc-set! m x (cons y (or (assoc-ref m x) '()))))
+    (list (if (and (not (pair? x))
+		   (not (pair? y)))
+	      (assoc! (first m) x y)
+	      (first m))
+	  (if (and (not (pair? x))
+		   (not (pair? y)))
+	      (assoc! (second m) y x)
+	      (second m))
+	  (if (not (pair? y))
+	      (third m)
+	      (if (assoc-ref (third m) x)
+		  (type-error 0 "type variable already a function")
+		  (assoc-set! (third m) x y)))))
+  (create-reduxtab
+   (let compare% ((m `(()
+		       ;; 0_x ≡ 0_y (though we only use 0y→0x).
+		       ;; Also, associations in an alist need to be mutable.
+		       (,(cons 0 '(0)))
+		       ()))
+		  (nx nx)
+		  (ny ny))
+     (let ((x (node-content nx))
+	   (y (node-content ny)))
+       (cond
+	;; same same
+	((eq? nx ny)
+	 m)
+	((and (not x) (not y))
+	 m)
+	((and (zo? x) (zo? y))
+	 m)
+	((and (tv? x) (tv? y))
+	 (massoc m x y))
+	((and (pair? x) (pair? y))
+	 (compare% (compare% m (car x) (car y))
+		   (cdr x) (cdr y)))
+	;; cases with #f
+	((and (zo? x) (not y))
+	 (set-node-content! ny x)
+	 m)
+	((and (zo? y) (not x))
+	 (set-node-content! nx y)
+	 m)
+	((and (tv? y) (not x))
+	 (let ((z (next)))
+	   (set-node-content! nx z)
+	   (massoc m y z)))
+	((and (tv? x) (not y))
+	 (let ((z (next)))
+	   (set-node-content! ny z)
+	   (massoc m x z)))
+	((and (pair? x) (not y))
+	 (set-node-content! ny x)
+	 m)
+	((and (pair? y) (not x))
+	 (type-error 0 nx ny))
+	;; cases with TVs
+	((and (tv? x) (zo? y))
+	 (massoc m x y))
+	((and (tv? y) (zo? x))
+	 (massoc m x y))
+	((and (tv? x) (pair? y))
+	 (massoc m x y))
+	((and (tv? y) (pair? x))
+	 (type-error 0 nx ny))
+	;; outright incompatible cases
+	((or (and (zo? x) (pair? y))
+	     (and (zo? y) (pair? x)))
+	 (type-error 1 x y))
+	;; bad input
+	(else
+	 (type-error 2 nx ny)))))))
+
+(define (reduce-tvs! reduxtab node)
+  (map-tree!
+   (lambda (x)
+     (if (number? x)
+	 (or (assoc-ref reduxtab x)
+	     x)
+	 x))
+   node))
+
+(define (rename-tvs! node)
+  (let ((mapping (cons '() #f)))
+    (map-tree!
+     (lambda (x)
+       (if (tv? x)
+	   (if-let (z (assoc-ref (car mapping) x))
+		   z
+		   (let ((z (next)))
+		     (set-car! mapping (assoc-set! (car mapping) x z))
+		     z))
+	   x))
+     node)))
+
+(define (apply-1 nx ny)
+  (let ((x (node-content nx))
+	(y (node-content ny)))
+    (cond
+     ((not x)
+      (set-node-content! nx (cons ny (make-node #f)))
+      (cdr (node-content nx)))
+     ((zo? x)
+      (type-error 3 x y))
+     ((tv? x)
+      (type-error 2 nx ny)
+      )
+     ((pair? x)
+      (reduce-tvs! (compare (car x) ny)
+		   (copy-tree (cdr x))))
+     (else
+      (type-error 2 nx ny)))))
+
+(define (var-list? lst)
+  "Predicate for valid macro variable lists."
+  (and (every symbol? lst)
+       (equal? lst (delete-duplicates lst))))
+
+(define (sym-set! symtab name value)
+  "Associate a type to a symbol in a symtab."
+  (let ((m (module-name (current-module))))
+    (assoc-set! symtab m
+		(assoc-set! (or (assoc-ref symtab m) '())
+			    name value))))
+
+(define (sym-set symtab sym value)
+  "Like `sym-set!' but returns a copy of the symtab."
+  (sym-set! (alist-copy symtab) sym value))
+
+(define (sym-ref symtab name)
+  "Reference a symbol in a symtab returning its type."
+  (let ((m (module-name (current-module))))
+    (assoc-ref (or (assoc-ref symtab m) '()) name)))
+
+(define (populate-tvs! node)
+  "Add (in-place) new type variables to empty nodes of a tree."
+  (map-tree!
+   (lambda (x)
+     (if (not x)
+	 (next)
+	 x))
+   node))
+
+(define (expand symtab expr)
+  "Type check an expression returning two values: its resulting type and an
+expansion where all applications of symbols present in the symtab are curried.
+Raise a type error if the expression is invalid."
+  (match expr
+    (('quote x)
+     (values
+      (make-node 0)
+      `',x))
+    (('λc (? symbol? var) body)
+     (let ((var-node (make-node #f)))
+       (let ((bodyt bodye (expand (sym-set symtab var var-node)
+				  body)))
+	 (unless bodyt
+	   (type-error 5 "in body of" `(λc ,var ,body)))
+	 (populate-tvs! var-node)
+	 (values
+	  (make-node
+	   (cons var-node bodyt))
+	  `(lambda (,var) ,bodye)))))
+    (('letrecc1 ((? symbol? name) expr) body)
+     (type-error 0 'letrecc1 name expr body))
+    (('cudefine name-vars body ..1)
+     (values
+      #f
+      `(cudefine ,name-vars ,@body)))
+    (('definec (? (lambda (x)
+		    (and
+		     (pair? x)
+		     (symbol? (car x))
+		     (var-list? (cdr x))))
+		  (name vars ..1))
+       body)
+     (expand
+      symtab
+      `(definec ,name
+	 ,(fold-right (lambda (x prev)
+			`(λc ,x ,prev))
+		      body vars))))
+    (('definec (? symbol? name) body)
+     (let ((t e (expand symtab body)))
+       (if (not t)
+	   (type-error 5 "in body of" `(definec ,name ,body))
+	   ;; We need to declare the type twice. Once, in `expand', to ensure
+	   ;; the type will be available in future `expand' calls. Second, in
+	   ;; the expanded expression, so that it gets compiled.
+	   (begin
+	     (∷% name t)
+	     (values
+	      #f
+	      `(begin
+		 ((@@ (vouivre curry) ∷%)
+		  ',name
+		  ((@ (vouivre curry) parse)
+		   ',(bare-type t)))
+		 (define ,name ,e)))))))
+    ((f)
+     (let ((t e (expand symtab f)))
+       (values
+	(if t
+	    (type-error 3 expr)
+	    #f)
+	`(,e))))
+    ((f as ..1)
+     (let ((ft fe (expand symtab f))
+	   (ats aes (unzip2
+		     (map
+		      (lambda (a)
+			(receive vals (expand symtab a) vals))
+		      as))))
+       (if (not ft)
+	   (values #f `(,fe ,@aes))
+	   (values
+	    (fold
+	     (lambda (at a prev)
+	       (apply-1 prev (or at (type-error 5 f a))))
+	     ft ats as)
+	    (fold
+	     (lambda (ae prev)
+	       (list prev ae))
+	     fe aes)))))
+    (x
+     (values
+      (if (symbol? x)
+	  (sym-ref symtab x)
+	  (make-node 0))
+      x))))
+
+(define (bare-type x)
+  "Return a type as tree s-expression without nodes."
+  (and=>
+   x
+   (lambda (node)
+     (let ((x (node-content node)))
+       (cond
+	((pair? x)
+	 (cons (bare-type (car x)) (bare-type (cdr x))))
+	(else x))))))
+
+(define* (pt node #:optional (port current-output-port))
+  "Print a tree to the given port in a cons cell format with '?' for empty
+nodes."
+  (format
+   port "~a~%"
+   (let pt% ((nx node))
+     (let ((x (node-content nx)))
+       (cond
+	((not x)
+	 "?")
+	((number? x)
+	 (number->string x))
+	((pair? x)
+	 (format #f "(~a . ~a)"
+		 (pt% (car x))
+		 (pt% (cdr x)))))))))
+
+(define (parse x)
+  "Parse a type from its cons cells representation to a tree."
+  (if (not x)
+      #f
+      (second
+       (let parse% ((tvs '())
+		    (x x))
+	 (cond
+	  ((eq? x '?)
+	   (list tvs (make-node #f)))
+	  ((zo? x)
+	   (list tvs (make-node 0)))
+	  ((tv? x)
+	   (if-let (z (assoc-ref tvs x))
+		   (list tvs (make-node z))
+		   (let ((tv (next)))
+		     (list (assoc-set! tvs x tv)
+			   (make-node tv)))))
+	  ((pair? x)
+	   (let* ((a (parse% tvs (car x)))
+		  (b (parse% (first a) (cdr x))))
+	     (list (first b) (make-node (cons (second a) (second b)))))))))))
+
+(define (equal-types? ta tb)
+  "Check the equality of two types."
+  (define (equal-types?% ta tb correspondances)
+    (let ((a (node-content ta))
+	  (b (node-content tb)))
+      (or
+       (eq? a b)
+       (let ((correspond?
+	      (lambda (tx ty correspondances)
+		(let ((x (node-content tx))
+		      (y (node-content ty)))
+		  (cond
+		   ((and (zo? x)
+			 (zo? y))
+		    correspondances)
+		   ((and (tv? x)
+			 (tv? y))
+		    (let ((xy (assoc-ref (car correspondances) x))
+			  (yx (assoc-ref (cdr correspondances) y)))
+		      (if (and (not xy) (not yx))
+			 (cons (assoc-set! (car correspondances) x y)
+			       (assoc-set! (cdr correspondances) y x))
+			 (and (eq? xy y) (eq? yx x) correspondances))))
+		   ((and (pair? x) (pair? y))
+		    (equal-types?% tx ty correspondances))
+		   (else #f))))))
+	 (match (list a b)
+	   (((a1 . a2) (b1 . b2))
+	    (and=>
+	     (correspond? a1 b1 correspondances)
+	     (lambda (correspondances)
+	       (correspond? a2 b2 correspondances))))
+	   (else #f))))))
+  (if (or (not ta) (not tb))
+      (eq? ta tb)
+      (and (equal-types?% ta tb '(() . ()))
+	   #t)))
+
+(define-syntax curried-untyped-define
+  (syntax-rules ()
+    ((_ (name var) body ...)
+     (cdefine (name var) body ...))
+    ((_ (name var1 var2 ...) body ...)
+     (curried-untyped-define ((name var1) var2 ...) body ...))))
+
+(define (∷% name type)
+  (set! symtab (sym-set! symtab name type)))
+
+(define-syntax-rule (∷ name type)
+  (∷% 'name (parse 'type)))
+
+(define* (type-of x #:optional port)
+  "Print the type of a declared symbol to the given port."
+  (if-let (x (expand symtab x))
+	  (pt x port)
+	  (format port "#f~%")))
diff --git a/vouivre/hconfig.scm b/vouivre/hconfig.scm
new file mode 100644
index 0000000..d2ba4a2
--- /dev/null
+++ b/vouivre/hconfig.scm
@@ -0,0 +1,23 @@
+(define-module
+ (vouivre hconfig)
+ #:use-module
+ (srfi srfi-26)
+ #:export
+ (%version
+  %author
+  %license
+  %copyright
+  %gettext-domain
+  G_
+  N_
+  init-nls
+  init-locale))
+
+(define %version "0.1")
+
+(define %author "Vouivre Digital Corporation")
+
+(define %license 'gpl3+)
+
+(define %copyright '(2023))
+
diff --git a/vouivre/misc.scm b/vouivre/misc.scm
new file mode 100644
index 0000000..accc3ba
--- /dev/null
+++ b/vouivre/misc.scm
@@ -0,0 +1,99 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre misc)
+  #:use-module (ice-9 arrays)
+  #:use-module (srfi srfi-1)
+  #:export
+  (array-map
+   array-map-indexed
+   flip
+   for-indices-in-range
+   if-let
+   ifn
+   list-zeros
+   map-indexed
+   produce-array
+   produce-typed-array))
+
+(define (flip f)
+  "Returns a procedure behaving as `f', but with arguments taken in reverse
+order."
+  (lambda args
+    (apply f (reverse args))))
+
+(define-syntax if-let
+  (syntax-rules ()
+    [(_ (x test) consequent alternate)
+     (let ([x test])
+       (if x consequent alternate))]
+    [(_ (x test) consequent)
+     (let ([x test])
+       (if x consequent))]))
+
+(define-syntax ifn
+  (syntax-rules ()
+    [(_ test alternate consequent)
+     (if test consequent alternate)]
+    [(_ test alternate)
+     (if (not test) alternate)]))
+
+(define (list-zeros n)
+  (list-tabulate n (lambda _ 0)))
+
+(define (map-indexed f . lists)
+  "Like `map' but the last argument of `f' is passed the corresponding index."
+  (apply map f (append lists (list (list-tabulate (length (car lists))
+						  identity)))))
+
+(define (for-indices-in-range f starts ends)
+  (define (for-indices-in-range% f indices starts ends)
+    (if (null? starts)
+	(apply f (reverse indices))
+	(do ((i (car starts) (1+ i)))
+	    ((= i (car ends)))
+	  (for-indices-in-range%
+	   f
+           (cons i indices)
+           (cdr starts)
+           (cdr ends)))))
+  (for-indices-in-range% f '() starts ends))
+
+;;;; array utilities
+
+(define (produce-typed-array f type . dims)
+  (let ((a (apply make-typed-array type *unspecified* dims)))
+    (array-index-map! a f)
+    a))
+
+(define (produce-array f . dims)
+  (apply produce-typed-array f #t dims))
+
+(define (array-map proc array . more)
+  (let ((x (array-copy array)))
+    (apply array-map! x proc array more)
+    x))
+
+(define (array-map-indexed proc array)
+  (let ((x (array-copy array)))
+    (array-index-map!
+     x
+     (lambda indices
+       (apply proc
+	      (apply array-ref array indices)
+	      indices)))
+    x))
diff --git a/vouivre/mnist.scm b/vouivre/mnist.scm
new file mode 100644
index 0000000..eabbe5e
--- /dev/null
+++ b/vouivre/mnist.scm
@@ -0,0 +1,95 @@
+;;;; Copyright (C) 2023 Vouivre Digital Corporation
+;;;;
+;;;; This file is part of Vouivre.
+;;;;
+;;;; Vouivre is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public
+;;;; License as published by the Free Software Foundation, either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; Vouivre is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with Vouivre. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (vouivre mnist)
+  #:use-module (guix build download)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (vouivre misc)
+  #:use-module (web uri)
+  #:export (load-mnist))
+
+;; NOTE: The directory and url must not include any trailing '/' character.
+(define directory "mnist")
+(define url "http://yann.lecun.com/exdb/mnist")
+(define trn-imgs-fname "train-images-idx3-ubyte")
+(define trn-lbls-fname "train-labels-idx1-ubyte")
+
+(define (exists? fname)
+  "Return `#t' if the file with the given name exists and `#f' otherwise."
+  (catch 'system-error
+    (lambda ()
+      (with-input-from-file fname
+	(lambda () #t)
+	#:binary #t))
+    (lambda _ #f)))
+
+(define (load-mnist nb-items download?)
+  "Return the given number of data points from the MNIST dataset downloading it
+if needed and requested in the ./mnist directory.
+
+The data is a cons cell containing an array (nb-items, height, width) of
+training images and an array (nb-items) of corresponding labels."
+  (define (read-uint bytes)
+    (bytevector-uint-ref (get-bytevector-n (current-input-port)
+					   bytes)
+			 0
+			 (endianness big)
+			 bytes))  
+  (apply
+   cons
+   (map
+    (lambda (base-name magic rank)
+      (let ((fname (string-append directory "/" base-name)))
+	(let redo ((download? download?))
+	  (if (exists? fname)
+	      (with-input-from-file fname
+		(lambda ()
+		  (when (not (= magic (read-uint 4)))
+		    (error "Unsupported file magic number."))
+		  (let* ((n (min nb-items (read-uint 4)))
+			 (dims (list-tabulate rank (lambda (x) (read-uint 4))))
+			 (n-dims (apply * n dims))
+			 (a (apply make-typed-array 'u8 0 n dims))
+			 (ac (array-contents a)))
+		    (let lp ((i 0))
+		      (if (= i n-dims)
+			  a
+			  (begin
+			    (array-set! ac (read-uint 1) i)
+			    (lp (1+ i)))))))
+		#:binary #t)
+	      (ifn download?
+		   (error (string-append "The MNIST dataset doesn't exist. If you tried with `download?' to `#t' already, to no avail, you can download the files manually from " url ", and extract them to a \"mnist\" directory at the root of the project. You can also file a bug report."))
+		   (let ((gzname (string-append fname ".gz")))
+		     (invoke "mkdir" "-p" directory)
+		     (call-with-output-file gzname
+		       (lambda (port)
+			 (put-bytevector
+			  port
+			  (get-bytevector-all
+			   (http-fetch
+			    (string->uri
+			     (string-append url "/" base-name ".gz"))))))
+		       #:binary #t)
+		     (invoke "gunzip" gzname)
+		     (redo #f)))))))
+    (list trn-imgs-fname trn-lbls-fname)
+    (list 2051 2049)
+    (list 2 0))))
diff --git a/vouivre/promises.scm b/vouivre/promises.scm
new file mode 100644
index 0000000..f3cd1e5
--- /dev/null
+++ b/vouivre/promises.scm
@@ -0,0 +1,105 @@
+;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms
+
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+;; This file has been modified by Vouivre Digital Corporation. The exact
+;; modifications can be seen in a shell using:
+;; $ git diff b4695cd888df6511915262884d2ce317156f92e8 promises.scm
+
+;;; Commentary:
+
+;; This is the code of the reference implementation of SRFI-45, modified
+;; to use SRFI-9 and to add 'promise?' to the list of exports.
+
+;; This module is documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (vouivre promises)
+  #:export (*promises* reset-promises)
+  #:replace (delay force)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu))
+
+(define *promises* (make-parameter #f))
+
+(define-record-type promise (make-promise val) promise?
+  (val promise-val promise-val-set!))
+
+(define-record-type value (make-value tag proc rec) value?
+  (tag value-tag value-tag-set!)
+  (proc value-proc value-proc-set!)
+  (rec value-rec value-rec-set!))
+
+(define-syntax-rule (lazy exp)
+  (let ((proc (lambda () exp)))
+    (make-promise (make-value 'lazy proc proc))))
+
+(define (eager x)
+  (make-promise (make-value 'eager x #f)))
+
+(define-syntax-rule (delay exp)
+  (let ((promise (lazy (eager exp)))
+	(promises-ptr (*promises*)))
+    (set-car! promises-ptr (cons promise (car promises-ptr)))
+    promise))
+
+(define (force promise)
+  (let ((content (promise-val promise)))
+    (case (value-tag content)
+      ((eager)
+       (value-proc content))
+      ((lazy)
+       (let* ((promise* ((value-proc content)))
+              (content  (promise-val promise)))	   ; *
+         (unless (eqv? 'eager (value-tag content)) ; *
+           (value-tag-set! content (value-tag (promise-val promise*)))
+           (value-proc-set! content (value-proc (promise-val promise*)))
+           (promise-val-set! promise* content))
+         (force promise))))))
+;; (*) These two lines re-fetch and check the original promise in case
+;;     the first line of the let* caused it to be forced.  For an example
+;;     where this happens, see reentrancy test 3 below.
+
+(define (reset-promises promises)
+  (unless (null? promises)
+    (let ((v (promise-val (car promises))))
+      (when (value-rec v)
+	(value-proc-set! v (value-rec v))
+	(value-tag-set! v 'lazy))
+      (reset-promises (cdr promises)))))
+
+(define* (promise-visit promise #:key on-eager on-lazy)
+  (define content (promise-val promise))
+  (case (value-tag content)
+    ((eager) (on-eager (value-proc content)))
+    ((lazy)  (on-lazy (value-proc content)))))
+
+(set-record-type-printer! promise
+  (lambda (promise port)
+    (promise-visit promise
+      #:on-eager (lambda (value)
+                   (format port "#<promise = ~s>" value))
+      #:on-lazy  (lambda (proc)
+                   (format port "#<promise => ~s>" proc)))))