├── .gitignore ├── README.md ├── project.clj ├── src └── jalunke │ ├── compile.clj │ ├── eval.clj │ ├── grammar.clj │ └── lexing.clj └── test └── jalunke ├── compile_test.clj ├── eval_test.clj └── plus.hal /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ✨ 2 | [halunke.jetzt](http://halunke.jetzt) 3 | ✨ 4 | 5 | 6 | video thumbnail 9 | 10 | 11 | ```clojure 12 | user=> (require 'jalunke.compile) 13 | nil 14 | user=> (require 'jalunke.eval) 15 | nil 16 | user=> (def plus (slurp "test/jalunke/plus.hal")) 17 | #'user/plus 18 | user=> (print plus) 19 | ('fn = { |'a 'b| (a + b) }) 20 | (fn call [1 2]) 21 | user=> (jalunke.compile/compile-code plus) 22 | (clojure.core/let [fn (clojure.core/fn [a b] (+ a b))] (call fn [1 2])) 23 | user=> (jalunke.eval/evaluate plus) 24 | 3 25 | ``` 26 | 27 | Copyright (c) 2018 Jan Stępień. Distributed under the MIT License. 28 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject jalunke "0.0.0" 2 | :dependencies [[org.clojure/clojure "1.9.0"]] 3 | :profiles {:dev {:dependencies [[org.clojure/test.check "0.9.0"]]}}) 4 | -------------------------------------------------------------------------------- /src/jalunke/compile.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.compile 2 | (:require [clojure.string :as str] 3 | [clojure.spec.alpha :as s] 4 | [jalunke.grammar :as grammar])) 5 | 6 | (declare compile-exprs) 7 | 8 | (defn prepending [forms] 9 | (fn [more] 10 | (list* forms more))) 11 | 12 | (defmulti translate first) 13 | 14 | (defmethod translate ::grammar/number 15 | [[_ {string ::grammar/string}]] 16 | (prepending (Long/parseLong string))) 17 | 18 | (defmethod translate ::grammar/string 19 | [[_ {string ::grammar/string}]] 20 | (prepending (subs string 1 (dec (count string))))) 21 | 22 | (defmethod translate ::grammar/bareword 23 | [[_ {string ::grammar/string}]] 24 | (prepending (symbol string))) 25 | 26 | (defmethod translate ::grammar/assignment 27 | [[_ {sym ::grammar/symbol, value ::grammar/value}]] 28 | (let [value (compile-exprs [value]) 29 | sym (-> sym 30 | ::grammar/string 31 | (subs 1) 32 | symbol)] 33 | (fn [form] 34 | (list 35 | `(let [~sym ~value] 36 | ~@form))))) 37 | 38 | (defmethod translate ::grammar/msg-send 39 | [[_ {::grammar/keys [body object method arg-pairs last-arg]}]] 40 | (let [method-chunks (cons method (map ::grammar/method arg-pairs)) 41 | method (->> method-chunks 42 | (map ::grammar/string) 43 | (str/join \-) 44 | symbol) 45 | args (mapv ::grammar/arg arg-pairs) 46 | all-args (cons object (if last-arg 47 | (conj args last-arg) 48 | args)) 49 | compiled-args (map (comp compile-exprs vector) 50 | all-args)] 51 | (prepending (cons method compiled-args)))) 52 | 53 | (defn do? [forms] 54 | (and (sequential? forms) 55 | (= 'do (first forms)))) 56 | 57 | (defmethod translate ::grammar/array 58 | [[_ {exprs ::grammar/exprs}]] 59 | (let [values (compile-exprs exprs)] 60 | (prepending (if (do? values) 61 | (vec (rest values)) 62 | [values])))) 63 | 64 | (defmethod translate ::grammar/nullary-function 65 | [[_ {body ::grammar/body}]] 66 | (let [values (compile-exprs body)] 67 | (prepending `(fn [] 68 | ~@(if (do? values) 69 | (rest values) 70 | (list values)))))) 71 | 72 | (defn- compile-arguments [arg-tokens] 73 | {:pre [(every? (comp #{:unassigned-bareword} 74 | ::grammar/token 75 | second) 76 | arg-tokens)]} 77 | (for [token arg-tokens] 78 | (-> token 79 | second 80 | ::grammar/string 81 | (subs 1) 82 | symbol))) 83 | 84 | (defmethod translate ::grammar/function 85 | [[_ {args ::grammar/args, body ::grammar/body}]] 86 | (let [values (compile-exprs body) 87 | args (compile-arguments args)] 88 | (prepending `(fn ~(vec args) 89 | ~@(if (do? values) 90 | (rest values) 91 | (list values)))))) 92 | 93 | (defmethod translate :default 94 | [form] 95 | (throw (ex-info (format "Cannot translate %s" (pr-str form) ) 96 | {:form form}))) 97 | 98 | (defn compile-exprs [exprs] 99 | (letfn [(maybe-do [forms] 100 | (if (= 1 (count forms)) 101 | (first forms) 102 | (cons 'do forms)))] 103 | (->> exprs 104 | (map translate) 105 | reverse 106 | (reduce (fn [cont form-fn] 107 | (form-fn cont)) 108 | ()) 109 | maybe-do))) 110 | 111 | (defn compile-code [code] 112 | (let [result (grammar/parse code)] 113 | (compile-exprs (:program result)))) 114 | 115 | (comment 116 | (compile-code "('foo = -3)\n((foo > 0) then { \"pos\" } else { \"notpos\" })") 117 | (compile-code "('xs = [1 2 3])\n({|'x| (1 + x)} map xs)")) 118 | -------------------------------------------------------------------------------- /src/jalunke/eval.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.eval 2 | (:require [jalunke.compile :as c] 3 | [clojure.string :as str])) 4 | 5 | (defn call [f args] 6 | (apply f args)) 7 | 8 | (defn replace-with [hay needle replacement] 9 | (str/replace hay needle replacement)) 10 | 11 | (defn then-else [bool then else] 12 | (if bool 13 | (then) 14 | (else))) 15 | 16 | (defn reverse* [str] 17 | (str/reverse str)) 18 | 19 | (defn reduce-with [coll f init] 20 | (reduce f init coll)) 21 | 22 | (defn- with-builtins [forms] 23 | (list 24 | 'let 25 | '[call jalunke.eval/call 26 | then-else jalunke.eval/then-else 27 | reduce-with jalunke.eval/reduce-with 28 | reverse jalunke.eval/reverse* 29 | replace-with jalunke.eval/replace-with] 30 | forms)) 31 | 32 | (defn evaluate [code] 33 | (let [forms (c/compile-code code)] 34 | (eval (with-builtins forms)))) 35 | 36 | (comment 37 | (evaluate "('foo = 3)\n((foo > 0) then { \"pos\" } else { \"notpos\" })") 38 | (evaluate "('xs = [1 2 3])\n({|'x| (1 + x)} map xs)")) 39 | -------------------------------------------------------------------------------- /src/jalunke/grammar.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.grammar 2 | (:require [clojure.string :as str] 3 | [clojure.spec.alpha :as s] 4 | [jalunke.lexing :as lex])) 5 | 6 | (s/def ::program 7 | (s/+ ::expression)) 8 | 9 | (s/def ::expression 10 | (s/alt ::number ::number 11 | ::string ::string 12 | ::msg-send ::msg-send 13 | ::function ::function 14 | ::nullary-function ::nullary-function 15 | ::bareword ::bareword 16 | ::assignment ::assignment 17 | ::array ::array)) 18 | 19 | (s/def ::msg-send 20 | (s/cat ::open-paren ::open-paren 21 | ::object ::expression 22 | ::method ::bareword 23 | ::arg-pairs (s/* (s/cat ::arg ::expression 24 | ::method ::bareword)) 25 | ::last-arg (s/? ::expression) 26 | ::close-paren ::close-paren)) 27 | 28 | (s/def ::assignment 29 | (s/cat ::open-paren ::open-paren 30 | ::symbol ::unassigned-bareword 31 | ::eq #{[:bareword "="]} 32 | ::value ::expression 33 | ::close-paren ::close-paren)) 34 | 35 | (s/def ::array 36 | (s/cat ::open-bracket ::open-bracket 37 | ::exprs (s/* ::expression) 38 | ::close-bracket ::close-bracket)) 39 | 40 | (s/def ::nullary-function 41 | (s/cat ::open-curly ::open-curly 42 | ::body (s/+ ::expression) 43 | ::close-curly ::close-curly)) 44 | 45 | (s/def ::function 46 | (s/cat ::open-curly ::open-curly 47 | ::open-bar ::bar 48 | ::args (s/+ (s/alt ::unassigned-bareword 49 | ::unassigned-bareword)) 50 | ::close-bar ::bar 51 | ::body (s/+ ::expression) 52 | ::close-curly ::close-curly)) 53 | 54 | (s/def ::open-curly 55 | #{[:open-curly "{"]}) 56 | 57 | (s/def ::close-curly 58 | #{[:close-curly "}"]}) 59 | 60 | (s/def ::open-bracket 61 | #{[:open-bracket "["]}) 62 | 63 | (s/def ::close-bracket 64 | #{[:close-bracket "]"]}) 65 | 66 | (s/def ::open-paren 67 | #{[:open-paren "("]}) 68 | 69 | (s/def ::close-paren 70 | #{[:close-paren ")"]}) 71 | 72 | (s/def ::bar 73 | #{[:bar "|"]}) 74 | 75 | (s/def ::bareword 76 | (s/spec 77 | (s/cat ::token #{:bareword} 78 | ::string string?))) 79 | 80 | (s/def ::number 81 | (s/spec 82 | (s/cat ::token #{:number} 83 | ::string string?))) 84 | 85 | (s/def ::string 86 | (s/spec 87 | (s/cat ::token #{:string} 88 | ::string string?))) 89 | 90 | (s/def ::unassigned-bareword 91 | (s/spec 92 | (s/cat ::token #{:unassigned-bareword} 93 | ::string string?))) 94 | 95 | (defn- remove-irrelevant [tokens] 96 | (remove (comp #{:whitespace :comment} first) tokens)) 97 | 98 | (defn parse [code] 99 | (let [tokens (remove-irrelevant (lex/tokenise code)) 100 | prog (s/conform ::program tokens)] 101 | (if (s/invalid? prog) 102 | (s/explain-data ::program tokens) 103 | {:program prog}))) 104 | 105 | #_ 106 | (parse "('a = ('b = 3))") 107 | -------------------------------------------------------------------------------- /src/jalunke/lexing.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.lexing 2 | (:require [clojure.string :as str] 3 | [clojure.spec.alpha :as s])) 4 | 5 | (defn- single-char [code] 6 | (some-> (case (first code) 7 | \( :open-paren 8 | \) :close-paren 9 | \{ :open-curly 10 | \} :close-curly 11 | \[ :open-bracket 12 | \] :close-bracket 13 | \| :bar 14 | nil) 15 | (vector (subs code 0 1)))) 16 | 17 | (defn- number [code] 18 | (if-let [m (re-find #"^[+-]?[0-9]+" code)] 19 | [:number m])) 20 | 21 | (defn- unassigned-bareword [code] 22 | (if-let [m (re-find #"^'[a-zA-Z_]+" code)] 23 | [:unassigned-bareword m])) 24 | 25 | (defn- bareword [code] 26 | (if-let [[m] (re-find #"^([a-zA-Z_]+|[<>+=-])" code)] 27 | [:bareword m])) 28 | 29 | (defn- string [code] 30 | (if-let [m (re-find #"^\"[^\"]+\"" code)] 31 | [:string m])) 32 | 33 | (defn- whitespace [code] 34 | (if-let [m (re-find #"^[ \t\n]+" code)] 35 | [:whitespace m])) 36 | 37 | (defn- comment-block [code] 38 | (if (str/starts-with? code "/*") 39 | (let [idx (str/index-of code "*/")] 40 | [:comment (subs code 0 (+ 2 idx))]))) 41 | 42 | (defn tokenise [code] 43 | (if (seq code) 44 | (if-let [[type string] (or (single-char code) 45 | (number code) 46 | (string code) 47 | (unassigned-bareword code) 48 | (bareword code) 49 | (comment-block code) 50 | (whitespace code))] 51 | (cons [type string] (tokenise (subs code (count string)))) 52 | (throw (ex-info "Unexpected token" {:code code}))))) 53 | -------------------------------------------------------------------------------- /test/jalunke/compile_test.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.compile-test 2 | (:require [jalunke 3 | [compile :as c] 4 | [grammar :as grammar]] 5 | [clojure.spec.alpha :as s] 6 | [clojure.test.check 7 | [clojure-test :refer [defspec]] 8 | [properties :as prop] 9 | [generators :as gen]] 10 | [clojure.test :refer :all])) 11 | 12 | (deftest small-samples 13 | (are [in out] (= out (c/compile-code in)) 14 | 15 | "/**/ 1 /* \n\n */ 2 /* \" */" 16 | '(do 1 2) 17 | 18 | "('a = 3)" 19 | '(clojure.core/let [a 3]) 20 | 21 | "('a = [b])" 22 | '(clojure.core/let [a [b]]) 23 | 24 | "('a = [c (3 + 1) d])" 25 | '(clojure.core/let [a [c (+ 3 1) d]]) 26 | 27 | "({ \"bar\" } call)" 28 | '(call (clojure.core/fn [] "bar")) 29 | 30 | "(\"foo\" replace \"b\" with \"f\")" 31 | '(replace-with "foo" "b" "f") 32 | 33 | "{ |'a| a }" 34 | '(clojure.core/fn [a] a) 35 | 36 | "('fn = { |'a 'b| (a + b) }) (fn call [1 2])" 37 | '(clojure.core/let [fn (clojure.core/fn [a b] 38 | (+ a b))] 39 | (call fn [1 2])) 40 | 41 | "({ 0 1 } call)" 42 | '(call (clojure.core/fn [] 0 1)) 43 | 44 | "('a = (\"foo\" reverse))" 45 | '(clojure.core/let [a (reverse "foo")]) 46 | 47 | "('a = 3) (a + a)" 48 | '(clojure.core/let [a 3] 49 | (+ a a)) 50 | 51 | "(a < 1)" '(< a 1))) 52 | 53 | (s/def ::grammar/number 54 | (s/with-gen (s/get-spec ::grammar/number) 55 | (fn [] 56 | (->> gen/int 57 | (gen/fmap str) 58 | (gen/fmap (partial vector :number)))))) 59 | 60 | (s/def ::grammar/string 61 | (s/with-gen (s/get-spec ::grammar/string) 62 | (fn [] 63 | (->> gen/string-alphanumeric 64 | (gen/fmap #(str \" % \")) 65 | (gen/fmap (partial vector :string)))))) 66 | 67 | #_ 68 | (s/def ::grammar/unassigned-bareword 69 | (s/with-gen (s/get-spec ::grammar/unassigned-bareword) 70 | (fn [] 71 | (gen/return [:unassigned-bareword "'a"]) 72 | ))) 73 | 74 | #_ 75 | (gen/sample (s/gen ::grammar/unassigned-bareword)) 76 | 77 | #_ 78 | (defspec generative-madness 79 | (prop/for-all 80 | [program (s/gen ::grammar/program)] 81 | (c/compile-exprs (s/conform ::grammar/program program)))) 82 | -------------------------------------------------------------------------------- /test/jalunke/eval_test.clj: -------------------------------------------------------------------------------- 1 | (ns jalunke.eval-test 2 | (:require [jalunke.eval :as e] 3 | [clojure.spec.alpha :as s] 4 | [clojure.test.check 5 | [clojure-test :refer [defspec]] 6 | [properties :as prop] 7 | [generators :as gen]] 8 | [clojure.test :refer :all])) 9 | 10 | (deftest happy-path 11 | (are [in out] (= out (e/evaluate in)) 12 | 13 | "('fn = { |'a 'b| (a + b) }) (fn call [1 2])" 14 | 3 15 | 16 | "((2 > 3) then { \"yes!\" } else { \"no!\" })" 17 | "no!" 18 | 19 | "(\"abc\" reverse)" 20 | "cba" 21 | 22 | "([1 2 3] reduce {|'memo 'el| (memo + el) } with 0)" 23 | 6 24 | 25 | "(\"foo\" replace \"f\" with \"b\")" 26 | "boo")) 27 | -------------------------------------------------------------------------------- /test/jalunke/plus.hal: -------------------------------------------------------------------------------- 1 | ('fn = { |'a 'b| (a + b) }) 2 | (fn call [1 2]) 3 | --------------------------------------------------------------------------------