├── examples ├── let.sclj ├── eval.sclj ├── apply.sclj ├── call-cc.sclj ├── fact.sclj ├── macros.sclj └── polymorphism.sclj ├── .gitignore ├── docs ├── vision.md └── manual.md ├── src ├── simple_stackless_lisp │ ├── env.clj │ ├── reader.clj │ ├── main.clj │ ├── core.clj │ ├── util.clj │ ├── builtins.clj │ ├── impl.clj │ ├── multi.clj │ └── types.clj └── experiments │ └── types.clj ├── project.clj ├── .github └── workflows │ └── clojure.yml ├── README.md └── LICENSE /examples/let.sclj: -------------------------------------------------------------------------------- 1 | (let [a 1 2 | b 2] 3 | (println (+ a b))) -------------------------------------------------------------------------------- /examples/eval.sclj: -------------------------------------------------------------------------------- 1 | (def a 1) 2 | 3 | (def code 4 | (quote 5 | (+ a 1))) 6 | 7 | (println (eval code)) 8 | -------------------------------------------------------------------------------- /examples/apply.sclj: -------------------------------------------------------------------------------- 1 | (def f 2 | (fn [x y] 3 | (+ x y))) 4 | 5 | (def args 6 | (list 1 2)) 7 | 8 | (println (apply f args)) 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | profiles.clj 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /.lein-* 10 | /.nrepl-port 11 | .hgignore 12 | .hg/ 13 | -------------------------------------------------------------------------------- /examples/call-cc.sclj: -------------------------------------------------------------------------------- 1 | "From https://stackoverflow.com/q/16529475" 2 | 3 | (def example 4 | (fn [] 5 | (call-cc 6 | (fn [k] 7 | (* 5 (k 4)))))) 8 | 9 | (println (example)) -------------------------------------------------------------------------------- /examples/fact.sclj: -------------------------------------------------------------------------------- 1 | (def fact 2 | (fn [n] 3 | (if (< n 2) 4 | 1 5 | (* n (fact (- n 1)))))) 6 | 7 | (println "(fact 50000) =>") 8 | 9 | (println (fact 50000)) 10 | -------------------------------------------------------------------------------- /examples/macros.sclj: -------------------------------------------------------------------------------- 1 | (def and 2 | (macro [x y] 3 | (let [x# (gensym "x")] 4 | (quote 5 | (let [(unquote x#) (unquote x)] 6 | (if (unquote x#) 7 | (unquote y) 8 | (unquote x#))))))) 9 | 10 | (def or 11 | (macro [x y] 12 | (let [x# (gensym "x")] 13 | (quote 14 | (let [(unquote x#) (unquote x)] 15 | (if (unquote x#) 16 | (unquote x#) 17 | (unquote y))))))) 18 | 19 | (def dbg 20 | (macro [exp] 21 | (quote (println (quote (unquote exp)) "=>" (unquote exp))))) 22 | 23 | (dbg (and true false)) 24 | (dbg (or false true)) -------------------------------------------------------------------------------- /docs/vision.md: -------------------------------------------------------------------------------- 1 | # Vision - Simple Stackless Lisp 2 | 3 | ## Language features 4 | 5 | - Clojure-like functional Lisp-1 6 | - Go-like async IO, goroutines, and channels 7 | - Arbitrary precision numbers 8 | - Destructuring everywhere 9 | - No stack overflows 10 | - First class macros 11 | - First class continuations 12 | - Delimited continuations 13 | - First-class specs and toggle-able runtime spec-checking 14 | - All top-level functions in modules must be default cases of multimethods 15 | 16 | ## Others 17 | 18 | - Leiningen-like all-in-one tool for deps, builds, etc 19 | - Package user code as single distributable JAR/native executable 20 | - Expression Debugger 21 | - Native/JS runtimes 22 | - Web framework 23 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/env.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.env 2 | (:require [simple-stackless-lisp.util :refer [throw+]])) 3 | 4 | (defn lookup 5 | [env symbol] 6 | (cond 7 | (contains? @env symbol) 8 | (get @env symbol) 9 | 10 | (::parent @env) 11 | (recur (::parent @env) symbol) 12 | 13 | :else 14 | (throw+ "Symbol " symbol " is unbound!"))) 15 | 16 | (defn top-level 17 | [env] 18 | (if (::parent @env) 19 | (recur (::parent @env)) 20 | env)) 21 | 22 | (defn extend! 23 | [env mapping] 24 | (atom (assoc mapping ::parent env))) 25 | 26 | (defn bind! 27 | [env sym val] 28 | (swap! env assoc sym val) 29 | nil) 30 | 31 | (defn fresh-env 32 | ([] 33 | (fresh-env {})) 34 | ([initial-bindings] 35 | (extend! nil initial-bindings))) 36 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/reader.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.reader 2 | (:refer-clojure :exclude [read-string]) 3 | (:require [clojure.edn :as edn] 4 | [simple-stackless-lisp.types :as t] 5 | [simple-stackless-lisp.util :refer [with-retry]])) 6 | 7 | (defn read-string 8 | "Returns AST from given code string." 9 | [^String s] 10 | (edn/read-string 11 | {:readers {'char (fn [^String ch-str] 12 | (t/char (.codePointAt ch-str 0) false))}} 13 | s)) 14 | 15 | (defn read-exp 16 | "Reads a multi-line edn expression from stdin." 17 | [] 18 | (with-retry [text (read-line)] 19 | (read-string text) 20 | (catch RuntimeException e 21 | (if (= "EOF while reading" 22 | (.getMessage e)) 23 | (retry (str text (read-line))) 24 | (throw e))))) 25 | -------------------------------------------------------------------------------- /examples/polymorphism.sclj: -------------------------------------------------------------------------------- 1 | ;; implement method `apply` 2 | ;; for collection types 3 | ;; so they are functions 4 | ;; of their keys 5 | 6 | (multi-method apply String 7 | (fn [s args] 8 | (let [idx (vector-get args 0)] 9 | (string-get s idx)))) 10 | 11 | (multi-method apply Vector 12 | (fn [v args] 13 | (let [idx (vector-get args 0)] 14 | (vector-get v idx)))) 15 | 16 | (multi-method apply HashMap 17 | (fn [m args] 18 | (let [key (vector-get args 0)] 19 | (hash-map-get m key)))) 20 | 21 | (def s "hello") 22 | (println "string " s 23 | " has " (s 1) 24 | " at idx " 1) 25 | 26 | (def v (vector 10 20 30)) 27 | (println "vector " v 28 | " has " (v 1) 29 | " at idx " 1) 30 | 31 | (def m {:a 1 :b 2}) 32 | (println "map " m 33 | " has " (m :a) 34 | " at key " :a) 35 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject simple-stackless-lisp "0.1.0-SNAPSHOT" 2 | :description "A simple stackless lisp implementation" 3 | :url "http://github.com/divs1210/simple-stackless-lisp" 4 | :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0" 5 | :url "https://www.eclipse.org/legal/epl-2.0/"} 6 | :dependencies [[org.clojure/clojure "1.11.1"]] 7 | :main simple-stackless-lisp.main 8 | :target-path "target/%s" 9 | :profiles {:uberjar {:aot :all 10 | :global-vars {*warn-on-reflection* true}} 11 | :native-image {:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}} 12 | :plugins [[io.taylorwood/lein-native-image "0.3.1"]] 13 | :native-image {:name "sclj" 14 | :opts ["--verbose" 15 | "--no-fallback" 16 | "--report-unsupported-elements-at-runtime" 17 | "--initialize-at-build-time" 18 | "--no-server"]}) 19 | -------------------------------------------------------------------------------- /src/experiments/types.clj: -------------------------------------------------------------------------------- 1 | (ns experiments.types 2 | (:refer-clojure :exclude [get]) 3 | (:require [simple-stackless-lisp.types :as t])) 4 | 5 | ;; Interface 6 | ;; ========= 7 | ;; (defmulti get 8 | ;; (fn [this & _] 9 | ;; (t/type this))) 10 | 11 | ;; (defmulti slice 12 | ;; (fn [this & _] 13 | ;; (t/type this))) 14 | 15 | ;; (defmulti put! 16 | ;; (fn [this & _] 17 | ;; (t/type this))) 18 | 19 | 20 | ;; Implementations 21 | ;; =============== 22 | ;; (defmethod get 'Array 23 | ;; [this idx] 24 | ;; (t/array-get this idx)) 25 | 26 | ;; (defmethod slice 'Array 27 | ;; [this from to] 28 | ;; (t/array-slice this from to)) 29 | 30 | ;; (defmethod put! 'Array 31 | ;; [this idx val] 32 | ;; (t/array-put! this idx val)) 33 | 34 | ;; ;; === 35 | 36 | ;; (defmethod get 'ArrayWindow 37 | ;; [this idx] 38 | ;; (t/array-window-get this idx)) 39 | 40 | ;; (defmethod put! 'ArrayWindow 41 | ;; [this idx val] 42 | ;; (t/array-window-put! this idx val)) 43 | 44 | ;; (defmethod slice 'ArrayWindow 45 | ;; [this from to] 46 | ;; (t/array-window-slice this from to)) 47 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/main.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.main 2 | (:gen-class) 3 | (:require 4 | [simple-stackless-lisp.builtins :as b] 5 | [simple-stackless-lisp.core :as core] 6 | [simple-stackless-lisp.env :as env] 7 | [simple-stackless-lisp.multi :as m] 8 | [simple-stackless-lisp.reader :as r] 9 | [simple-stackless-lisp.types :as t] 10 | [simple-stackless-lisp.util :as u])) 11 | 12 | (defn run-file 13 | [filename] 14 | (let [text (str "(do " (slurp filename) ")") 15 | code (r/read-string text)] 16 | (core/eval code))) 17 | 18 | (defn run-repl [] 19 | (println "============================") 20 | (println "|Simple Stackless Lisp REPL|") 21 | (println "============================") 22 | (let [env (env/fresh-env b/builtins) 23 | exe (u/executor)] 24 | (while true 25 | (try 26 | (print "> ") 27 | (flush) 28 | (let [ret (core/eval (r/read-exp) env identity exe)] 29 | (env/bind! env '%1 ret) 30 | (println "=>" 31 | (t/string->java-string 32 | (m/k-to-readable-string identity ret)) 33 | "\n")) 34 | (catch Throwable e 35 | (println "Error: " (.getMessage e)) 36 | (println)))))) 37 | 38 | (defn -main 39 | [& [filename]] 40 | (if filename 41 | (run-file filename) 42 | (run-repl))) 43 | -------------------------------------------------------------------------------- /.github/workflows/clojure.yml: -------------------------------------------------------------------------------- 1 | name: Clojure CI 2 | 3 | on: 4 | pull_request: 5 | branches: [ "main" ] 6 | 7 | jobs: 8 | build: 9 | name: simple-stackless-lisp ${{ matrix.os }} 10 | runs-on: ${{ matrix.os }} 11 | strategy: 12 | matrix: 13 | os: [ubuntu-latest, macos-latest, windows-latest] 14 | steps: 15 | - uses: actions/checkout@v3 16 | 17 | - uses: graalvm/setup-graalvm@v1 18 | with: 19 | version: '22.3.0' 20 | java-version: '17' 21 | components: 'native-image' 22 | github-token: ${{ secrets.GITHUB_TOKEN }} 23 | native-image-job-reports: 'false' 24 | 25 | - name: Install clojure tools 26 | uses: DeLaGuardo/setup-clojure@10.1 27 | with: 28 | lein: 2.9.1 29 | 30 | - name: Install dependencies 31 | run: lein deps 32 | 33 | - name: Compile JAR 34 | run: lein uberjar 35 | 36 | - name: Compile native binary 37 | run: | 38 | lein native-image 39 | mv target/uberjar/*-standalone.jar target/default+native-image/sclj.jar 40 | 41 | - name: Upload binary 42 | uses: actions/upload-artifact@v3 43 | with: 44 | name: sclj-${{ matrix.os }} 45 | path: | 46 | target/default+native-image/sclj 47 | target/default+native-image/sclj.exe 48 | target/default+native-image/sclj.jar 49 | if-no-files-found: warn 50 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # simple-stackless-lisp 2 | 3 | A small but powerful Clojure-like Lisp. 4 | 5 | Has first class continuations and macros. 6 | 7 | Data oriented and [super polymorphic](examples/polymorphism.sclj). 8 | 9 | This is a **Work In Progress**, and there is [more to come](docs/vision.md)! 10 | 11 | **NOTE:** Docs might not always be up to date, since the language is in heavy development. 12 | 13 | ## Example 14 | 15 | ```clojure 16 | ;; examples/fact.sclj 17 | (def fact 18 | (fn [n] 19 | (if (< n 2) 20 | 1 21 | (* n (fact (- n 1)))))) 22 | 23 | (println "(fact 50000) =>") 24 | (println (fact 50000)) 25 | ``` 26 | 27 | More [code examples](examples/) are available. 28 | 29 | There's also a [User Manual](docs/manual.md). 30 | 31 | ## Usage 32 | 33 | ### Download 34 | 35 | You can find pre-compiled executables [here](https://github.com/divs1210/simple-stackless-lisp/releases/latest). 36 | 37 | ### Start a REPL 38 | 39 | ``` 40 | $ ./sclj 41 | ``` 42 | 43 | Use `rlwrap` for a more pleasant REPL experience: 44 | 45 | ``` 46 | $ rlwrap ./sclj 47 | ``` 48 | 49 | ### Run a file 50 | 51 | ``` 52 | $ ./sclj code.sclj 53 | ``` 54 | 55 | ## Build from source 56 | 57 | [The manual](docs/manual.md) contains more info on building and running the interpreter. 58 | 59 | ## Thanks 60 | 61 | [Lisperator's technique](https://lisperator.net/pltut/cps-evaluator/) for building a stackless interpreter led me down this rabbit hole. 62 | 63 | ## License 64 | 65 | Copyright © 2022 Divyansh Prakash 66 | 67 | This program and the accompanying materials are made available under the 68 | terms of the Eclipse Public License 2.0 which is available at 69 | http://www.eclipse.org/legal/epl-2.0. 70 | 71 | This Source Code may also be made available under the following Secondary 72 | Licenses when the conditions for such availability set forth in the Eclipse 73 | Public License, v. 2.0 are satisfied: GNU General Public License as published by 74 | the Free Software Foundation, either version 2 of the License, or (at your 75 | option) any later version, with the GNU Classpath Exception which is available 76 | at https://www.gnu.org/software/classpath/license.html. 77 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/core.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.core 2 | (:refer-clojure :exclude [eval]) 3 | (:require 4 | [simple-stackless-lisp.builtins :as b] 5 | [simple-stackless-lisp.env :as env] 6 | [simple-stackless-lisp.impl :as impl] 7 | [simple-stackless-lisp.util :as u] 8 | [simple-stackless-lisp.types :as t])) 9 | 10 | (defn walk 11 | [this exp env k GUARD] 12 | (GUARD walk [this exp env k GUARD]) 13 | (cond 14 | (or (number? exp) 15 | (keyword? exp)) 16 | (k exp) 17 | 18 | (contains? #{nil true false} exp) 19 | (k exp) 20 | 21 | (string? exp) 22 | (k (t/java-string->string exp)) 23 | 24 | (symbol? exp) 25 | (k (env/lookup env exp)) 26 | 27 | (vector? exp) 28 | (impl/k-read-vector this exp env k GUARD) 29 | 30 | (map? exp) 31 | (impl/k-read-map this exp env k GUARD) 32 | 33 | (seq? exp) 34 | (let [[op & args] exp] 35 | (case op 36 | def 37 | (impl/k-def this args env k GUARD) 38 | 39 | let 40 | (impl/k-let this args env k GUARD) 41 | 42 | if 43 | (impl/k-if this args env k GUARD) 44 | 45 | do 46 | (impl/k-do this args env k GUARD) 47 | 48 | quote 49 | (impl/k-quote this args env k GUARD) 50 | 51 | fn 52 | (impl/k-fn this [args false] env k GUARD) 53 | 54 | macro 55 | (impl/k-fn this [args true] env k GUARD) 56 | 57 | trace! 58 | (impl/k-trace! this args env k GUARD) 59 | 60 | eval 61 | (impl/k-eval this args env k GUARD) 62 | 63 | ;; various applications 64 | (if (and (symbol? op) 65 | (.startsWith (str op) ".")) 66 | ;; dot notation 67 | (impl/k-dot-notation this [op args] env k GUARD) 68 | ;; function / macro call 69 | (impl/k-apply this [op args] env k GUARD)))) 70 | 71 | :else 72 | (u/throw+ "Can't evaluate: " exp))) 73 | 74 | (defn eval 75 | ([exp] 76 | (eval exp (env/fresh-env b/builtins))) 77 | ([exp env] 78 | (eval exp env identity)) 79 | ([exp env k] 80 | (eval exp env k (u/executor))) 81 | ([exp env k exe] 82 | (let [{:keys [guard execute]} exe] 83 | (execute walk [walk exp env k guard])))) 84 | -------------------------------------------------------------------------------- /docs/manual.md: -------------------------------------------------------------------------------- 1 | # Simple Stackless Lisp User's Manual 2 | 3 | This language is a **Work In Progress**. 4 | 5 | Feel free to play around with it, though! 6 | 7 | ## Language Spec 8 | 9 | ### Types 10 | 11 | - Nil: `nil` 12 | - Arbitrary precision numbers: `1`, `0.0004`, `2334234.3423443` 13 | - Booleans: `true`, `false` 14 | - Strings: `"Hello, world!"` 15 | - Symbols: `x`, `is-it-even?` 16 | - Lists: `(list 1 2 3)` 17 | - Functions: `(fn [x] (+ x 1))` 18 | 19 | ### Special forms 20 | 21 | #### def 22 | 23 | Binds a symbol to a value in the top-level (global) environment. 24 | 25 | ```clojure 26 | (def a 1) 27 | 28 | (def b 2) 29 | 30 | (def c (+ a b)) 31 | 32 | c ;; => 3 33 | ``` 34 | 35 | #### let 36 | 37 | Lexically scoped local bindings. 38 | 39 | ```clojure 40 | (let [a 1 41 | b 2 42 | c (+ a b)] 43 | c) ;; => 3 44 | ``` 45 | 46 | #### if 47 | 48 | ```clojure 49 | (if (< 1 2) 50 | "a" 51 | "b") ;; => "a" 52 | ``` 53 | 54 | #### do 55 | 56 | ```clojure 57 | (do 58 | (println "a") 59 | (println "b") 60 | "c") ;; => "c" 61 | ;; a 62 | ;; b 63 | ``` 64 | 65 | #### quote 66 | 67 | Returns its argument unevaluated. 68 | 69 | ```clojure 70 | (quote undefined-symbol) ;; => undefined-symbol 71 | (quote (1 2 a "d" (+ 2 4))) ;; => (1 2 a "d" (+ 2 4)) 72 | ``` 73 | 74 | #### fn 75 | 76 | ```clojure 77 | (def add 78 | (fn [a b] 79 | (+ a b))) 80 | 81 | (add 1 2) ;; => 3 82 | ``` 83 | 84 | #### macro 85 | 86 | CL-like unhygeinic macros for now. 87 | 88 | ```clojure 89 | (def dbg 90 | (macro [exp] 91 | (let [exp# (gensym)] 92 | (quote 93 | (let [(unquote exp#) (unquote exp)] 94 | (do 95 | (println (quote (unquote exp)) "=>" (unquote exp#)) 96 | (unquote exp#))))))) 97 | 98 | (* 2 (dbg (+ 1 2))) ;; => 6 99 | ;; (+ 1 2) => 3 100 | ``` 101 | 102 | #### eval 103 | 104 | ```clojure 105 | (def a 1) 106 | 107 | (let [b 2 108 | code (quote (+ a b))] 109 | (eval code)) ;; => 3 110 | ``` 111 | 112 | ### Functions 113 | 114 | #### Sequences 115 | `list`, `first`, `rest`, `seq` ,`cons` 116 | 117 | #### IO 118 | `print`, `println` 119 | 120 | #### Math 121 | `=`, `<`, `>`, `<=`, `>=`, `+`, `-`, `*`, `/` 122 | 123 | #### Misc 124 | `gensym`, `apply`, `call-cc` 125 | 126 | ## Usage 127 | 128 | ### I. Download 129 | 130 | You can find pre-compiled executables [here](https://github.com/divs1210/simple-stackless-lisp/releases/latest). 131 | 132 | ##### Start a REPL 133 | 134 | ``` 135 | $ ./sclj 136 | ``` 137 | 138 | or 139 | 140 | ``` 141 | $ java -jar sclj.jar 142 | ``` 143 | 144 | **NOTE:** Running a REPL with `rlwrap` will lead to a much more pleasant experience: 145 | 146 | ``` 147 | $ rlwrap ./sclj 148 | ``` 149 | 150 | ##### Run a file 151 | 152 | ``` 153 | $ ./sclj code.sclj 154 | ``` 155 | 156 | or 157 | 158 | ``` 159 | $ java -jar sclj.jar code.sclj 160 | ``` 161 | 162 | ### II. Build from source 163 | 164 | #### Clone this project 165 | 166 | ``` 167 | $ git clone https://github.com/divs1210/simple-stackless-lisp.git 168 | 169 | $ cd simple-stackless-lisp 170 | ``` 171 | 172 | #### Build a JAR 173 | 174 | Requires Java and Leiningen to be installed. 175 | 176 | ``` 177 | $ lein uberjar 178 | ``` 179 | 180 | #### Build a native executable 181 | 182 | Requires GraalVM and its native-image tool to be installed. 183 | 184 | ``` 185 | $ lein native-image 186 | ``` 187 | 188 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/util.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.util 2 | (:require [clojure.edn :as edn] 3 | [clojure.string :as str] 4 | [clojure.walk :as walk]) 5 | (:import clojure.lang.ExceptionInfo)) 6 | 7 | (defrecord Retry [bindings]) 8 | 9 | (defmacro with-retry 10 | "It's really inconvenient not being able to recur from within (catch) 11 | expressions. This macro wraps its body in a (loop [bindings] (try ...)). 12 | Provides a (retry & new bindings) form which is usable within (catch) blocks. 13 | When this form is returned by the body, the body will be retried with the new 14 | bindings. 15 | 16 | Taken from: https://gist.github.com/aphyr/a81825ab80656679db78" 17 | [initial-bindings & body] 18 | (assert (vector? initial-bindings)) 19 | (assert (even? (count initial-bindings))) 20 | (let [bindings-count (/ (count initial-bindings) 2) 21 | body (walk/prewalk (fn [form] 22 | (if (and (list? form) 23 | (= 'retry (first form))) 24 | (do (assert (= bindings-count 25 | (count (rest form)))) 26 | `(Retry. [~@(rest form)])) 27 | form)) 28 | body) 29 | retval (gensym 'retval)] 30 | `(loop [~@initial-bindings] 31 | (let [~retval (try ~@body)] 32 | (if (instance? Retry ~retval) 33 | (recur ~@(->> (range bindings-count) 34 | (map (fn [i] `(nth (:bindings ~retval) ~i))))) 35 | ~retval))))) 36 | 37 | (defn- make-guard 38 | [guard-state f args] 39 | (swap! guard-state update :stack-depth inc) 40 | (when (= (:stack-depth @guard-state) 41 | (:max-stack-depth @guard-state)) 42 | (throw (ex-info "" {:type ::max-stack-depth-reached 43 | :f f 44 | :args args})))) 45 | 46 | (defn- make-execute 47 | [guard-state f args] 48 | (with-retry [f f 49 | args args] 50 | (apply f args) 51 | (catch ExceptionInfo e 52 | (let [{:keys [type f args]} (ex-data e)] 53 | (if (= ::max-stack-depth-reached type) 54 | (do 55 | (swap! guard-state assoc :stack-depth 0) 56 | (retry f args)) 57 | (throw e)))))) 58 | 59 | (defn executor 60 | [& {:keys [max-stack-depth] 61 | :or {max-stack-depth 200}}] 62 | (let [guard-state (atom {:stack-depth 0 63 | :max-stack-depth max-stack-depth})] 64 | {:guard (partial make-guard guard-state) 65 | :execute (partial make-execute guard-state)})) 66 | 67 | (defn throw+ 68 | "Throws a generic error with the given message." 69 | [& strs] 70 | (throw (Exception. (str/join strs)))) 71 | 72 | (defn ->cps 73 | "Converts function to Continuation Passing Style. 74 | This code: 75 | ((->cps inc) println 1) 76 | prints 2." 77 | [f] 78 | (fn [k & args] 79 | (k (apply f args)))) 80 | 81 | (defn k-reduce 82 | "A stackless reduce implementation. 83 | `f` will be called like: 84 | (f acc x k GUARD)" 85 | [f acc xs k GUARD] 86 | (if-let [[x & remaining] (seq xs)] 87 | (letfn [(with-new-acc [new-acc] 88 | (GUARD with-new-acc [new-acc]) 89 | (k-reduce f new-acc remaining k GUARD))] 90 | (f acc x with-new-acc GUARD)) 91 | (k acc))) 92 | 93 | (defn k-map 94 | "A stackless map implementation. 95 | Built on top of `k-reduce`." 96 | [f xs k GUARD] 97 | (k-reduce (fn CC [acc x then GUARD] 98 | (GUARD CC [acc x then GUARD]) 99 | (f x 100 | (fn CC [fx] 101 | (GUARD CC [fx]) 102 | (then (conj acc fx))) 103 | GUARD)) 104 | [] 105 | xs 106 | k 107 | GUARD)) 108 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/builtins.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.builtins 2 | (:refer-clojure :exclude [print println]) 3 | (:require 4 | [simple-stackless-lisp.multi :as m] 5 | [simple-stackless-lisp.types :as t] 6 | [simple-stackless-lisp.util :refer [->cps]] 7 | [clojure.core :as core])) 8 | 9 | (defn print 10 | [& objs] 11 | (let [unicode-strs (map #(m/k-to-string identity %) objs) 12 | joined-str (t/string-join (t/string []) unicode-strs) 13 | java-str (t/string->java-string joined-str)] 14 | (core/print java-str) 15 | (flush))) 16 | 17 | (defn println 18 | [& objs] 19 | (apply print objs) 20 | (core/println)) 21 | 22 | (def builtins 23 | {;; Types 24 | ;; ===== 25 | 'type (->cps t/type) 26 | 'instance? (->cps t/instance?) 27 | 28 | ;; Bootstrapped Functions 29 | ;; ====================== 30 | 'apply m/k-apply 31 | 32 | ;; MultiMethods 33 | ;; ============ 34 | 'multi m/k-multi 35 | 'multi-name (->cps m/multi-name) 36 | 'multi-method m/k-multi-method 37 | 'multi-methods (->cps m/multi-methods) 38 | 'multi-get (->cps m/multi-get) 39 | 40 | ;; Primitives 41 | ;; ========== 42 | 'Nil 'Nil 43 | 'Boolean 'Boolean 44 | 'Number 'Number 45 | 'Symbol 'Symbol 46 | 'Keyword 'Keyword 47 | 'Fn 'Fn 48 | 49 | 'MultiMethod 'MultiMethod 50 | 'MethodNotFoundError 'MethodNotFoundError 51 | 52 | ;; Characters 53 | ;; ========== 54 | 'Character 'Character 55 | 'char (->cps t/char) 56 | 'char-nbsp? (->cps t/char-non-breaking-whitespace?) 57 | 'char-bsp? (->cps t/char-breaking-whitespace?) 58 | 'char-space? (->cps t/char-whitespace?) 59 | 'char-upcase (->cps t/char-upcase) 60 | 'char-downcase (->cps t/char-downcase) 61 | 62 | ;; Strings 63 | ;; ======= 64 | 'String 'String 65 | 'string (->cps t/string) 66 | 'string-size (->cps t/string-size) 67 | 'string-get (->cps t/string-get) 68 | 'string-put (->cps t/string-put) 69 | 'string-slice (->cps t/string-slice) 70 | 'string-concat (->cps t/string-concat) 71 | 'string-join (->cps t/string-join) 72 | 'string-blank? (->cps t/string-blank?) 73 | '->str m/k-to-string 74 | '->rstr m/k-to-readable-string 75 | 76 | ;; Vectors 77 | ;; ======= 78 | 'Vector 'Vector 79 | 'vector (->cps vector) 80 | 'vector-size (->cps t/vector-size) 81 | 'vector-get (->cps t/vector-get) 82 | 'vector-put (->cps t/vector-put) 83 | 'vector-slice (->cps t/vector-slice) 84 | 'vector-concat (->cps t/vector-concat) 85 | 86 | ;; Hashmaps 87 | ;; ======== 88 | 'HashMap 'HashMap 89 | 'hash-map (->cps hash-map) 90 | 'hash-map-size (->cps t/hash-map-size) 91 | 'hash-map-get (->cps t/hash-map-get) 92 | 'hash-map-put (->cps t/hash-map-put) 93 | 'hash-map-select (->cps t/hash-map-select) 94 | 'hash-map-merge (->cps t/hash-map-merge) 95 | 'hash-map-keys (->cps t/hash-map-keys) 96 | 'hash-map-contains? (->cps t/hash-map-contains?) 97 | 98 | ;; Atoms 99 | ;; ===== 100 | 'Atom 'Atom 101 | 'atom (->cps atom) 102 | 'atom-deref (->cps t/atom-deref) 103 | 'atom-set! (->cps t/atom-set!) 104 | 'atom-cas! (->cps t/atom-cas!) 105 | 'atom-swap! t/k-atom-swap! 106 | 107 | ;; I/O 108 | ;; === 109 | 'print (->cps print) 110 | 'println (->cps println) 111 | 112 | ;; Misc 113 | ;; ==== 114 | 'identical? (->cps identical?) 115 | 'gensym (->cps gensym) 116 | 117 | 'call-cc 118 | (fn [k f] 119 | (f k (fn CC [_ ret] 120 | (k ret)))) 121 | 122 | 'throw! 123 | (fn [k m] 124 | (throw (ex-info (:msg m) m)) 125 | (k nil)) 126 | 127 | ;; Logic 128 | ;; ===== 129 | '= (->cps =) 130 | '< (->cps <) 131 | '> (->cps >) 132 | '<= (->cps <=) 133 | '>= (->cps >=) 134 | 135 | ;; Math 136 | ;; ==== 137 | '+ (->cps +') 138 | '- (->cps -) 139 | '* (->cps *') 140 | '/ (->cps /)}) 141 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/impl.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.impl 2 | (:require 3 | [clojure.string :as str] 4 | [clojure.walk :refer [postwalk]] 5 | [simple-stackless-lisp.env :as env] 6 | [simple-stackless-lisp.multi :as m] 7 | [simple-stackless-lisp.util :as u] 8 | [simple-stackless-lisp.types :as t])) 9 | 10 | (defn k-def 11 | [walk args env k GUARD] 12 | (let [[sym val-exp] args] 13 | (walk walk 14 | val-exp 15 | env 16 | (fn CC [val] 17 | (GUARD CC [val]) 18 | (k (env/bind! (env/top-level env) sym val))) 19 | GUARD))) 20 | 21 | (defn k-let 22 | [walk args env k GUARD] 23 | (let [[bindings body] args] 24 | (if (empty? bindings) 25 | (walk walk body env k GUARD) 26 | (let [[var val-exp & remaining] bindings 27 | env (env/extend! env {}) 28 | then (fn CC [val] 29 | (GUARD CC [val]) 30 | (env/bind! env var val) 31 | (k-let walk [remaining body] env k GUARD))] 32 | (walk walk val-exp env then GUARD))))) 33 | 34 | (defn k-if 35 | [walk args env k GUARD] 36 | (let [[test-exp then-exp else-exp] args] 37 | (walk walk 38 | test-exp 39 | env 40 | (fn CC [test-val] 41 | (GUARD CC [test-val]) 42 | (walk walk 43 | (if test-val then-exp else-exp) 44 | env 45 | k 46 | GUARD)) 47 | GUARD))) 48 | 49 | (defn k-do 50 | [walk exps env k GUARD] 51 | (u/k-reduce (fn CC [_ exp then GUARD] 52 | (GUARD CC [nil exp then GUARD]) 53 | (walk walk exp env then GUARD)) 54 | nil 55 | exps 56 | k 57 | GUARD)) 58 | 59 | (defn k-quote 60 | "TODO: implement and use stackless postwalk" 61 | [walk [exp] env k GUARD] 62 | (k (postwalk (fn [node] 63 | (if (seq? node) 64 | (let [[op arg] node] 65 | (if (= 'unquote op) 66 | (walk walk arg env identity GUARD) 67 | node)) 68 | node)) 69 | exp))) 70 | 71 | (defn k-fn 72 | [walk [[argv body-exp] macro?] env k GUARD] 73 | (k ^{::macro? macro?} 74 | (fn CC [k & args] 75 | (GUARD CC (cons k args)) 76 | (let [params (zipmap argv args) 77 | params (assoc params '%args (vec args)) 78 | fn-env (env/extend! env params)] 79 | (walk walk body-exp fn-env k GUARD))))) 80 | 81 | (defn k-trace! 82 | [walk [code-exp] env k GUARD] 83 | (let [top-level-env (env/top-level env)] 84 | (when (not (::stack-depth @top-level-env)) 85 | (env/bind! top-level-env ::stack-depth (atom 0))) 86 | (letfn [(tracing-walk [_ t-exp _ t-k _] 87 | (let [stack-depth (::stack-depth @top-level-env)] 88 | (GUARD tracing-walk [tracing-walk t-exp env t-k GUARD]) 89 | (print (str/join (repeat @stack-depth "│"))) 90 | (prn t-exp) 91 | (swap! stack-depth inc) 92 | (walk tracing-walk 93 | t-exp 94 | env 95 | (fn t-k+ [ret] 96 | (GUARD t-k+ [ret]) 97 | (swap! stack-depth dec) 98 | (print (str/join (repeat @stack-depth "│"))) 99 | (print "└>") 100 | (println 101 | (t/string->java-string 102 | (m/k-to-readable-string identity ret))) 103 | (t-k ret)) 104 | GUARD)))] 105 | (tracing-walk tracing-walk code-exp env k GUARD)))) 106 | 107 | (defn k-eval 108 | [walk [code-exp] env k GUARD] 109 | (letfn [(with-code [code] 110 | (GUARD with-code [code]) 111 | (walk walk code env k GUARD))] 112 | (walk walk code-exp env with-code GUARD))) 113 | 114 | (defn k-dot-notation 115 | [walk [op args] env k GUARD] 116 | (let [obj-exp (first args) 117 | key-name (-> op str (.substring 1) symbol) 118 | new-exp (case key-name 119 | __keys__ (list 'hash-map-keys obj-exp) 120 | __has-key?__ (list 'hash-map-contains? obj-exp (second args)) 121 | ;; else 122 | (list 'hash-map-get 123 | obj-exp 124 | (keyword key-name) 125 | nil))] 126 | (walk walk new-exp env k GUARD))) 127 | 128 | (defn- k-apply-fn 129 | [walk [f arg-exps] env k GUARD] 130 | (letfn [(with-args [args] 131 | (GUARD with-args [args]) 132 | (m/k-apply k f args))] 133 | (u/k-map (fn CC [x-exp with-x GUARD] 134 | (GUARD CC [x-exp with-x GUARD]) 135 | (walk walk x-exp env with-x GUARD)) 136 | arg-exps 137 | with-args 138 | GUARD))) 139 | 140 | (defn- k-apply-macro 141 | [walk [m arg-exps] env k GUARD] 142 | (letfn [(with-new-exp [new-exp] 143 | (GUARD with-new-exp [new-exp]) 144 | (walk walk new-exp env k GUARD))] 145 | (apply m (cons with-new-exp arg-exps)))) 146 | 147 | (defn k-apply 148 | [walk [f-exp arg-exps] env k GUARD] 149 | (letfn [(with-f [f] 150 | (GUARD with-f [f]) 151 | (let [apply-fn (if (::macro? (meta f)) 152 | k-apply-macro 153 | k-apply-fn)] 154 | (apply-fn walk [f arg-exps] env k GUARD)))] 155 | (walk walk f-exp env with-f GUARD))) 156 | 157 | 158 | ;; Reader 159 | ;; ====== 160 | (defn k-read-vector 161 | [walk vlit env k GUARD] 162 | (letfn [(with-xs [xs] 163 | (GUARD with-xs [xs]) 164 | (k (vec xs)))] 165 | (u/k-map (fn CC [x-exp with-x GUARD] 166 | (GUARD CC [x-exp with-x GUARD]) 167 | (walk walk x-exp env with-x GUARD)) 168 | vlit 169 | with-xs 170 | GUARD))) 171 | 172 | (defn k-read-map 173 | [walk mlit env k GUARD] 174 | (letfn [(with-entries [entries] 175 | (GUARD with-entries [entries]) 176 | (k (into {} entries)))] 177 | (u/k-map (fn CC [kv with-kv GUARD] 178 | (GUARD CC [kv with-kv GUARD]) 179 | (k-read-vector walk kv env with-kv GUARD)) 180 | mlit 181 | with-entries 182 | GUARD))) 183 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/multi.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.multi 2 | (:refer-clojure :exclude [methods get-method]) 3 | (:require [clojure.core :as core] 4 | [simple-stackless-lisp.types :as t])) 5 | 6 | (declare k-apply k-to-readable-string) 7 | 8 | (defn- make-k-default-method 9 | [name k-args->dispatch-val] 10 | (fn [k & args] 11 | (let [dv (k-apply identity k-args->dispatch-val args) 12 | msg (str "No implementation of method: " 13 | (t/string->java-string name) 14 | " found for dispatch-val: " 15 | (t/string->java-string 16 | (k-to-readable-string identity dv)))] 17 | (throw (ex-info 18 | msg 19 | {:type 'MethodNotFoundError 20 | :multi name 21 | :dispatch-val dv 22 | :msg msg})) 23 | (k nil)))) 24 | 25 | (def k-apply 26 | (let [name 27 | (t/java-string->string "apply") 28 | 29 | k-args->dispatch-val 30 | (fn [k & args] 31 | (k (t/type (first args)))) 32 | 33 | implementations 34 | (atom {}) 35 | 36 | dispatch 37 | (with-meta 38 | (fn [with-result & args] 39 | (let [dispatch-val (core/apply k-args->dispatch-val (cons identity args)) 40 | k-impl (or (get @implementations dispatch-val) 41 | (get @implementations :MultiMethod/default))] 42 | (core/apply k-impl with-result args))) 43 | {:multimethod? true 44 | :name name 45 | :implementations implementations})] 46 | (swap! implementations assoc 47 | :MultiMethod/default (make-k-default-method name k-args->dispatch-val)) 48 | (swap! implementations assoc 49 | 'Fn (fn [k f args] 50 | (core/apply f (cons k args)))) 51 | (swap! implementations assoc 52 | 'MultiMethod (fn [k f args] 53 | (core/apply f (cons k args)))) 54 | dispatch)) 55 | 56 | (defn k-multi 57 | [k name k-args->dispatch-val] 58 | (let [implementations 59 | (atom {}) 60 | 61 | dispatch 62 | (with-meta 63 | (fn [with-result & args] 64 | (let [dispatch-val (k-apply identity k-args->dispatch-val args) 65 | k-impl (or (get @implementations dispatch-val) 66 | (get @implementations :MultiMethod/default))] 67 | (k-apply with-result k-impl args))) 68 | {:multimethod? true 69 | :name name 70 | :implementations implementations})] 71 | (swap! implementations assoc 72 | :MultiMethod/default (make-k-default-method name k-args->dispatch-val)) 73 | (k dispatch))) 74 | 75 | (defn k-multi-method 76 | [k multi dispatch-val k-impl] 77 | (let [multi-record (meta multi) 78 | impls (:implementations multi-record)] 79 | (swap! impls assoc dispatch-val k-impl) 80 | (k nil))) 81 | 82 | (defn- multi-info 83 | [multi] 84 | (some-> multi 85 | meta 86 | (dissoc :multimethod?) 87 | (update :implementations deref))) 88 | 89 | (defn multi-name 90 | [multi] 91 | (-> multi multi-info :name)) 92 | 93 | (defn multi-methods 94 | [multi] 95 | (-> multi multi-info :implementations)) 96 | 97 | (defn multi-get 98 | [multi dispatch-val] 99 | (let [impls (multi-methods multi) 100 | default-impl (:MultiMethod/default impls)] 101 | (get impls dispatch-val default-impl))) 102 | 103 | 104 | ;; Primitive multimethods 105 | ;; ====================== 106 | (def k-to-string 107 | (k-multi 108 | identity (t/java-string->string "->str") 109 | (fn [k obj] 110 | (k (t/type obj))))) 111 | 112 | (def k-to-readable-string 113 | (k-multi 114 | identity (t/java-string->string "->rstr") 115 | (fn [k obj] 116 | (k (t/type obj))))) 117 | 118 | (defn primitive->string 119 | [obj] 120 | (t/java-string->string (str obj))) 121 | 122 | (defn hash-map->readable-string 123 | [m] 124 | (let [item-strs (map (fn [[k v]] 125 | (t/string-join (t/java-string->string " ") 126 | [(k-to-readable-string identity k) 127 | (k-to-readable-string identity v)])) 128 | m) 129 | items-str (t/string-join (t/java-string->string ", ") 130 | item-strs)] 131 | (t/string-join (t/string []) 132 | [(t/java-string->string "{") 133 | items-str 134 | (t/java-string->string "}")]))) 135 | 136 | (k-multi-method 137 | identity k-to-string :MultiMethod/default 138 | (fn [k obj] 139 | (k (hash-map->readable-string obj)))) 140 | 141 | (k-multi-method 142 | identity k-to-readable-string :MultiMethod/default 143 | (fn [k obj] 144 | (k-to-string k obj))) 145 | 146 | (k-multi-method 147 | identity k-to-string 'Nil 148 | (fn [k n] 149 | (k (t/java-string->string "nil")))) 150 | 151 | (k-multi-method 152 | identity k-to-string 'Number 153 | (fn [k n] 154 | (k (primitive->string n)))) 155 | 156 | (k-multi-method 157 | identity k-to-string 'Boolean 158 | (fn [k b] 159 | (k (primitive->string b)))) 160 | 161 | (k-multi-method 162 | identity k-to-string 'Symbol 163 | (fn [k s] 164 | (k (primitive->string s)))) 165 | 166 | (k-multi-method 167 | identity k-to-string 'Keyword 168 | (fn [k kw] 169 | (k (primitive->string kw)))) 170 | 171 | (k-multi-method 172 | identity k-to-string 'Character 173 | (fn [k c] 174 | (k (t/string [c])))) 175 | 176 | (k-multi-method 177 | identity k-to-string 'String 178 | (fn [k s] 179 | (k s))) 180 | 181 | (k-multi-method 182 | identity k-to-string 'Fn 183 | (fn [k f] 184 | (k (t/java-string->string "#Fn")))) 185 | 186 | (k-multi-method 187 | identity k-to-string 'MultiMethod 188 | (fn [k m] 189 | (k (t/string-join (t/string []) 190 | [(t/java-string->string "#MultiMethod[") 191 | (k-to-readable-string identity (multi-name m)) 192 | (t/java-string->string "]")])))) 193 | 194 | (k-multi-method 195 | identity k-to-string 'Vector 196 | (fn [k v] 197 | (let [item-strs (map #(k-to-readable-string identity %) v) 198 | items-str (t/string-join (t/java-string->string ", ") 199 | item-strs)] 200 | (k (t/string-join (t/string []) 201 | [(t/java-string->string "[") 202 | items-str 203 | (t/java-string->string "]")]))))) 204 | 205 | (k-multi-method 206 | identity k-to-string 'HashMap 207 | (fn [k m] 208 | (k (hash-map->readable-string m)))) 209 | 210 | (k-multi-method 211 | identity k-to-string 'Atom 212 | (fn [k a] 213 | (k (t/string-join (t/string []) 214 | [(t/java-string->string "#Atom[") 215 | (k-to-readable-string identity @a) 216 | (t/java-string->string "]")])))) 217 | 218 | (k-multi-method 219 | identity k-to-readable-string 'Character 220 | (fn [k c] 221 | (k (t/string-join (t/string []) 222 | [(t/java-string->string "#char \"") 223 | (t/string-escape (k-to-string identity c)) 224 | (t/java-string->string "\"")])))) 225 | 226 | (k-multi-method 227 | identity k-to-readable-string 'String 228 | (fn [k s] 229 | (k (t/string-join (t/string []) 230 | [(t/java-string->string "\"") 231 | (t/string-escape s) 232 | (t/java-string->string "\"")])))) 233 | -------------------------------------------------------------------------------- /src/simple_stackless_lisp/types.clj: -------------------------------------------------------------------------------- 1 | (ns simple-stackless-lisp.types 2 | (:refer-clojure :exclude [char type instance?]) 3 | (:require 4 | [clojure.core :as core] 5 | [clojure.string :as str] 6 | [simple-stackless-lisp.util :as u]) 7 | (:import 8 | (clojure.lang Atom IPersistentMap PersistentVector))) 9 | 10 | ;; Types 11 | ;; ===== 12 | (defn atom? [obj] 13 | (core/instance? Atom obj)) 14 | 15 | (defn typed-map? [obj] 16 | (and (map? obj) 17 | (contains? obj :type))) 18 | 19 | (defn multimethod? [obj] 20 | (and (fn? obj) 21 | (:multimethod? (meta obj)))) 22 | 23 | (defn type [obj] 24 | (cond 25 | (nil? obj) 'Nil 26 | (boolean? obj) 'Boolean 27 | (number? obj) 'Number 28 | (symbol? obj) 'Symbol 29 | (keyword? obj) 'Keyword 30 | (vector? obj) 'Vector 31 | (atom? obj) 'Atom 32 | (multimethod? obj) 'MultiMethod 33 | (fn? obj) 'Fn 34 | (typed-map? obj) (:type obj) 35 | (map? obj) 'HashMap 36 | :else (u/throw+ "Don't know type of: " obj))) 37 | 38 | (defn instance? 39 | [t obj] 40 | (= t (type obj))) 41 | 42 | ;; Array Windows 43 | ;; ============= 44 | ;; (defn array-window 45 | ;; [^Vector array from to] 46 | ;; (locking array 47 | ;; (let [size (.size array)] 48 | ;; (assert (<= from to)) 49 | ;; (assert (<= 0 from (dec size))) 50 | ;; (assert (<= 0 to size))) 51 | ;; {:type 'ArrayWindow 52 | ;; :array array 53 | ;; :from from 54 | ;; :to to})) 55 | 56 | ;; (defn- check-window-overflow 57 | ;; [window min-idx idx max-idx] 58 | ;; (let [{:keys [^Vector array from]} window 59 | ;; size (.size array)] 60 | ;; (assert (<= min-idx idx max-idx) 61 | ;; (str "ArrayWindow overflow!\n" 62 | ;; "array-size: " size "\n" 63 | ;; "window-idx: " (- idx from) "\n" 64 | ;; "array-idx: " idx)))) 65 | 66 | ;; (defn array-window-size 67 | ;; [^IPersistentMap window] 68 | ;; (let [{:keys [from to]} window] 69 | ;; (if (= to from) 70 | ;; 0 71 | ;; (- to from)))) 72 | 73 | ;; (defn array-window-get 74 | ;; [^IPersistentMap window idx] 75 | ;; (let [{:keys [^Vector array from to]} window] 76 | ;; (locking array 77 | ;; (let [size (array-size array) 78 | ;; from' (min from size) 79 | ;; idx' (+ from idx) 80 | ;; to' (min (dec to) (dec size))] 81 | ;; (check-window-overflow window from' idx' to') 82 | ;; (.get array idx'))))) 83 | 84 | ;; (defn array-window-slice 85 | ;; [^IPersistentMap window from to] 86 | ;; (array-window (:array window) 87 | ;; (+ from (:from window)) 88 | ;; (+ to (:from window)))) 89 | 90 | ;; (defn array-window-put! 91 | ;; [^IPersistentMap window idx val] 92 | ;; (let [{:keys [^Vector array from to]} window] 93 | ;; (locking array 94 | ;; (let [size (array-size array) 95 | ;; from' (min from size) 96 | ;; idx' (+ from idx) 97 | ;; to' (min (dec to) (dec size))] 98 | ;; (check-window-overflow window from' idx' to') 99 | ;; (array-put! array idx' val) 100 | ;; window)))) 101 | 102 | 103 | ;; Immutable Vectors 104 | ;; ================= 105 | ;; backed by Clojure's PersistentVectors 106 | (defn vector-size 107 | [^PersistentVector v] 108 | (.size v)) 109 | 110 | (defn vector-get 111 | [^PersistentVector v idx] 112 | (v idx)) 113 | 114 | (defn vector-put 115 | [^PersistentVector v idx val] 116 | (assoc v idx val)) 117 | 118 | (defn vector-slice 119 | [^PersistentVector v from to] 120 | (subvec v from to)) 121 | 122 | (defn vector-concat 123 | [^PersistentVector this ^PersistentVector that] 124 | (into this that)) 125 | 126 | 127 | ;; Immutable Hashmaps 128 | ;; ================== 129 | ;; backed by Clojure's PersistentMaps 130 | (defn hash-map-size 131 | [^IPersistentMap m] 132 | (count m)) 133 | 134 | (defn hash-map-get 135 | ([m key] 136 | (hash-map-get m key nil)) 137 | ([^IPersistentMap m key not-found] 138 | (get m key not-found))) 139 | 140 | (defn hash-map-put 141 | [^IPersistentMap m key val] 142 | (assoc m key val)) 143 | 144 | (defn hash-map-select 145 | [^IPersistentMap m keys] 146 | (select-keys m keys)) 147 | 148 | (defn hash-map-merge 149 | [^IPersistentMap this ^IPersistentMap that] 150 | (merge this that)) 151 | 152 | (defn hash-map-keys 153 | [^IPersistentMap m] 154 | (try 155 | (vec (keys m)) 156 | (catch Throwable _ 157 | ;; Handles cases where .__keys__ 158 | ;; is called on buitin types 159 | ;; like numbers and vectors. 160 | []))) 161 | 162 | (defn hash-map-contains? 163 | [^IPersistentMap m key] 164 | (try 165 | (contains? m key) 166 | (catch Throwable _ 167 | ;; Handles cases where .__has-key?__ 168 | ;; is called on buitin types 169 | ;; like numbers and vectors. 170 | false))) 171 | 172 | 173 | ;; Unicode Code Points 174 | ;; =================== 175 | (defn code-point-valid? 176 | [^Integer i] 177 | (Character/isValidCodePoint i)) 178 | 179 | (defn- code-point-non-breaking-whitespace? 180 | [^Integer cp] 181 | (contains? #{\u00A0 \u2007 \u2060 \u202F} 182 | (core/char cp))) 183 | 184 | (defn- code-point-breaking-whitespace? 185 | [^Integer cp] 186 | (Character/isWhitespace cp)) 187 | 188 | (defn- code-point-whitespace? 189 | [^Integer cp] 190 | (or (code-point-non-breaking-whitespace? cp) 191 | (code-point-breaking-whitespace? cp))) 192 | 193 | (defn- code-point-upcase 194 | [^Integer cp] 195 | (Character/toUpperCase cp)) 196 | 197 | (defn- code-point-downcase 198 | [^Integer cp] 199 | (Character/toLowerCase cp)) 200 | 201 | (defn- code-point->java-string 202 | [^Integer cp] 203 | (Character/toString cp)) 204 | 205 | 206 | ;; Unicode Characters 207 | ;; ================== 208 | (defn char 209 | ([cp] 210 | (char cp true)) 211 | ([^Integer cp check?] 212 | (when check? 213 | (assert (code-point-valid? cp) 214 | (str "Not a Unicode code point: " cp))) 215 | {:type 'Character 216 | :code-point cp})) 217 | 218 | (defn char-non-breaking-whitespace? 219 | [{:keys [^Integer code-point]}] 220 | (code-point-non-breaking-whitespace? code-point)) 221 | 222 | (defn char-breaking-whitespace? 223 | [{:keys [^Integer code-point]}] 224 | (code-point-breaking-whitespace? code-point)) 225 | 226 | (defn char-whitespace? 227 | [{:keys [^Integer code-point]}] 228 | (code-point-whitespace? code-point)) 229 | 230 | (defn char-upcase 231 | [{:keys [^Integer code-point]}] 232 | (char (code-point-upcase code-point))) 233 | 234 | (defn char-downcase 235 | [{:keys [^Integer code-point]}] 236 | (char (code-point-downcase code-point))) 237 | 238 | (defn char->java-string 239 | [{:keys [^Integer code-point]}] 240 | (code-point->java-string code-point)) 241 | 242 | 243 | ;; Immutable Unicode Strings 244 | ;; ========================= 245 | (defn string 246 | [^PersistentVector chars] 247 | {:type 'String 248 | :chars chars}) 249 | 250 | (defn string-size 251 | [{:keys [chars]}] 252 | (vector-size chars)) 253 | 254 | (defn string-get 255 | [{:keys [chars]} idx] 256 | (chars idx)) 257 | 258 | (defn string-put 259 | [{:keys [chars]} idx char] 260 | (string (vector-put chars idx char))) 261 | 262 | (defn string-slice 263 | [{:keys [chars]} from to] 264 | (string (vector-slice chars from to))) 265 | 266 | (defn string-concat 267 | [this that] 268 | (let [this-chars (:chars this) 269 | that-chars (:chars that)] 270 | (string (vector-concat this-chars that-chars)))) 271 | 272 | (defn string-blank? 273 | [{:keys [chars]}] 274 | (every? char-whitespace? chars)) 275 | 276 | (defn string-join 277 | [separator strings] 278 | (loop [acc (string []) 279 | remaining strings] 280 | (if-let [[s & more] (seq remaining)] 281 | (if (seq more) 282 | (recur (-> acc 283 | (string-concat s) 284 | (string-concat separator)) 285 | more) 286 | (string-concat acc s)) 287 | acc))) 288 | 289 | (defn java-string->string 290 | [^String s] 291 | (->> s 292 | (.codePoints) 293 | (.boxed) 294 | (.toList) 295 | (mapv #(char % false)) 296 | (string))) 297 | 298 | (defn string->java-string 299 | [{:keys [chars]}] 300 | (->> chars 301 | (map char->java-string) 302 | (str/join))) 303 | 304 | (defn java-string-escape 305 | [^String s] 306 | (-> s 307 | (.replace "\\", "\\\\") 308 | (.replace "\t", "\\t") 309 | (.replace "\b", "\\b") 310 | (.replace "\n", "\\n") 311 | (.replace "\r", "\\r") 312 | (.replace "\f", "\\f") 313 | (.replace "\"", "\\\""))) 314 | 315 | (defn string-escape 316 | [s] 317 | (-> s 318 | string->java-string 319 | java-string-escape 320 | java-string->string)) 321 | 322 | 323 | ;; Atoms 324 | ;; ===== 325 | ;; backed by Clojure's Atoms 326 | (defn atom-deref 327 | [^Atom a] 328 | @a) 329 | 330 | (defn atom-set! 331 | [^Atom a x] 332 | (reset! a x)) 333 | 334 | (defn atom-cas! 335 | [^Atom a oldval newval] 336 | (compare-and-set! a oldval newval)) 337 | 338 | (defn k-atom-swap! 339 | [k ^Atom a k-f] 340 | (k (swap! a (partial k-f identity)))) 341 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 2.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 4 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION 5 | OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial content 12 | Distributed under this Agreement, and 13 | 14 | b) in the case of each subsequent Contributor: 15 | i) changes to the Program, and 16 | ii) additions to the Program; 17 | where such changes and/or additions to the Program originate from 18 | and are Distributed by that particular Contributor. A Contribution 19 | "originates" from a Contributor if it was added to the Program by 20 | such Contributor itself or anyone acting on such Contributor's behalf. 21 | Contributions do not include changes or additions to the Program that 22 | are not Modified Works. 23 | 24 | "Contributor" means any person or entity that Distributes the Program. 25 | 26 | "Licensed Patents" mean patent claims licensable by a Contributor which 27 | are necessarily infringed by the use or sale of its Contribution alone 28 | or when combined with the Program. 29 | 30 | "Program" means the Contributions Distributed in accordance with this 31 | Agreement. 32 | 33 | "Recipient" means anyone who receives the Program under this Agreement 34 | or any Secondary License (as applicable), including Contributors. 35 | 36 | "Derivative Works" shall mean any work, whether in Source Code or other 37 | form, that is based on (or derived from) the Program and for which the 38 | editorial revisions, annotations, elaborations, or other modifications 39 | represent, as a whole, an original work of authorship. 40 | 41 | "Modified Works" shall mean any work in Source Code or other form that 42 | results from an addition to, deletion from, or modification of the 43 | contents of the Program, including, for purposes of clarity any new file 44 | in Source Code form that contains any contents of the Program. Modified 45 | Works shall not include works that contain only declarations, 46 | interfaces, types, classes, structures, or files of the Program solely 47 | in each case in order to link to, bind by name, or subclass the Program 48 | or Modified Works thereof. 49 | 50 | "Distribute" means the acts of a) distributing or b) making available 51 | in any manner that enables the transfer of a copy. 52 | 53 | "Source Code" means the form of a Program preferred for making 54 | modifications, including but not limited to software source code, 55 | documentation source, and configuration files. 56 | 57 | "Secondary License" means either the GNU General Public License, 58 | Version 2.0, or any later versions of that license, including any 59 | exceptions or additional permissions as identified by the initial 60 | Contributor. 61 | 62 | 2. GRANT OF RIGHTS 63 | 64 | a) Subject to the terms of this Agreement, each Contributor hereby 65 | grants Recipient a non-exclusive, worldwide, royalty-free copyright 66 | license to reproduce, prepare Derivative Works of, publicly display, 67 | publicly perform, Distribute and sublicense the Contribution of such 68 | Contributor, if any, and such Derivative Works. 69 | 70 | b) Subject to the terms of this Agreement, each Contributor hereby 71 | grants Recipient a non-exclusive, worldwide, royalty-free patent 72 | license under Licensed Patents to make, use, sell, offer to sell, 73 | import and otherwise transfer the Contribution of such Contributor, 74 | if any, in Source Code or other form. This patent license shall 75 | apply to the combination of the Contribution and the Program if, at 76 | the time the Contribution is added by the Contributor, such addition 77 | of the Contribution causes such combination to be covered by the 78 | Licensed Patents. The patent license shall not apply to any other 79 | combinations which include the Contribution. No hardware per se is 80 | licensed hereunder. 81 | 82 | c) Recipient understands that although each Contributor grants the 83 | licenses to its Contributions set forth herein, no assurances are 84 | provided by any Contributor that the Program does not infringe the 85 | patent or other intellectual property rights of any other entity. 86 | Each Contributor disclaims any liability to Recipient for claims 87 | brought by any other entity based on infringement of intellectual 88 | property rights or otherwise. As a condition to exercising the 89 | rights and licenses granted hereunder, each Recipient hereby 90 | assumes sole responsibility to secure any other intellectual 91 | property rights needed, if any. For example, if a third party 92 | patent license is required to allow Recipient to Distribute the 93 | Program, it is Recipient's responsibility to acquire that license 94 | before distributing the Program. 95 | 96 | d) Each Contributor represents that to its knowledge it has 97 | sufficient copyright rights in its Contribution, if any, to grant 98 | the copyright license set forth in this Agreement. 99 | 100 | e) Notwithstanding the terms of any Secondary License, no 101 | Contributor makes additional grants to any Recipient (other than 102 | those set forth in this Agreement) as a result of such Recipient's 103 | receipt of the Program under the terms of a Secondary License 104 | (if permitted under the terms of Section 3). 105 | 106 | 3. REQUIREMENTS 107 | 108 | 3.1 If a Contributor Distributes the Program in any form, then: 109 | 110 | a) the Program must also be made available as Source Code, in 111 | accordance with section 3.2, and the Contributor must accompany 112 | the Program with a statement that the Source Code for the Program 113 | is available under this Agreement, and informs Recipients how to 114 | obtain it in a reasonable manner on or through a medium customarily 115 | used for software exchange; and 116 | 117 | b) the Contributor may Distribute the Program under a license 118 | different than this Agreement, provided that such license: 119 | i) effectively disclaims on behalf of all other Contributors all 120 | warranties and conditions, express and implied, including 121 | warranties or conditions of title and non-infringement, and 122 | implied warranties or conditions of merchantability and fitness 123 | for a particular purpose; 124 | 125 | ii) effectively excludes on behalf of all other Contributors all 126 | liability for damages, including direct, indirect, special, 127 | incidental and consequential damages, such as lost profits; 128 | 129 | iii) does not attempt to limit or alter the recipients' rights 130 | in the Source Code under section 3.2; and 131 | 132 | iv) requires any subsequent distribution of the Program by any 133 | party to be under a license that satisfies the requirements 134 | of this section 3. 135 | 136 | 3.2 When the Program is Distributed as Source Code: 137 | 138 | a) it must be made available under this Agreement, or if the 139 | Program (i) is combined with other material in a separate file or 140 | files made available under a Secondary License, and (ii) the initial 141 | Contributor attached to the Source Code the notice described in 142 | Exhibit A of this Agreement, then the Program may be made available 143 | under the terms of such Secondary Licenses, and 144 | 145 | b) a copy of this Agreement must be included with each copy of 146 | the Program. 147 | 148 | 3.3 Contributors may not remove or alter any copyright, patent, 149 | trademark, attribution notices, disclaimers of warranty, or limitations 150 | of liability ("notices") contained within the Program from any copy of 151 | the Program which they Distribute, provided that Contributors may add 152 | their own appropriate notices. 153 | 154 | 4. COMMERCIAL DISTRIBUTION 155 | 156 | Commercial distributors of software may accept certain responsibilities 157 | with respect to end users, business partners and the like. While this 158 | license is intended to facilitate the commercial use of the Program, 159 | the Contributor who includes the Program in a commercial product 160 | offering should do so in a manner which does not create potential 161 | liability for other Contributors. Therefore, if a Contributor includes 162 | the Program in a commercial product offering, such Contributor 163 | ("Commercial Contributor") hereby agrees to defend and indemnify every 164 | other Contributor ("Indemnified Contributor") against any losses, 165 | damages and costs (collectively "Losses") arising from claims, lawsuits 166 | and other legal actions brought by a third party against the Indemnified 167 | Contributor to the extent caused by the acts or omissions of such 168 | Commercial Contributor in connection with its distribution of the Program 169 | in a commercial product offering. The obligations in this section do not 170 | apply to any claims or Losses relating to any actual or alleged 171 | intellectual property infringement. In order to qualify, an Indemnified 172 | Contributor must: a) promptly notify the Commercial Contributor in 173 | writing of such claim, and b) allow the Commercial Contributor to control, 174 | and cooperate with the Commercial Contributor in, the defense and any 175 | related settlement negotiations. The Indemnified Contributor may 176 | participate in any such claim at its own expense. 177 | 178 | For example, a Contributor might include the Program in a commercial 179 | product offering, Product X. That Contributor is then a Commercial 180 | Contributor. If that Commercial Contributor then makes performance 181 | claims, or offers warranties related to Product X, those performance 182 | claims and warranties are such Commercial Contributor's responsibility 183 | alone. Under this section, the Commercial Contributor would have to 184 | defend claims against the other Contributors related to those performance 185 | claims and warranties, and if a court requires any other Contributor to 186 | pay any damages as a result, the Commercial Contributor must pay 187 | those damages. 188 | 189 | 5. NO WARRANTY 190 | 191 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 192 | PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS" 193 | BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 194 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF 195 | TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR 196 | PURPOSE. Each Recipient is solely responsible for determining the 197 | appropriateness of using and distributing the Program and assumes all 198 | risks associated with its exercise of rights under this Agreement, 199 | including but not limited to the risks and costs of program errors, 200 | compliance with applicable laws, damage to or loss of data, programs 201 | or equipment, and unavailability or interruption of operations. 202 | 203 | 6. DISCLAIMER OF LIABILITY 204 | 205 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT 206 | PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS 207 | SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 208 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST 209 | PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 210 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 211 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 212 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE 213 | POSSIBILITY OF SUCH DAMAGES. 214 | 215 | 7. GENERAL 216 | 217 | If any provision of this Agreement is invalid or unenforceable under 218 | applicable law, it shall not affect the validity or enforceability of 219 | the remainder of the terms of this Agreement, and without further 220 | action by the parties hereto, such provision shall be reformed to the 221 | minimum extent necessary to make such provision valid and enforceable. 222 | 223 | If Recipient institutes patent litigation against any entity 224 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 225 | Program itself (excluding combinations of the Program with other software 226 | or hardware) infringes such Recipient's patent(s), then such Recipient's 227 | rights granted under Section 2(b) shall terminate as of the date such 228 | litigation is filed. 229 | 230 | All Recipient's rights under this Agreement shall terminate if it 231 | fails to comply with any of the material terms or conditions of this 232 | Agreement and does not cure such failure in a reasonable period of 233 | time after becoming aware of such noncompliance. If all Recipient's 234 | rights under this Agreement terminate, Recipient agrees to cease use 235 | and distribution of the Program as soon as reasonably practicable. 236 | However, Recipient's obligations under this Agreement and any licenses 237 | granted by Recipient relating to the Program shall continue and survive. 238 | 239 | Everyone is permitted to copy and distribute copies of this Agreement, 240 | but in order to avoid inconsistency the Agreement is copyrighted and 241 | may only be modified in the following manner. The Agreement Steward 242 | reserves the right to publish new versions (including revisions) of 243 | this Agreement from time to time. No one other than the Agreement 244 | Steward has the right to modify this Agreement. The Eclipse Foundation 245 | is the initial Agreement Steward. The Eclipse Foundation may assign the 246 | responsibility to serve as the Agreement Steward to a suitable separate 247 | entity. Each new version of the Agreement will be given a distinguishing 248 | version number. The Program (including Contributions) may always be 249 | Distributed subject to the version of the Agreement under which it was 250 | received. In addition, after a new version of the Agreement is published, 251 | Contributor may elect to Distribute the Program (including its 252 | Contributions) under the new version. 253 | 254 | Except as expressly stated in Sections 2(a) and 2(b) above, Recipient 255 | receives no rights or licenses to the intellectual property of any 256 | Contributor under this Agreement, whether expressly, by implication, 257 | estoppel or otherwise. All rights in the Program not expressly granted 258 | under this Agreement are reserved. Nothing in this Agreement is intended 259 | to be enforceable by any entity that is not a Contributor or Recipient. 260 | No third-party beneficiary rights are created under this Agreement. 261 | 262 | Exhibit A - Form of Secondary Licenses Notice 263 | 264 | "This Source Code may also be made available under the following 265 | Secondary Licenses when the conditions for such availability set forth 266 | in the Eclipse Public License, v. 2.0 are satisfied: {name license(s), 267 | version(s), and exceptions or additional permissions here}." 268 | 269 | Simply including a copy of this Agreement, including this Exhibit A 270 | is not sufficient to license the Source Code under Secondary Licenses. 271 | 272 | If it is not possible or desirable to put the notice in a particular 273 | file, then You may include the notice in a location (such as a LICENSE 274 | file in a relevant directory) where a recipient would be likely to 275 | look for such a notice. 276 | 277 | You may add additional accurate notices of copyright ownership. 278 | --------------------------------------------------------------------------------