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
|
:else
|
||||||
(make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
|
(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
|
"For interoperation with Clojure, it will often be necessary to pass
|
||||||
qualified names that are not representable in Lisp 1.5. This function
|
qualified names that are not representable in Lisp 1.5. This function
|
||||||
takes a sequence in the form `(PART PART PART... NAME)` and returns
|
takes a sequence in the form `(PART PART PART... NAME)` and returns
|
||||||
|
@ -284,21 +284,25 @@
|
||||||
f (cond
|
f (cond
|
||||||
(try
|
(try
|
||||||
(fn? (eval l-name))
|
(fn? (eval l-name))
|
||||||
(catch java.lang.ClassNotFoundException e nil)) (eval l-name)
|
(catch java.lang.ClassNotFoundException e nil)) l-name
|
||||||
(try
|
(try
|
||||||
(fn? (eval q-name))
|
(fn? (eval q-name))
|
||||||
(catch java.lang.ClassNotFoundException e nil)) (eval q-name)
|
(catch java.lang.ClassNotFoundException e nil)) q-name
|
||||||
:else (throw
|
:else (throw
|
||||||
(ex-info
|
(ex-info
|
||||||
(str "INTEROP: unknown function `" fn-symbol "`")
|
(str "INTEROP: unknown function `" fn-symbol "`")
|
||||||
{:cause :interop
|
{:cause :interop
|
||||||
:detail :not-found
|
:detail :not-found
|
||||||
:name fn-symbol
|
:name fn-symbol
|
||||||
:also-tried l-name})))
|
:also-tried l-name})))]
|
||||||
result (eval (cons f args))]
|
(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
|
(cond
|
||||||
(instance? beowulf.cons_cell.ConsCell result) result
|
(instance? beowulf.cons_cell.ConsCell result) result
|
||||||
(seq? result) (make-beowulf-list result)
|
(coll? result) (make-beowulf-list result)
|
||||||
(symbol? result) result
|
(symbol? result) result
|
||||||
(string? result) (symbol result)
|
(string? result) (symbol result)
|
||||||
(number? result) result
|
(number? result) result
|
||||||
|
@ -307,7 +311,7 @@
|
||||||
(str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
|
(str "INTEROP: Cannot return `" result "` to Lisp 1.5.")
|
||||||
{:cause :interop
|
{:cause :interop
|
||||||
:detail :not-representable
|
:detail :not-representable
|
||||||
:result result})))))
|
:result result}))))))
|
||||||
|
|
||||||
(defn APPLY
|
(defn APPLY
|
||||||
"For bootstrapping, at least, a version of APPLY written in Clojure.
|
"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 'CONS) (make-cons-cell (CAR args) (CADR args))
|
||||||
(= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
|
(= function 'ATOM) (if (ATOM? (CAR args)) T NIL)
|
||||||
(= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
|
(= function 'EQ) (if (= (CAR args) (CADR args)) T NIL)
|
||||||
|
(= function 'INTEROP) (INTEROP (CAR args) (CDR args))
|
||||||
:else
|
:else
|
||||||
(APPLY
|
(APPLY
|
||||||
(EVAL function environment)
|
(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