;;; -*- Mode:LISP; Package:COMPILER; Readtable:ZL; Base:10 -*-

#|

FOREIGN-SYMBOL.LISP

Provides a compile-time customization mechanism for solving problems
with references to symbols in undefined packages or unloaded systems.

The real-word application of this is for the cross-compiler, when Lambda
system files contain references to symbols in Falcon packages that are
not known to Lambda.  (Got that?)

For each "foreign symbol," a property list of values is associated with
the foreign symbol tag, which is generally a keyword.  For each target
computer, a "native value" for the foreign symbol can be associated with
a particular tag.  (These native values can be anything, but the
existing requirement is to obtain a different symbol as the foreign
symbol value.)

Here's an example of the application of FOREIGN-SYMBOL.  Instead of
doing the following and losing:

  (do-something-with
    (cond
      ((eq *target-computer* 'k)
        ;;array:art-q ;;WKF: 5/18/88
        #+lambda k-array:art-q #+falcon array:art-q
        'art-q)
      ((eq *target-computer* 'lambda)
        ;;etc.
        )))

...one would do:

1: Define the Lambda native symbol, e.g., in "SYS:SYS;TYPES":

   #+lambda
   (def-foreign-symbol :art-q 'ZL:ART-Q)

2: Define the Falcon native symbol elsewhere:

   (def-foreign-symbol :art-q
     #+lambda 'K-ARRAY:ART-Q
     #+falcon 'ARRAY:ART-Q)

3: Refer to the foreign symbol:

(defun foo () (print (foreign-symbol :art-q)))

Additional features:

1. FOREIGN-SYMBOL is SETF'able; this translates into DEF-FOREIGN-SYMBOL,
which (when compiled) should be used as a top-level form only.

2. The source file of a FOREIGN-SYMBOL is recorded and checked, like DEFUN's, etc.

3. FOREIGN-SYMBOL-VALUE is also provided to provide compile-time lookups
with a further level of indirection: the SYMBOL-VALUE of the native
symbol is returned.

4. INLINE-FOREIGN-SYMBOL and INLINE-FOREIGN-SYMBOL-VALUE are equivalent
to FOREIGN-SYMBOL and FOREIGN-SYMBOL-VALUE, respectively, but they get
optimized into the at compile-time values of .  This is for code that
doesn't need to get the foreign symbols dynamically, at run time.  I
don't know if anything in the system files will need this.

|#

(defvar *foreign-symbol-table* (make-hash-table))

;;;Utility look-up function

(defun lookup-foreign-symbol (foreign-symbol &optional error-p)
  (declare (eh:error-reporter))
  (flet ((error-string ()
	  (format nil "There is no declared foreign-symbol value for ~S" foreign-symbol)))
    (or (car-safe (getf (gethash foreign-symbol *foreign-symbol-table*) *target-computer*))
	(if error-p (error (error-string))
	  ;;If allowed, user can set value for undefined foreign-symbol
	  (let ((result (cerror t  nil nil (error-string))))
	    (def-foreign-symbol foreign-symbol result)
	    result)))))

(defun foreign-symbol (FOREIGN-SYMBOL &optional error-p)
  "Returns the version of FOREIGN-SYMBOL appropriate to the compilation target
  computer, according to the appropriate CLAUSE in CLAUSES.
ERROR-P non-NIL means don't allow user to handle undefined foreign symbol
  by specifying a new value."
  (lookup-foreign-symbol foreign-symbol error-p))

(defun def-foreign-symbol (foreign-symbol native-value)
  (declare (zwei:indentation 2 1))
  (setf (getf (gethash foreign-symbol *foreign-symbol-table*) *target-computer*)
	(ncons native-value))
  (si:record-source-file-name foreign-symbol 'foreign-symbol))

(defsetf foreign-symbol def-foreign-symbol)

(defun foreign-symbol-value (foreign-symbol &optional error-p)
  (symbol-value (lookup-foreign-symbol foreign-symbol error-p)))

(deff inline-foreign-symbol 'foreign-symbol)
(deff inline-foreign-symbol-value 'foreign-symbol-value)

(defoptimizer compile-time-foreign-symbol inline-foreign-symbol (form)
  `(quote ,(foreign-symbol (second form) (third form))))

(defoptimizer compile-time-foreign-symbol-value inline-foreign-symbol-value (form)
  (foreign-symbol-value (second form) (third form)))

#| Tests:

(def-foreign-symbol :art-q
  #+(target falcon) 'k-array:art-q #-(target falcon) 'zl:art-q)

(defun foo () (print (foreign-symbol :art-q)))

(defun foo2 () (print (foreign-symbol-value :art-q)))

(defun foo3 () (print `(quote ,(foreign-symbol :art-q))))

(defun ifoo () (print (inline-foreign-symbol :art-q)))

(defun ifoo2 () (print (inline-foreign-symbol-value :art-q)))

(defun ifoo3 () (print `(quote ,(inline-foreign-symbol :art-q))))

|#