src/namespace.lisp

   1 ;;;; -*- encoding:utf-8 -*-
   2
   3 ;;; Copyright 2007-2010 Vladimir Sedach
   4 ;;; Copyright 2008 Travis Cross
   5
   6 ;;; SPDX-License-Identifier: BSD-3-Clause
   7
   8 ;;; Redistribution and use in source and binary forms, with or
   9 ;;; without modification, are permitted provided that the following
  10 ;;; conditions are met:
  11
  12 ;;; 1. Redistributions of source code must retain the above copyright
  13 ;;; notice, this list of conditions and the following disclaimer.
  14
  15 ;;; 2. Redistributions in binary form must reproduce the above
  16 ;;; copyright notice, this list of conditions and the following
  17 ;;; disclaimer in the documentation and/or other materials provided
  18 ;;; with the distribution.
  19
  20 ;;; 3. Neither the name of the copyright holder nor the names of its
  21 ;;; contributors may be used to endorse or promote products derived
  22 ;;; from this software without specific prior written permission.
  23
  24 ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  25 ;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  26 ;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  27 ;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  28 ;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
  29 ;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  30 ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  31 ;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  32 ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  33 ;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  34 ;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  35 ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  36 ;;; POSSIBILITY OF SUCH DAMAGE.
  37
  38 (in-package #:parenscript)
  39 (named-readtables:in-readtable :parenscript)
  40
  41 (defvar *obfuscated-packages* (make-hash-table))
  42
  43 (defun obfuscate-package (package-designator &optional symbol-map)
  44   (setf (gethash (find-package package-designator)
  45                  *obfuscated-packages*)
  46         (or symbol-map
  47             (let ((symbol-table (make-hash-table)))
  48               (lambda (symbol)
  49                 (or (gethash symbol symbol-table)
  50                     (setf (gethash symbol symbol-table)
  51                           (ps-gensym 'g))))))))
  52
  53 (defun unobfuscate-package (package-designator)
  54   (remhash (find-package package-designator) *obfuscated-packages*))
  55
  56 (defun maybe-obfuscate-symbol (symbol)
  57   (if (aand (symbol-package symbol) (eq :external (nth-value 1 (find-symbol (symbol-name symbol) it))))
  58       symbol
  59       (aif (gethash (symbol-package symbol) *obfuscated-packages*)
  60            (funcall it symbol)
  61            symbol)))
  62
  63 (defvar *package-prefix-table* (make-hash-table))
  64
  65 (defmacro ps-package-prefix (package)
  66   `(gethash (find-package ,package) *package-prefix-table*))
  67
  68 (defun symbol-to-js-string (symbol &optional (mangle-symbol-name? t))
  69   (let* ((symbol-name (symbol-name (maybe-obfuscate-symbol symbol)))
  70          (identifier (if mangle-symbol-name?
  71                          (encode-js-identifier symbol-name)
  72                          symbol-name)))
  73     (aif (ps-package-prefix (symbol-package symbol))
  74          (concatenate 'string it identifier)
  75          identifier)))