001 (ns beowulf.interop
002 (:require [beowulf.cons-cell :refer [make-beowulf-list]]
003 [beowulf.host :refer [CAR CDR]]
004 [beowulf.oblist :refer [*options* NIL]]
005 [clojure.string :as s :refer [last-index-of lower-case split
006 upper-case]]))
007
008 ;;;; INTEROP feature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
009
010 (defn listify-qualified-name
011 "We need to be able to print something we can link to the particular Clojure
012 function `subr` in a form in which Lisp 1.5 is able to read it back in and
013 relink it.
014
015 This assumes `subr` is either
016 1. a string in the format `#'beowulf.io/SYSIN` or `beowulf.io/SYSIN`; or
017 2. something which, when coerced to a string with `str`, will have such
018 a format."
019 [subr]
020 (make-beowulf-list
021 (map
022 #(symbol (upper-case %))
023 (remove empty? (split (str subr) #"[#'./]")))))
024
025
026 (defn interpret-qualified-name
027 "For interoperation with Clojure, it will often be necessary to pass
028 qualified names that are not representable in Lisp 1.5. This function
029 takes a sequence in the form `(PART PART PART... NAME)` and returns
030 a symbol in the form `part.part.part/NAME`. This symbol will then be
031 tried in both that form and lower-cased. Names with hyphens or
032 underscores cannot be represented with this scheme."
033 ([l]
034 (symbol
035 (let [n (s/join "."
036 (concat (map #(lower-case (str %)) (butlast l))
037 (list (last l))))
038 s (last-index-of n ".")]
039 (if s
040 (str (subs n 0 s) "/" (subs n (inc s)))
041 n)))))
042
043 (defn to-beowulf
044 "Return a beowulf-native representation of the Clojure object `o`.
045 Numbers and symbols are unaffected. Collections have to be converted;
046 strings must be converted to symbols."
047 [o]
048 (cond
049 (coll? o) (make-beowulf-list o)
050 (string? o) (symbol (s/upper-case o))
051 :else o))
052
053 (defn to-clojure
054 "If l is a `beowulf.cons_cell.ConsCell`, return a Clojure list having the
055 same members in the same order."
056 [l]
057 (cond
058 (not (instance? beowulf.cons_cell.ConsCell l))
059 l
060 (= (CDR l) NIL)
061 (list (to-clojure (CAR l)))
062 :else
063 (conj (to-clojure (CDR l)) (to-clojure (CAR l)))))
064
065 (defn INTEROP
066 "Clojure (or other host environment) interoperation API. `fn-symbol` is expected
067 to be either
068
069 1. a symbol bound in the host environment to a function; or
070 2. a sequence (list) of symbols forming a qualified path name bound to a
071 function.
072
073 Lower case characters cannot normally be represented in Lisp 1.5, so both the
074 upper case and lower case variants of `fn-symbol` will be tried. If the
075 function you're looking for has a mixed case name, that is not currently
076 accessible.
077
078 `args` is expected to be a Lisp 1.5 list of arguments to be passed to that
079 function. Return value must be something acceptable to Lisp 1.5, so either
080 a symbol, a number, or a Lisp 1.5 list.
081
082 If `fn-symbol` is not found (even when cast to lower case), or is not a function,
083 or the value returned cannot be represented in Lisp 1.5, an exception is thrown
084 with `:cause` bound to `:interop` and `:detail` set to a value representing the
085 actual problem."
086 [fn-symbol args]
087 (if-not (:strict *options*)
088 (let
089 [q-name (if
090 (seq? fn-symbol)
091 (interpret-qualified-name fn-symbol)
092 fn-symbol)
093 l-name (symbol (s/lower-case q-name))
094 f (cond
095 (try
096 (fn? (eval l-name))
097 (catch java.lang.ClassNotFoundException _ nil)) l-name
098 (try
099 (fn? (eval q-name))
100 (catch java.lang.ClassNotFoundException _ nil)) q-name
101 :else (throw
102 (ex-info
103 (str "INTEROP: ungecnáwen þegnung `" fn-symbol "`")
104 {:cause :interop
105 :detail :not-found
106 :name fn-symbol
107 :also-tried l-name})))
108 args' (to-clojure args)]
109 ;; (print (str "INTEROP: eahtiende `" (cons f args') "`"))
110 (flush)
111 (let [result (eval (conj args' f))] ;; this has the potential to blow up the world
112 ;; (println (str "; ágiefende `" result "`"))
113 (cond
114 (instance? beowulf.cons_cell.ConsCell result) result
115 (coll? result) (make-beowulf-list result)
116 (symbol? result) result
117 (string? result) (symbol result)
118 (number? result) result
119 :else (throw
120 (ex-info
121 (str "INTEROP: Ne can eahtiende `" result "` to Lisp 1.5.")
122 {:cause :interop
123 :detail :not-representable
124 :result result})))))
125 (throw
126 (ex-info
127 (str "INTEROP ne āfand innan Lisp 1.5.")
128 {:cause :interop
129 :detail :strict}))))