;;; Support for CMUCL sources
;;;
;;; CMUCL sources contain things like _"abc" and _N"abc" to support
;;; localization.  To be able to deal with this, we need to use a
;;; special readtable to compile CMUCL sources.

(defvar *cmucl-source-readtable*
  (let ((f (and (find-package "INTL")
                (find-symbol "INSTALL" "INTL"))))
    (if f
        (let ((rt (copy-readtable)))
          (funcall f rt)
          rt)
        (copy-readtable))))

(defun cmucl-package-p (package)
  (let ((name (package-name package)))
    ;; This list of packages obtained by running (list-all-packages)
    ;; in a clean cmucl and removing the CL and CL-USER packages, and
    ;; adding the backends like x86, sparc, and ppc.
    (member name '("PCL" "XREF" "PROFILE" "LOOP" "DISASSEM" "INSPECT" "CLOS-MOP"
                   "HEMLOCK" "WIRE" "ANSI-LOOP" "XLIB" "NEW-ASSEM"
                   "MULTIPROCESSING" "DFIXNUM" "FORMAT" "HEMLOCK-INTERNALS" "PRETTY-PRINT"
                   "BIGNUM" "C-CALL" "STREAM" "WALKER" "ALIEN" "CONDITIONS" "EVAL" "FWRAPPERS"
                   "INTL" "DEBUG" "ALIEN-INTERNALS" "C" "SYSTEM" "KEYWORD" "UNIX"
                   "DEBUG-INTERNALS" "KERNEL" "EXTENSIONS" "LISP"
                    "X86" "SPARC" "PPC")
            :test #'string=)))

(defimplementation call-with-syntax-hooks (fn)
  (cond ((cmucl-package-p *package*)
         (let ((*readtable* *cmucl-source-readtable*))
           (funcall fn)))
        (t
         (funcall fn))))