Added the beginnings of interop tests
This demonstrates that the idea of naming Lisp 1.5 functions implemented in Clojure with all-upper names will not work with the present INTEROP operator, so some rethink is going to be needed.
This commit is contained in:
parent
75da14790c
commit
d6801ee443
|
@ -234,7 +234,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
|
||||
|
@ -284,21 +284,25 @@
|
|||
f (cond
|
||||
(try
|
||||
(fn? (eval l-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) (eval l-name)
|
||||
(catch java.lang.ClassNotFoundException e nil)) l-name
|
||||
(try
|
||||
(fn? (eval q-name))
|
||||
(catch java.lang.ClassNotFoundException e nil)) (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))]
|
||||
:also-tried l-name})))]
|
||||
(print (str "INTEROP: evaluating `" (cons f args) "`"))
|
||||
(flush)
|
||||
(let [result (eval (read-string (str "(cons " f " " args ")")))] ;; this has the potential to blow up the world
|
||||
(println (str "; returning `" result "`"))
|
||||
|
||||
(cond
|
||||
(instance? beowulf.cons_cell.ConsCell result) result
|
||||
(seq? result) (make-beowulf-list result)
|
||||
(coll? result) (make-beowulf-list result)
|
||||
(symbol? result) result
|
||||
(string? result) (symbol result)
|
||||
(number? result) result
|
||||
|
@ -307,7 +311,7 @@
|
|||
(str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
|
||||
{:cause :interop
|
||||
:detail :not-representable
|
||||
:result result})))))
|
||||
:result result}))))))
|
||||
|
||||
(defn APPLY
|
||||
"For bootstrapping, at least, a version of APPLY written in Clojure.
|
||||
|
@ -325,6 +329,7 @@
|
|||
(= 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)
|
||||
|
|
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]]
|
||||
[beowulf.host :refer :all]
|
||||
[beowulf.read :refer [gsp]]))
|
||||
|
||||
|
||||
(deftest interop-test
|
||||
(testing "INTEROP called from Clojure"
|
||||
(let [expected '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)"))]
|
||||
(is (= actual expected))))
|
||||
)
|
Loading…
Reference in a new issue