Add clojure evaluator

9 files changed, 183 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
index cf0012f..050c525 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,5 @@
 *~
 *.profraw
 .idea
+.clj-kondo
+.lsp
diff --git a/clojure/.gitignore b/clojure/.gitignore
new file mode 100644
index 0000000..883fee3
--- /dev/null
+++ b/clojure/.gitignore
@@ -0,0 +1,6 @@
+.cpcache
+.nrepl-port
+.calva
+
+target
+
diff --git a/clojure/deps.edn b/clojure/deps.edn
new file mode 100644
index 0000000..b43182c
--- /dev/null
+++ b/clojure/deps.edn
@@ -0,0 +1,13 @@
+{:paths ["src"]
+ :deps
+ {metosin/reitit {:mvn/version "0.7.0"}
+  metosin/reitit-middleware {:mvn/version "0.7.0"}
+  ring/ring-jetty-adapter {:mvn/version "1.12.1"}
+  ring/ring-devel {:mvn/version "1.12.1"}
+  clj-http/clj-http {:mvn/version "3.13.0"}}
+
+ :aliases
+ {;; Run with clj -T:build function-in-build
+  :build {:deps {io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
+          :ns-default build}}}
+          
\ No newline at end of file
diff --git a/clojure/src/lccl/app.clj b/clojure/src/lccl/app.clj
new file mode 100644
index 0000000..522d8bf
--- /dev/null
+++ b/clojure/src/lccl/app.clj
@@ -0,0 +1,30 @@
+(ns lccl.app
+  (:require [reitit.ring :as ring-reitit]
+            [reitit.coercion.malli]
+            [reitit.ring.malli]
+            [reitit.dev.pretty :as pretty]
+            [reitit.ring.middleware.muuntaja :as muuntaja]
+            [muuntaja.core :as m]))
+
+(defn eval
+  [request]
+  (let [sexpr (slurp (:body request))]
+    (println "Demande d'évaluation de l'expression :" sexpr)
+    {:status 200, :body sexpr}))
+
+(defn api-handler
+  []
+  (ring-reitit/ring-handler
+   (ring-reitit/router
+    [["/eval" {:post eval}]]
+
+    {:exception pretty/exception
+     :data {
+            :muuntaja m/instance
+            :middleware [muuntaja/format-response-middleware]}})))
+
+(defn app-handler
+  []
+  (ring-reitit/routes (api-handler)))
+
+
diff --git a/clojure/src/lccl/fwk/middlewares.clj b/clojure/src/lccl/fwk/middlewares.clj
new file mode 100644
index 0000000..973cffc
--- /dev/null
+++ b/clojure/src/lccl/fwk/middlewares.clj
@@ -0,0 +1,15 @@
+(ns lccl.fwk.middlewares
+  (:require [ring.middleware.reload :as reload]))
+
+; https://bogoyavlensky.com/blog/auto-reloading-ring/
+(defn reloading-ring-handler
+  "Reload ring handler on each request."
+  [f]
+  (let [reload! (#'reload/reloader ["src"] true)]
+    (fn
+      ([request]
+       (reload!)
+       ((f) request))
+      ([request respond raise]
+       (reload!)
+       ((f) request respond raise)))))
\ No newline at end of file
diff --git a/clojure/src/lccl/lc/ast.clj b/clojure/src/lccl/lc/ast.clj
new file mode 100644
index 0000000..58bad11
--- /dev/null
+++ b/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/clojure/src/lccl/lc/evaluator.clj b/clojure/src/lccl/lc/evaluator.clj
new file mode 100644
index 0000000..70e972e
--- /dev/null
+++ b/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))))
diff --git a/clojure/src/lccl/main.clj b/clojure/src/lccl/main.clj
new file mode 100644
index 0000000..071d7c6
--- /dev/null
+++ b/clojure/src/lccl/main.clj
@@ -0,0 +1,36 @@
+(ns lccl.main
+  (:require [ring.adapter.jetty :as ring-jetty]
+            [clj-http.client :as client]
+            [lccl.app :as app]
+            [lccl.fwk.middlewares :as middlewares])
+  (:gen-class))
+
+(def TEAM_NAME "LCCL")    
+(def SELF_PORT 8888)    
+(def SELF_URL (str "http://127.0.0.1:" SELF_PORT))    
+(def TESTER_URL "http://127.0.0.1:8080")
+
+(defn run-http-server!
+  [{:keys [dev-mode? server-options]}]
+  (let [create-handler-fn #(app/app-handler)
+        handler* (if dev-mode?
+                   (middlewares/reloading-ring-handler create-handler-fn)
+                   (create-handler-fn))]
+    (ring-jetty/run-jetty handler* server-options)
+    (println "Evaluateur à l'écoute sur le port" (:port server-options))))
+
+(defn- run! [{dev-mode? :dev-mode?}]
+  (run-http-server! {:dev-mode? dev-mode?
+               :server-options {:join? false :port SELF_PORT}})
+  (let [response (client/post (str TESTER_URL "/register")
+               {:body (str "{\"url\": \"" SELF_URL "/eval\", \"name\": \"" TEAM_NAME  "\"}")
+                :content-type :json
+                :accept :json})]
+  (println "Résultat de l'enregistrement : " (:body response))))
+
+(defn -main 
+  [& _]
+  (run! {:dev-mode? false}))
+
+(comment
+  (run! {:dev-mode? true}))
diff --git a/clojure/test/lccl/lc/evaluator_test.clj b/clojure/test/lccl/lc/evaluator_test.clj
new file mode 100644
index 0000000..d1e9c41
--- /dev/null
+++ b/clojure/test/lccl/lc/evaluator_test.clj
@@ -0,0 +1,46 @@
+(ns lccl.lc.evaluator-test
+  (:require
+   [clojure.test :refer [deftest testing is]]
+   [lccl.lc.ast :refer [->Var ->Abs ->App IDENTITY]]
+   [lccl.lc.evaluator :refer [substitute evaluate]]))
+
+(def x (->Var "x"))
+(def y (->Var "y"))
+(def z (->Var "z"))
+
+(defn- assertEvalTo
+  [termToEvaluate result]
+  (is (= result (evaluate termToEvaluate))))
+
+(deftest evaluation
+  (testing "l'evaluation d'une variable rend la même variable"
+    ; evaluate(x) == x
+    (assertEvalTo x x))
+  (testing "l'evaluation d'une abstraction rend la même abstraction"
+    ; evaluate(λx.x) == λx.x
+    (assertEvalTo IDENTITY IDENTITY))
+  (testing "l'evaluation de l'application de deux vars rend la même abstraction"
+    ; evaluate(x y) == x y
+    (assertEvalTo (->App x y) (->App x y)))
+  (testing "l'evaluation de l'application de l'identite sur un argument rend l'argument"
+    ;  evaluate((λx.x) y) == y
+    (assertEvalTo (->App IDENTITY y) y))
+  (testing "l'evaluation de l'application d'une abstraction substitue son argument"
+    ;  evaluate((λx.x x) y) == y y
+    (assertEvalTo (->App (->Abs "x" (->App x x)) y) (->App y y)))
+  (testing "l'evaluation de l'application d'une abstraction d'abstraction substitue recursivement son argument"
+    ;  evaluate((λx.λy.x) z) == λy.z
+    (assertEvalTo (->App (->Abs "x" (->Abs "y" x)) z) (->Abs "y" z)))
+  (testing "l'evaluation de l'application d'une abstraction ne substitue pas ses variables libres"
+    ;  evaluate((λx.y) z) == y
+    (assertEvalTo (->App (->Abs "x" y) z) y))
+  (testing "l'evaluation de l'application d'une abstraction d'abstraction ne substitue pas les variables redéfinies"
+    ;  evaluate((λx.λx.x) z) == λx.x
+    (assertEvalTo (->App (->Abs "x" (->Abs "x" x)) z) (->Abs "x" x)))
+  )
+
+(deftest substitution
+  (testing "la substitution d'une variable rend la même variable"
+      ; substitute(x x, y) == y y
+    (is (= y (substitute x "x" y)))))
+