INTEROP written, but not yet wired in.
This commit is contained in:
parent
b0c14e0b3b
commit
ecbb4c2218
File diff suppressed because it is too large
Load diff
|
|
@ -16,20 +16,20 @@
|
|||
</tr></thead>
|
||||
<tr>
|
||||
<td><a href="beowulf/bootstrap.clj.html">beowulf.bootstrap</a></td><td class="with-bar"><div class="covered"
|
||||
style="width:67.4439461883408%;
|
||||
float:left;"> 752 </div><div class="not-covered"
|
||||
style="width:32.55605381165919%;
|
||||
float:left;"> 363 </div></td>
|
||||
<td class="with-number">67.44 %</td>
|
||||
style="width:60.47808764940239%;
|
||||
float:left;"> 759 </div><div class="not-covered"
|
||||
style="width:39.52191235059761%;
|
||||
float:left;"> 496 </div></td>
|
||||
<td class="with-number">60.48 %</td>
|
||||
<td class="with-bar"><div class="covered"
|
||||
style="width:58.52272727272727%;
|
||||
float:left;"> 103 </div><div class="partial"
|
||||
style="width:23.295454545454547%;
|
||||
float:left;"> 41 </div><div class="not-covered"
|
||||
style="width:18.181818181818183%;
|
||||
float:left;"> 32 </div></td>
|
||||
<td class="with-number">81.82 %</td>
|
||||
<td class="with-number">338</td><td class="with-number">40</td><td class="with-number">176</td>
|
||||
style="width:47.92626728110599%;
|
||||
float:left;"> 104 </div><div class="partial"
|
||||
style="width:19.35483870967742%;
|
||||
float:left;"> 42 </div><div class="not-covered"
|
||||
style="width:32.71889400921659%;
|
||||
float:left;"> 71 </div></td>
|
||||
<td class="with-number">67.28 %</td>
|
||||
<td class="with-number">414</td><td class="with-number">46</td><td class="with-number">217</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/cons_cell.clj.html">beowulf.cons-cell</a></td><td class="with-bar"><div class="covered"
|
||||
|
|
@ -95,9 +95,9 @@
|
|||
</tr>
|
||||
<tr><td>Totals:</td>
|
||||
<td class="with-bar"></td>
|
||||
<td class="with-number">72.95 %</td>
|
||||
<td class="with-number">68.97 %</td>
|
||||
<td class="with-bar"></td>
|
||||
<td class="with-number">79.52 %</td>
|
||||
<td class="with-number">72.89 %</td>
|
||||
</tr>
|
||||
</table>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
ALLUPPERCASE are Lisp 1.5 functions (although written in Clojure) and that
|
||||
therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
|
||||
objects."
|
||||
(:require [clojure.tools.trace :refer :all]
|
||||
(:require [clojure.string :as s]
|
||||
[clojure.tools.trace :refer :all]
|
||||
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -233,6 +234,81 @@
|
|||
:else
|
||||
(make-cons-cell (SUBLIS a (CAR y)) (SUBLIS a (CDR y)))))
|
||||
|
||||
(defn 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
|
||||
a symbol in the form `PART.PART.PART/NAME`. This symbol will then be
|
||||
tried in both that form and lower-cased. Names with hyphens or
|
||||
underscores cannot be represented with this scheme."
|
||||
[l]
|
||||
(if
|
||||
(seq? l)
|
||||
(symbol
|
||||
(s/reverse
|
||||
(s/replace-first
|
||||
(s/reverse
|
||||
(s/join "." (map str l)))
|
||||
"."
|
||||
"/")))
|
||||
l))
|
||||
|
||||
(deftrace INTEROP
|
||||
"Clojure (or other host environment) interoperation API. `fn-symbol` is expected
|
||||
to be either
|
||||
|
||||
1. a symbol bound in the host environment to a function; or
|
||||
2. a sequence (list) of symbols forming a qualified path name bound to a
|
||||
function.
|
||||
|
||||
Lower case characters cannot normally be represented in Lisp 1.5, so both the
|
||||
upper case and lower case variants of `fn-symbol` will be tried. If the
|
||||
function you're looking for has a mixed case name, that is not currently
|
||||
accessible.
|
||||
|
||||
`args` is expected to be a Lisp 1.5 list of arguments to be passed to that
|
||||
function. Return value must be something acceptable to Lisp 1.5, so either
|
||||
a symbol, a number, or a Lisp 1.5 list.
|
||||
|
||||
If `fn-symbol` is not found (even when cast to lower case), or is not a function,
|
||||
or the value returned cannot be represented in Lisp 1.5, an exception is thrown
|
||||
with `:cause` bound to `:interop` and `:detail` set to a value representing the
|
||||
actual problem."
|
||||
[fn-symbol args]
|
||||
(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
|
||||
(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})))))
|
||||
|
||||
(defn APPLY
|
||||
"For bootstrapping, at least, a version of APPLY written in Clojure.
|
||||
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
|
||||
|
|
|
|||
Loading…
Reference in a new issue