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:
Simon Brooke 2019-08-30 14:30:54 +01:00
parent 75da14790c
commit d6801ee443
2 changed files with 41 additions and 18 deletions

View file

@ -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)

View 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))))
)