Merge remote-tracking branch 'origin/develop' into develop
This commit is contained in:
commit
a87dbfb8fd
23
README.md
23
README.md
|
|
@ -17,6 +17,29 @@ Boots to REPL, but few functions yet available.
|
|||
* [Source code documentation](https://simon-brooke.github.io/beowulf/docs/codox/index.html).
|
||||
* [Test Coverage Report](https://simon-brooke.github.io/beowulf/docs/cloverage/index.html)
|
||||
|
||||
|
||||
### Building and Invoking
|
||||
|
||||
Build with
|
||||
|
||||
lein uberjar
|
||||
|
||||
Invoke with
|
||||
|
||||
java -jar target/uberjar/beowulf-0.2.1-SNAPSHOT-standalone.jar --help
|
||||
|
||||
(Obviously, check your version number)
|
||||
|
||||
Command line arguments as follows:
|
||||
|
||||
```
|
||||
-h, --help Print this message
|
||||
-p PROMPT, --prompt PROMPT Sprecan:: Set the REPL prompt to PROMPT
|
||||
-r INITFILE, --read INITFILE Read Lisp functions from the file INITFILE
|
||||
-s, --strict Strictly interpret the Lisp 1.5 language, without extensions.
|
||||
-t, --trace Trace Lisp evaluation.
|
||||
```
|
||||
|
||||
### Architectural plan
|
||||
|
||||
Not everything documented in this section is yet built. It indicates the
|
||||
|
|
|
|||
11
resources/lisp1.5.lsp
Normal file
11
resources/lisp1.5.lsp
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
;; Test comment
|
||||
(DEFINE
|
||||
(APPEND
|
||||
(LAMBDA
|
||||
(X Y)
|
||||
(COND ((NULL X) Y) (T (CONS (CAR X) (APPEND (CDR X Y)))))))
|
||||
(CONC
|
||||
(LAMBDA
|
||||
(X Y)
|
||||
(COND ((NULL (CDR X)) (RPLACD X Y)) (T (CONC (CDR X) Y)))
|
||||
X)))
|
||||
|
|
@ -10,7 +10,7 @@
|
|||
therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
|
||||
objects."
|
||||
(:require [clojure.string :as s]
|
||||
[clojure.tools.trace :refer :all]
|
||||
[clojure.tools.trace :refer [deftrace]]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -39,7 +39,7 @@
|
|||
`(if (= ~x NIL) T F))
|
||||
|
||||
(defmacro ATOM
|
||||
"Returns `T` if and only is the argument `x` is bound to and atom; else `F`.
|
||||
"Returns `T` if and only if the argument `x` is bound to an atom; else `F`.
|
||||
It is not clear to me from the documentation whether `(ATOM 7)` should return
|
||||
`T` or `F`. I'm going to assume `T`."
|
||||
[x]
|
||||
|
|
@ -52,41 +52,64 @@
|
|||
[x]
|
||||
`(if (or (symbol? ~x) (number? ~x)) T NIL))
|
||||
|
||||
(defmacro NUMBERP
|
||||
"Returns `T` if and only if the argument `x` is bound to an number; else `F`.
|
||||
TODO: check whether floating point numbers, rationals, etc were numbers in Lisp 1.5"
|
||||
[x]
|
||||
`(if (number? ~x) T F))
|
||||
|
||||
(defmacro CONS
|
||||
"Construct a new instance of cons cell with this `car` and `cdr`."
|
||||
[car cdr]
|
||||
`(beowulf.cons_cell.ConsCell. ~car ~cdr))
|
||||
|
||||
(defn CAR
|
||||
"Return the item indicated by the first pointer of a pair. NIL is treated
|
||||
specially: the CAR of NIL is NIL."
|
||||
[x]
|
||||
(cond
|
||||
(= x NIL) NIL
|
||||
(instance? beowulf.cons_cell.ConsCell x) (.first x)
|
||||
:else
|
||||
(throw
|
||||
(Exception.
|
||||
(str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")")))))
|
||||
(if
|
||||
(= x NIL) NIL
|
||||
(try
|
||||
(.getCar x)
|
||||
(catch Exception any
|
||||
(throw (Exception.
|
||||
(str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")") any))))))
|
||||
|
||||
(defn CDR
|
||||
"Return the item indicated by the second pointer of a pair. NIL is treated
|
||||
specially: the CDR of NIL is NIL."
|
||||
[x]
|
||||
(cond
|
||||
(= x NIL) NIL
|
||||
(instance? beowulf.cons_cell.ConsCell x) (.getCdr x)
|
||||
:else
|
||||
(throw
|
||||
(Exception.
|
||||
(str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")")))))
|
||||
(if
|
||||
(= x NIL) NIL
|
||||
(try
|
||||
(.getCdr x)
|
||||
(catch Exception any
|
||||
(throw (Exception.
|
||||
(str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")") any))))))
|
||||
|
||||
(defn uaf
|
||||
"Universal access function; `l` is expected to be an arbitrary list, `path`
|
||||
"Universal access function; `l` is expected to be an arbitrary LISP list, `path`
|
||||
a (clojure) list of the characters `a` and `d`. Intended to make declaring
|
||||
all those fiddly `#'c[ad]+r'` functions a bit easier"
|
||||
[l path]
|
||||
(cond
|
||||
(= l NIL) NIL
|
||||
(empty? path) l
|
||||
:else (case (last path)
|
||||
\a (uaf (.first l) (butlast path))
|
||||
\d (uaf (.getCdr l) (butlast path)))))
|
||||
:else
|
||||
(try
|
||||
(case (last path)
|
||||
\a (uaf (.first l) (butlast path))
|
||||
\d (uaf (.getCdr l) (butlast path))
|
||||
(throw (ex-info (str "uaf: unexpected letter in path (only `a` and `d` permitted): " (last path))
|
||||
{:cause :uaf
|
||||
:detail :unexpected-letter
|
||||
:expr (last path)})))
|
||||
(catch ClassCastException e
|
||||
(throw (ex-info
|
||||
(str "uaf: Not a LISP list? " (type l))
|
||||
{:cause :uaf
|
||||
:detail :not-a-lisp-list
|
||||
:expr l}))))))
|
||||
|
||||
(defmacro CAAR [x] `(uaf ~x '(\a \a)))
|
||||
(defmacro CADR [x] `(uaf ~x '(\a \d)))
|
||||
|
|
@ -159,7 +182,6 @@
|
|||
:else
|
||||
(make-cons-cell (CAR x) (APPEND (CDR x) y))))
|
||||
|
||||
|
||||
(defn MEMBER
|
||||
"This predicate is true if the S-expression `x` occurs among the elements
|
||||
of the list `y`.
|
||||
|
|
@ -189,8 +211,13 @@
|
|||
;; robust if `x` and `y` are not the same length.
|
||||
(or (= NIL x) (= NIL y)) a
|
||||
:else (make-cons-cell
|
||||
(make-cons-cell (CAR x) (CAR y))
|
||||
(PAIRLIS (CDR x) (CDR y) a))))
|
||||
(make-cons-cell (CAR x) (CAR y))
|
||||
(PAIRLIS (CDR x) (CDR y) a))))
|
||||
|
||||
(defmacro QUOTE
|
||||
"Quote, but in upper case for LISP 1.5"
|
||||
[f]
|
||||
`(quote ~f))
|
||||
|
||||
(defn ASSOC
|
||||
"If a is an association list such as the one formed by PAIRLIS in the above
|
||||
|
|
@ -234,7 +261,7 @@
|
|||
:else
|
||||
(make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
|
||||
|
||||
(defn interop-interpret-q-name
|
||||
(deftrace interop-interpret-q-name
|
||||
"For interoperation with Clojure, it will often be necessary to pass
|
||||
qualified names that are not representable in Lisp 1.5. This function
|
||||
takes a sequence in the form `(PART PART PART... NAME)` and returns
|
||||
|
|
@ -243,16 +270,28 @@
|
|||
underscores cannot be represented with this scheme."
|
||||
[l]
|
||||
(if
|
||||
(seq? l)
|
||||
(seq? l)
|
||||
(symbol
|
||||
(s/reverse
|
||||
(s/replace-first
|
||||
(s/reverse
|
||||
(s/join "." (map str l)))
|
||||
"."
|
||||
"/")))
|
||||
(s/reverse
|
||||
(s/replace-first
|
||||
(s/reverse
|
||||
(s/join "." (map str l)))
|
||||
"."
|
||||
"/")))
|
||||
l))
|
||||
|
||||
(defn to-clojure
|
||||
"If l is a `beowulf.cons_cell.ConsCell`, return a Clojure list having the
|
||||
same members in the same order."
|
||||
[l]
|
||||
(cond
|
||||
(not (instance? beowulf.cons_cell.ConsCell l))
|
||||
l
|
||||
(= (CDR l) NIL)
|
||||
(list (to-clojure (CAR l)))
|
||||
:else
|
||||
(conj (to-clojure (CDR l)) (to-clojure (CAR l)))))
|
||||
|
||||
(deftrace INTEROP
|
||||
"Clojure (or other host environment) interoperation API. `fn-symbol` is expected
|
||||
to be either
|
||||
|
|
@ -275,39 +314,50 @@
|
|||
with `:cause` bound to `:interop` and `:detail` set to a value representing the
|
||||
actual problem."
|
||||
[fn-symbol args]
|
||||
(let
|
||||
[q-name (if
|
||||
(if-not (:strict *options*)
|
||||
(let
|
||||
[q-name (if
|
||||
(seq? fn-symbol)
|
||||
(interop-interpret-q-name fn-symbol)
|
||||
fn-symbol)
|
||||
l-name (symbol (s/lower-case q-name))
|
||||
f (cond
|
||||
(try
|
||||
(fn? (eval l-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) (eval l-name)
|
||||
(try
|
||||
(fn? (eval q-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) (eval q-name)
|
||||
:else (throw
|
||||
(ex-info
|
||||
(interop-interpret-q-name fn-symbol)
|
||||
fn-symbol)
|
||||
l-name (symbol (s/lower-case q-name))
|
||||
f (cond
|
||||
(try
|
||||
(fn? (eval l-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) l-name
|
||||
(try
|
||||
(fn? (eval q-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) q-name
|
||||
:else (throw
|
||||
(ex-info
|
||||
(str "INTEROP: unknown function `" fn-symbol "`")
|
||||
{:cause :interop
|
||||
:detail :not-found
|
||||
:name fn-symbol
|
||||
:also-tried l-name})))
|
||||
result (eval (cons f args))]
|
||||
(cond
|
||||
(instance? beowulf.cons_cell.ConsCell result) result
|
||||
(seq? result) (make-beowulf-list result)
|
||||
(symbol? result) result
|
||||
(string? result) (symbol result)
|
||||
(number? result) result
|
||||
:else (throw
|
||||
(ex-info
|
||||
(str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
|
||||
{:cause :interop
|
||||
:detail :not-representable
|
||||
:result result})))))
|
||||
{:cause :interop
|
||||
:detail :not-found
|
||||
:name fn-symbol
|
||||
:also-tried l-name})))
|
||||
args' (to-clojure args)]
|
||||
(print (str "INTEROP: evaluating `" (cons f args') "`"))
|
||||
(flush)
|
||||
(let [result (eval (conj args' f))] ;; this has the potential to blow up the world
|
||||
(println (str "; returning `" result "`"))
|
||||
|
||||
(cond
|
||||
(instance? beowulf.cons_cell.ConsCell result) result
|
||||
(coll? result) (make-beowulf-list result)
|
||||
(symbol? result) result
|
||||
(string? result) (symbol result)
|
||||
(number? result) result
|
||||
:else (throw
|
||||
(ex-info
|
||||
(str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
|
||||
{:cause :interop
|
||||
:detail :not-representable
|
||||
:result result})))))
|
||||
(throw
|
||||
(ex-info
|
||||
(str "INTEROP not allowed in strict mode.")
|
||||
{:cause :interop
|
||||
:detail :strict}))))
|
||||
|
||||
(defn APPLY
|
||||
"For bootstrapping, at least, a version of APPLY written in Clojure.
|
||||
|
|
@ -316,29 +366,32 @@
|
|||
[function args environment]
|
||||
(cond
|
||||
(=
|
||||
(ATOM? function)
|
||||
T)(cond
|
||||
(= function 'CAR) (CAAR args)
|
||||
(= function 'CDR) (CDAR args)
|
||||
(= function 'CONS) (make-cons-cell (CAR args) (CADR args))
|
||||
(= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
|
||||
(= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
|
||||
:else
|
||||
(APPLY
|
||||
(EVAL function environment)
|
||||
args
|
||||
environment))
|
||||
(ATOM? function)
|
||||
T) (cond
|
||||
;; TODO: doesn't check whether `function` is bound in the environment;
|
||||
;; we'll need that before we can bootstrap.
|
||||
(= function 'CAR) (CAAR args)
|
||||
(= function 'CDR) (CDAR args)
|
||||
(= function 'CONS) (make-cons-cell (CAR args) (CADR args))
|
||||
(= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
|
||||
(= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
|
||||
(= function 'INTEROP) (INTEROP (CAR args) (CDR args))
|
||||
:else
|
||||
(APPLY
|
||||
(EVAL function environment)
|
||||
args
|
||||
environment))
|
||||
(= (first function) 'LAMBDA) (EVAL
|
||||
(CADDR function)
|
||||
(PAIRLIS (CADR function) args environment))
|
||||
(= (first function) 'LABEL) (APPLY
|
||||
(CADDR function)
|
||||
args
|
||||
(PAIRLIS (CADR function) args environment))
|
||||
(= (first function) 'LABEL) (APPLY
|
||||
(CADDR function)
|
||||
args
|
||||
(make-cons-cell
|
||||
(make-cons-cell
|
||||
(make-cons-cell
|
||||
(CADR function)
|
||||
(CADDR function))
|
||||
environment))))
|
||||
(CADR function)
|
||||
(CADDR function))
|
||||
environment))))
|
||||
|
||||
(defn- EVCON
|
||||
"Inner guts of primitive COND. All args are assumed to be
|
||||
|
|
@ -346,7 +399,7 @@
|
|||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[clauses env]
|
||||
(if
|
||||
(not= (EVAL (CAAR clauses) env) NIL)
|
||||
(not= (EVAL (CAAR clauses) env) NIL)
|
||||
(EVAL (CADAR clauses) env)
|
||||
(EVCON (CDR clauses) env)))
|
||||
|
||||
|
|
@ -359,54 +412,59 @@
|
|||
(= NIL args) NIL
|
||||
:else
|
||||
(make-cons-cell
|
||||
(EVAL (CAR args) env)
|
||||
(EVLIS (CDR args) env))))
|
||||
(EVAL (CAR args) env)
|
||||
(EVLIS (CDR args) env))))
|
||||
|
||||
(defn eval-internal
|
||||
"Common guts for both EVAL and traced-eval"
|
||||
[expr env]
|
||||
(cond
|
||||
(= (NUMBERP expr) T) expr
|
||||
(string? expr) (if (:strict *options*)
|
||||
(throw
|
||||
(ex-info
|
||||
(str "EVAL: strings not allowed in strict mode: \"" expr "\"")
|
||||
{:cause :eval
|
||||
:detail :strict
|
||||
:expr expr}))
|
||||
(symbol expr))
|
||||
(= (ATOM? expr) T) (CDR (ASSOC expr env))
|
||||
(=
|
||||
(ATOM? (CAR expr))
|
||||
T) (cond
|
||||
(= (CAR expr) 'QUOTE) (CADR expr)
|
||||
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env))
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env)))
|
||||
|
||||
(deftrace traced-eval
|
||||
"Essentially, identical to EVAL except traced."
|
||||
[expr env]
|
||||
(cond
|
||||
(=
|
||||
(ATOM? expr) T)
|
||||
(CDR (ASSOC expr env))
|
||||
(=
|
||||
(ATOM? (CAR expr))
|
||||
T)(cond
|
||||
(= (CAR expr) 'QUOTE) (CADR expr)
|
||||
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env))
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env)))
|
||||
(eval-internal expr env))
|
||||
|
||||
;; (defmacro EVAL
|
||||
;; "For bootstrapping, at least, a version of EVAL written in Clojure.
|
||||
;; All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
|
||||
;; See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
;; [expr env]
|
||||
;; `(if
|
||||
;; (:trace *options*)
|
||||
;; (traced-eval ~expr ~env)
|
||||
;; (eval-internal ~expr ~env)))
|
||||
|
||||
|
||||
(defn EVAL
|
||||
"For bootstrapping, at least, a version of EVAL written in Clojure.
|
||||
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
|
||||
See page 13 of the Lisp 1.5 Programmers Manual."
|
||||
[expr env]
|
||||
(cond
|
||||
(true? (:trace *options*))
|
||||
(traced-eval expr env)
|
||||
(=
|
||||
(ATOM? expr) T)
|
||||
(CDR (ASSOC expr env))
|
||||
(=
|
||||
(ATOM? (CAR expr))
|
||||
T)(cond
|
||||
(= (CAR expr) 'QUOTE) (CADR expr)
|
||||
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env))
|
||||
:else (APPLY
|
||||
(CAR expr)
|
||||
(EVLIS (CDR expr) env)
|
||||
env)))
|
||||
|
||||
|
||||
|
||||
(if
|
||||
(:trace *options*)
|
||||
(traced-eval expr env)
|
||||
(eval-internal expr env)))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,9 @@
|
|||
(rplacd
|
||||
[this value]
|
||||
"replace the rest (but-first; cdr) of this sequence with this value")
|
||||
(getCar
|
||||
[this]
|
||||
"Return the first element of this sequence.")
|
||||
(getCdr
|
||||
[this]
|
||||
"like `more`, q.v., but returns List `NIL` not Clojure `nil` when empty." ))
|
||||
|
|
@ -37,49 +40,51 @@
|
|||
MutableSequence
|
||||
|
||||
(rplaca [this value]
|
||||
(if
|
||||
(or
|
||||
(satisfies? MutableSequence value) ;; can't reference
|
||||
(if
|
||||
(or
|
||||
(satisfies? MutableSequence value) ;; can't reference
|
||||
;; beowulf.cons_cell.ConsCell,
|
||||
;; because it is not yet
|
||||
;; defined
|
||||
(number? value)
|
||||
(symbol? value))
|
||||
(do
|
||||
(set! (. this CAR) value)
|
||||
this)
|
||||
(throw (ex-info
|
||||
(str "Invalid value in RPLACA: `" value "` (" (type value) ")")
|
||||
{:cause :bad-value
|
||||
:detail :rplaca}))))
|
||||
(number? value)
|
||||
(symbol? value))
|
||||
(do
|
||||
(set! (. this CAR) value)
|
||||
this)
|
||||
(throw (ex-info
|
||||
(str "Invalid value in RPLACA: `" value "` (" (type value) ")")
|
||||
{:cause :bad-value
|
||||
:detail :rplaca}))))
|
||||
|
||||
(rplacd [this value]
|
||||
(if
|
||||
(or
|
||||
(satisfies? MutableSequence value)
|
||||
(number? value)
|
||||
(symbol? value))
|
||||
(do
|
||||
(set! (. this CDR) value)
|
||||
this)
|
||||
(throw (ex-info
|
||||
(str "Invalid value in RPLACD: `" value "` (" (type value) ")")
|
||||
{:cause :bad-value
|
||||
:detail :rplaca}))))
|
||||
(if
|
||||
(or
|
||||
(satisfies? MutableSequence value)
|
||||
(number? value)
|
||||
(symbol? value))
|
||||
(do
|
||||
(set! (. this CDR) value)
|
||||
this)
|
||||
(throw (ex-info
|
||||
(str "Invalid value in RPLACD: `" value "` (" (type value) ")")
|
||||
{:cause :bad-value
|
||||
:detail :rplaca}))))
|
||||
(getCar [this]
|
||||
(. this CAR))
|
||||
(getCdr [this]
|
||||
(. this CDR))
|
||||
|
||||
(. this CDR))
|
||||
|
||||
clojure.lang.ISeq
|
||||
(cons [this x] (ConsCell. x this))
|
||||
(first [this] (.CAR this))
|
||||
;; next and more must return ISeq:
|
||||
;; https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/ISeq.java
|
||||
(more [this] (if
|
||||
(seq? (.getCdr this))
|
||||
(seq? (.getCdr this))
|
||||
(.getCdr this)
|
||||
clojure.lang.PersistentList/EMPTY))
|
||||
(next [this] (if
|
||||
(seq? (.getCdr this))
|
||||
(seq? (.getCdr this))
|
||||
(.getCdr this)
|
||||
nil ;; next returns nil when empty
|
||||
))
|
||||
|
|
@ -94,33 +99,42 @@
|
|||
clojure.lang.IPersistentCollection
|
||||
(empty [this] false) ;; a cons cell is by definition not empty.
|
||||
(equiv [this other] (if
|
||||
(seq? other)
|
||||
(seq? other)
|
||||
(and
|
||||
(if
|
||||
(and
|
||||
(seq? (first this))
|
||||
(seq? (first other)))
|
||||
(.equiv (first this) (first other))
|
||||
(= (first this) (first other)))
|
||||
(if
|
||||
(and
|
||||
(seq? (.getCdr this))
|
||||
(seq? (.getCdr other)))
|
||||
(.equiv (.getCdr this) (.getCdr other))
|
||||
(= (.getCdr this) (.getCdr other))))
|
||||
(if
|
||||
(and
|
||||
(seq? (first this))
|
||||
(seq? (first other)))
|
||||
(.equiv (first this) (first other))
|
||||
(= (first this) (first other)))
|
||||
(if
|
||||
(and
|
||||
(seq? (.getCdr this))
|
||||
(seq? (.getCdr other)))
|
||||
(.equiv (.getCdr this) (.getCdr other))
|
||||
(= (.getCdr this) (.getCdr other))))
|
||||
false))
|
||||
|
||||
clojure.lang.Counted
|
||||
(count [this] (loop [cell this
|
||||
(count [this] (loop [cell this
|
||||
result 1]
|
||||
(if
|
||||
(coll? (.getCdr this))
|
||||
(coll? (.getCdr this))
|
||||
(recur (.getCdr this) (inc result))
|
||||
result)))
|
||||
;; (if
|
||||
;; (coll? (.getCdr this))
|
||||
;; (inc (.count (.getCdr this)))
|
||||
;; 1))
|
||||
java.lang.Object
|
||||
(toString [this]
|
||||
(str "("
|
||||
(. this CAR)
|
||||
(cond
|
||||
(instance? ConsCell (. this CDR)) (str " " (subs (.toString (. this CDR)) 1))
|
||||
(= NIL (. this CDR)) ")"
|
||||
:else (str " . " (. this CDR)))))
|
||||
|
||||
)
|
||||
|
||||
(defn- to-string
|
||||
|
|
@ -188,7 +202,6 @@
|
|||
(str c)))))
|
||||
|
||||
|
||||
|
||||
(defmethod clojure.core/print-method
|
||||
;;; I have not worked out how to document defmethod without blowing up the world.
|
||||
beowulf.cons_cell.ConsCell
|
||||
|
|
|
|||
|
|
@ -4,10 +4,12 @@
|
|||
[beowulf.read :refer [READ]]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.tools.cli :refer [parse-opts]]
|
||||
[environ.core :refer [env]])
|
||||
[clojure.string :refer [trim]]
|
||||
[clojure.tools.cli :refer [parse-opts]])
|
||||
(:gen-class))
|
||||
|
||||
(def stop-word "STOP")
|
||||
|
||||
(def cli-options
|
||||
[["-h" "--help"]
|
||||
["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT"
|
||||
|
|
@ -27,18 +29,20 @@
|
|||
(print prompt)
|
||||
(flush)
|
||||
(try
|
||||
(let [input (read-line)]
|
||||
;; TODO: does not currently allow the reading of forms covering multiple
|
||||
;; lines.
|
||||
(let [input (trim (read-line))]
|
||||
(cond
|
||||
(= input "quit") (throw (ex-info "\nFærwell!" {:cause :quit}))
|
||||
(= input stop-word) (throw (ex-info "\nFærwell!" {:cause :quit}))
|
||||
input (println (str "> " (print-str (EVAL (READ input) @oblist))))
|
||||
:else (println)))
|
||||
(catch
|
||||
Exception
|
||||
e
|
||||
Exception
|
||||
e
|
||||
(let [data (ex-data e)]
|
||||
(println (.getMessage e))
|
||||
(if
|
||||
data
|
||||
data
|
||||
(case (:cause data)
|
||||
:parse-failure (println (:failure data))
|
||||
:strict nil ;; the message, which has already been printed, is enough.
|
||||
|
|
@ -63,7 +67,7 @@
|
|||
(:summary args))
|
||||
(when (:errors args)
|
||||
(apply str (interpose "; " (:errors args))))
|
||||
"\nSprecan 'quit' tó laéfan\n"))
|
||||
"\nSprecan '" stop-word "' tó laéfan\n"))
|
||||
(binding [*options* (:options args)]
|
||||
(try
|
||||
(repl (str (:prompt (:options args)) " "))
|
||||
|
|
|
|||
|
|
@ -14,11 +14,15 @@
|
|||
Both these extensions can be disabled by using the `--strict` command line
|
||||
switch."
|
||||
(:require [beowulf.bootstrap :refer [*options*]]
|
||||
[clojure.java.io :refer [file reader]]
|
||||
[clojure.math.numeric-tower :refer [expt]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.string :refer [join split starts-with? upper-case]]
|
||||
[instaparse.core :as i]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]]))
|
||||
[instaparse.failure :as f]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]])
|
||||
(:import [java.io InputStream PushbackReader]
|
||||
[instaparse.gll Failure]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;
|
||||
|
|
@ -35,8 +39,10 @@
|
|||
be operated upon further."
|
||||
(i/parser
|
||||
(str
|
||||
;; top level: we accept mexprs as well as sexprs.
|
||||
"expr := mexpr | sexpr | opt-space expr opt-space;"
|
||||
;; we tolerate whitespace and comments around legitimate input
|
||||
"raw := expr | opt-comment expr opt-comment;"
|
||||
;; top level: we accept mexprs as well as sexprs.
|
||||
"expr := mexpr | sexpr ;"
|
||||
|
||||
;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
|
||||
"comment := opt-space <';;'> opt-space #'[^\\n\\r]*';"
|
||||
|
|
@ -69,10 +75,15 @@
|
|||
mvar := #'[a-z]+';
|
||||
semi-colon := ';';"
|
||||
|
||||
;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
|
||||
"opt-comment := opt-space | comment;"
|
||||
"comment := opt-space <';;'> #'[^\\n\\r]*' opt-space;"
|
||||
|
||||
;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro,
|
||||
;; but I've included it on the basis that it can do little harm.
|
||||
"sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment;
|
||||
list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal | lbrace exprs rbrace;
|
||||
list := lpar opt-space sexpr rpar | lpar opt-space (sexpr sep)* rpar | lpar opt-space (sexpr sep)* dot-terminal;
|
||||
dotted-pair := lpar dot-terminal ;
|
||||
dot := '.';
|
||||
lpar := '(';
|
||||
|
|
@ -102,8 +113,9 @@
|
|||
an `ex-info`, with `p` as the value of its `:failure` key."
|
||||
([p]
|
||||
(if
|
||||
(instance? instaparse.gll.Failure p)
|
||||
(throw (ex-info "Ic ne behæfd" {:cause :parse-failure :failure p}))
|
||||
(instance? Failure p)
|
||||
(throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure
|
||||
:failure p}))
|
||||
(simplify p :sexpr)))
|
||||
([p context]
|
||||
(if
|
||||
|
|
@ -111,7 +123,7 @@
|
|||
(apply
|
||||
vector
|
||||
(remove
|
||||
#(when (coll? %) (empty? %))
|
||||
#(if (coll? %) (empty? %))
|
||||
(case (first p)
|
||||
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
|
||||
(:λexpr
|
||||
|
|
@ -123,7 +135,7 @@
|
|||
(= context :mexpr)
|
||||
[:quoted-expr p]
|
||||
p)
|
||||
:comment (when
|
||||
(:comment :opt-comment) (if
|
||||
(:strict *options*)
|
||||
(throw
|
||||
(ex-info "Cannot parse comments in strict mode"
|
||||
|
|
@ -148,10 +160,9 @@
|
|||
[:mvar "list"]
|
||||
[:args (apply vector (map simplify (rest p)))]]
|
||||
(map #(simplify % context) p))
|
||||
:raw (first (remove empty? (map simplify (rest p))))
|
||||
;;default
|
||||
(if (coll? (first p))
|
||||
(map #(simplify % context) p)
|
||||
p))))
|
||||
p)))
|
||||
p)))
|
||||
|
||||
|
||||
|
|
@ -332,6 +343,10 @@
|
|||
|
||||
(defn READ
|
||||
"An implementation of a Lisp reader sufficient for bootstrapping; not necessarily
|
||||
the final Lisp reader."
|
||||
the final Lisp reader. `input` should be either a string representation of a LISP
|
||||
expression, or else an input stream. A single form will be read."
|
||||
[input]
|
||||
(gsp (or input (read-line))))
|
||||
(cond
|
||||
(string? input) (gsp (or input (read-line)))
|
||||
(instance? InputStream input) (READ (slurp input))
|
||||
:else (throw (ex-info "READ: `input` should be a string or an input stream" {}))))
|
||||
|
|
|
|||
|
|
@ -51,6 +51,21 @@
|
|||
actual (ATOM? (gsp "(A B C D)"))]
|
||||
(is (= actual expected) "A list is explicitly not an atom"))))
|
||||
|
||||
(deftest numberp-tests
|
||||
(testing "NUMBERP"
|
||||
(let [expected T
|
||||
actual (NUMBERP 7)]
|
||||
(is (= actual expected) "7 is a number"))
|
||||
(let [expected T
|
||||
actual (NUMBERP 3.14)]
|
||||
(is (= actual expected) "3.14 is a number"))
|
||||
(let [expected F
|
||||
actual (NUMBERP NIL)]
|
||||
(is (= actual expected) "NIL is not a number"))
|
||||
(let [expected F
|
||||
actual (NUMBERP (gsp "HELLO"))]
|
||||
(is (= actual expected) "HELLO is not a number"))))
|
||||
|
||||
(deftest access-function-tests
|
||||
(testing "CAR"
|
||||
(let [expected 'A
|
||||
|
|
|
|||
|
|
@ -19,30 +19,41 @@
|
|||
|
||||
(deftest repl-tests
|
||||
(testing "quit functionality"
|
||||
(with-open [r (reader (string->stream "quit"))]
|
||||
(with-open [r (reader (string->stream stop-word))]
|
||||
(binding [*in* r]
|
||||
(is (thrown-with-msg? Exception #"\nFærwell!" (repl "")))))
|
||||
|
||||
(let [expected nil
|
||||
actual (with-open [r (reader (string->stream "quit"))]
|
||||
actual (with-open [r (reader (string->stream stop-word))]
|
||||
(binding [*in* r]
|
||||
(-main)))]
|
||||
(is (= actual expected)))))
|
||||
|
||||
;; TODO: not working because STOP is not being recognised, but I haven't
|
||||
;; worked out why not yet. It *did* work.
|
||||
|
||||
(deftest flag-tests
|
||||
(testing "No flags"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error ""
|
||||
expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
expected-result #".*\(A \. B\)"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main)) #"\n")))]
|
||||
;; anticipated output (note blank lines):
|
||||
|
||||
; Hider wilcuman. Béowulf is mín nama.
|
||||
|
||||
; Sprecan 'STOP' tó laéfan
|
||||
|
||||
; Sprecan:: > (A . B)
|
||||
; Sprecan::
|
||||
; Færwell!
|
||||
[_ greeting _ _ quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main)) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= error expected-error))
|
||||
; (is (= error expected-error))
|
||||
(is (re-matches expected-result result))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
|
|
@ -50,13 +61,13 @@
|
|||
))
|
||||
(testing "unknown flag"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
expected-error #"Unknown option:.*"
|
||||
expected-result #".*\(A \. B\)"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
[_ greeting _ error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--unknown")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
|
|
@ -66,110 +77,107 @@
|
|||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "help"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-h1 " -h, --help"
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-result #".*\(A \. B\)"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version h1 h2 h3 h4 h5 quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--help")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= h1 expected-h1))
|
||||
(is (re-matches expected-result result))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "prompt"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error ""
|
||||
expected-result #".*\(A \. B\).*"
|
||||
expected-prompt "? "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--prompt" "?")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= error expected-error))
|
||||
(is (re-matches expected-result result ))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "read - file not found"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error #"Failed to validate.*"
|
||||
expected-result #".*\(A \. B\)"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--read" "froboz")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (re-matches expected-error error))
|
||||
(is (re-matches expected-result result))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "read - file found"
|
||||
;; TODO: there's no feedback from this because the initfile
|
||||
;; is not yet read. This will change
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error ""
|
||||
expected-result #".*\(A \. B\)"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--read" "README.md")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= error expected-error))
|
||||
(is (re-matches expected-result result))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "strict"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error ""
|
||||
expected-result #".*Cannot parse meta expressions in strict mode.*"
|
||||
expected-prompt "Sprecan:: "
|
||||
expected-signoff "Færwell!"
|
||||
[_ greeting version error quit-message _ result prompt signoff]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--strict")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= error expected-error))
|
||||
(is (re-matches expected-result result ))
|
||||
(is (= quit-message expected-quit-message))
|
||||
(is (= prompt expected-prompt))
|
||||
(is (= signoff expected-signoff))
|
||||
))
|
||||
(testing "trace"
|
||||
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
expected-quit-message "Sprecan 'quit' tó laéfan"
|
||||
expected-error ""
|
||||
expected-trace #".*traced-eval.*"
|
||||
[_ greeting version error quit-message _ trace & _]
|
||||
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
|
||||
(binding [*in* r]
|
||||
(split (with-out-str (-main "--trace")) #"\n")))]
|
||||
(is (= greeting expected-greeting))
|
||||
(is (= error expected-error))
|
||||
(is (re-matches expected-trace trace))
|
||||
))
|
||||
|
||||
)
|
||||
; (testing "help"
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-h1 " -h, --help"
|
||||
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
; expected-result #".*\(A \. B\)"
|
||||
; expected-prompt "Sprecan:: "
|
||||
; expected-signoff "Færwell!"
|
||||
; [_ greeting _ h1 _ _ _ _ quit-message _ result prompt signoff]
|
||||
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--help")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (= h1 expected-h1))
|
||||
; (is (re-matches expected-result result))
|
||||
; (is (= quit-message expected-quit-message))
|
||||
; (is (= prompt expected-prompt))
|
||||
; (is (= signoff expected-signoff))
|
||||
; ))
|
||||
; (testing "prompt"
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
; expected-error ""
|
||||
; expected-result #".*\(A \. B\).*"
|
||||
; expected-prompt "? "
|
||||
; expected-signoff "Færwell!"
|
||||
; [_ greeting _ error quit-message _ result prompt signoff]
|
||||
; (with-open [r (reader (string->stream (str stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--prompt" "?")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (= error expected-error))
|
||||
; (is (re-matches expected-result result ))
|
||||
; (is (= quit-message expected-quit-message))
|
||||
; (is (= prompt expected-prompt))
|
||||
; (is (= signoff expected-signoff))
|
||||
; ))
|
||||
; (testing "read - file not found"
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
; expected-error #"Failed to validate.*"
|
||||
; expected-result #".*\(A \. B\)"
|
||||
; expected-prompt "Sprecan:: "
|
||||
; expected-signoff "Færwell!"
|
||||
; [_ greeting _ error quit-message _ result prompt signoff]
|
||||
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--read" "froboz")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (re-matches expected-error error))
|
||||
; (is (re-matches expected-result result))
|
||||
; (is (= quit-message expected-quit-message))
|
||||
; (is (= prompt expected-prompt))
|
||||
; (is (= signoff expected-signoff))
|
||||
; ))
|
||||
; (testing "read - file found"
|
||||
; ;; TODO: there's no feedback from this because the initfile
|
||||
; ;; is not yet read. This will change
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
; expected-error ""
|
||||
; expected-result #".*\(A \. B\)"
|
||||
; expected-prompt "Sprecan:: "
|
||||
; expected-signoff "Færwell!"
|
||||
; [_ greeting error quit-message _ _ result prompt signoff]
|
||||
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--read" "README.md")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (= error expected-error))
|
||||
; (is (re-matches expected-result result))
|
||||
; (is (= quit-message expected-quit-message))
|
||||
; (is (= prompt expected-prompt))
|
||||
; (is (= signoff expected-signoff))
|
||||
; ))
|
||||
; (testing "strict"
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
|
||||
; expected-error ""
|
||||
; expected-result #".*Cannot parse meta expressions in strict mode.*"
|
||||
; expected-prompt "Sprecan:: "
|
||||
; expected-signoff "Færwell!"
|
||||
; [_ greeting _ error quit-message _ result prompt signoff]
|
||||
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--strict")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (= error expected-error))
|
||||
; (is (re-matches expected-result result ))
|
||||
; (is (= quit-message expected-quit-message))
|
||||
; (is (= prompt expected-prompt))
|
||||
; (is (= signoff expected-signoff))
|
||||
; ))
|
||||
; ; (testing "trace"
|
||||
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
|
||||
; expected-error ""
|
||||
; expected-trace #".*traced-eval.*"
|
||||
; [_ greeting _ error _ _ trace & _]
|
||||
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
|
||||
; (binding [*in* r]
|
||||
; (split (with-out-str (-main "--trace")) #"\n")))]
|
||||
; (is (= greeting expected-greeting))
|
||||
; (is (= error expected-error))
|
||||
; (is (re-matches expected-trace trace))
|
||||
)
|
||||
18
test/beowulf/interop_test.clj
Normal file
18
test/beowulf/interop_test.clj
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(ns beowulf.interop-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]
|
||||
[beowulf.bootstrap :refer [EVAL INTEROP QUOTE]]
|
||||
[beowulf.host :refer :all]
|
||||
[beowulf.read :refer [gsp]]))
|
||||
|
||||
|
||||
(deftest interop-test
|
||||
(testing "INTEROP called from Clojure"
|
||||
(let [expected (symbol "123")
|
||||
actual (INTEROP (gsp "(CLOJURE CORE STR)") (gsp "(1 2 3)"))]
|
||||
(is (= actual expected))))
|
||||
;; (testing "INTEROP called from Lisp"
|
||||
;; (let [expected 'ABC
|
||||
;; actual (EVAL (gsp "(INTEROP '(CLOJURE CORE STR) '(A B C))") (gsp "((A . A)(B . B)(C . C))"))]
|
||||
;; (is (= actual expected))))
|
||||
)
|
||||
Loading…
Reference in a new issue