diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | clojure/.gitignore | 6 | ||||
| -rw-r--r-- | clojure/deps.edn | 13 | ||||
| -rw-r--r-- | clojure/src/lccl/app.clj | 30 | ||||
| -rw-r--r-- | clojure/src/lccl/fwk/middlewares.clj | 15 | ||||
| -rw-r--r-- | clojure/src/lccl/lc/ast.clj | 7 | ||||
| -rw-r--r-- | clojure/src/lccl/lc/evaluator.clj | 28 | ||||
| -rw-r--r-- | clojure/src/lccl/main.clj | 36 | ||||
| -rw-r--r-- | clojure/test/lccl/lc/evaluator_test.clj | 46 |
9 files changed, 183 insertions, 0 deletions
@@ -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))))) + |