From 7752d73216578d5961751b5d0535088d384b4aa6 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Sat, 25 Jan 2025 10:45:41 +0100
Subject: Move λ-calcul workshop code to subdirectory
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 lambda-calcul/clojure/src/lccl/lc/ast.clj       |  7 +++++++
 lambda-calcul/clojure/src/lccl/lc/evaluator.clj | 28 +++++++++++++++++++++++++
 2 files changed, 35 insertions(+)
 create mode 100644 lambda-calcul/clojure/src/lccl/lc/ast.clj
 create mode 100644 lambda-calcul/clojure/src/lccl/lc/evaluator.clj

(limited to 'lambda-calcul/clojure/src/lccl/lc')

diff --git a/lambda-calcul/clojure/src/lccl/lc/ast.clj b/lambda-calcul/clojure/src/lccl/lc/ast.clj
new file mode 100644
index 0000000..58bad11
--- /dev/null
+++ b/lambda-calcul/clojure/src/lccl/lc/ast.clj
@@ -0,0 +1,7 @@
+(ns lccl.lc.ast)
+
+(defrecord Var [name])
+(defrecord Abs [arg body])
+(defrecord App [left right])
+
+(def IDENTITY (->Abs "x" (->Var "x")))
diff --git a/lambda-calcul/clojure/src/lccl/lc/evaluator.clj b/lambda-calcul/clojure/src/lccl/lc/evaluator.clj
new file mode 100644
index 0000000..70e972e
--- /dev/null
+++ b/lambda-calcul/clojure/src/lccl/lc/evaluator.clj
@@ -0,0 +1,28 @@
+(ns lccl.lc.evaluator
+  (:import [lccl.lc.ast Var Abs App])
+  (:require [lccl.lc.ast :refer [->Abs ->App]]))
+
+(declare substitute)
+
+(defmulti evaluate (fn [term] [(type term)]))
+(defmethod evaluate [Var] ([term] term))
+(defmethod evaluate [Abs] ([term] term))
+(defmethod evaluate [App]
+  ([term]
+   (let [left (-> term :left)]
+     (condp = (type left)
+       Abs (substitute (:body left) (:arg left) (:right term))
+       term))))
+
+(defmulti substitute (fn [body arg val] [(type body)]))
+(defmethod substitute [Var]
+  ([body arg val]
+   (if (= (:name body) arg) val body)))
+(defmethod substitute [Abs]
+  ([body arg val]
+   (if (= (:arg body) arg)
+     body
+     (->Abs (:arg body) (substitute (:body body) arg val)))))
+(defmethod substitute [App]
+  ([body arg val]
+   (->App (substitute (:left body) arg val) (substitute (:right body) arg val))))
-- 
cgit v1.2.3