(:file "js-source-model" :depends-on ("package" "utils"))
(:file "ps-source-model" :depends-on ("js-source-model"))
(:file "parser" :depends-on ("js-source-model" "ps-source-model"))
+ (:file "builtin-packages" :depends-on ("parser"))
(:file "deprecated-interface" :depends-on ("parser"))
(:file "js-macrology" :depends-on ("deprecated-interface"))
(:file "ps-macrology" :depends-on ("js-macrology"))
(:file "js-translation" :depends-on ("ps-macrology"))
; (:file "js-ugly-translation" :depends-on ("js-translation"))
(:file "reader" :depends-on ("parser"))
- (:file "compilation-interface" :depends-on ("package" "reader" "js-translation")); "js-ugly-translation"))
+ (:file "compilation-interface" :depends-on ("package" "reader" "js-translation" "builtin-packages")); "js-ugly-translation"))
;; standard library
(:module :lib
:components ((:static-file "functional.lisp")
(:file "test" :depends-on ("test-package"))
(:file "ref2test" :depends-on ("test"))
(:file "reference-tests" :depends-on ("test"))
- (:file "ps-tests" :depends-on ("test"))))))
+ (:file "ps-tests" :depends-on ("test"))
+ (:file "package-system-tests" :depends-on ("test"))))))
+
(defmethod asdf:perform ((o test-op) (c (eql (find-system :parenscript.test))))
(asdf:operate 'asdf:load-op :parenscript.test)
(funcall (intern (symbol-name :run-tests)
- (find-package :js-test))))
+ (find-package :parenscript-test))))
--- /dev/null
+(in-package :parenscript)
+
+(defmethod setup-compilation-environment ((comp-env compilation-environment))
+ (install-standard-script-packages comp-env)
+ (setf (comp-env-current-package comp-env)
+ (find-script-package :parenscript-user comp-env))
+ comp-env)
+
+(defparameter *javascript-exports*
+ (append
+ nil
+ cl-user::*shared-symbols-ps-js*))
+
+(defparameter *parenscript-exports*
+ (append
+ *javascript-exports*
+ cl-user::*parenscript-lang-exports*
+ nil
+ ))
+
+(defmethod install-standard-script-packages ((comp-env compilation-environment))
+ (list
+ (create-script-package
+ comp-env
+ :name "KEYWORD" :lisp-package :keyword)
+ (create-script-package
+ comp-env
+ :name "GLOBAL" :lisp-package :parenscript.global)
+ (create-script-package
+ comp-env
+ :name "JAVASCRIPT" :nicknames (list "JS") :lisp-package :parenscript.javascript
+ :exports *javascript-exports*
+ :secondary-lisp-packages '(:common-lisp))
+ (create-script-package
+ comp-env
+ :name "PARENSCRIPT" :lisp-package :parenscript
+ :exports *parenscript-exports*
+ :used-packages '(:javascript)
+ )
+ (create-script-package
+ comp-env
+ :name "PARENSCRIPT-USER" :lisp-package :parenscript-user
+ :secondary-lisp-packages (list :cl-user)
+ :used-packages '("PARENSCRIPT")
+ :nicknames '("PS-USER" "PAREN-USER"))))
\ No newline at end of file
(*compilation-environment* ,var))
,@body))
-
(defun translate-ast (compiled-expr
&key
(comp-env *compilation-environment*)
(pretty-print t)
(output-stream nil)
(toplevel-p t)
- (comp-env (make-basic-compilation-environment)))
+ (comp-env (or *compilation-environment*
+ (make-basic-compilation-environment))))
"Compiles the Parenscript form SCRIPT-FORM into the language specified by OUTPUT-SPEC.
Non-null PRETTY-PRINT values result in a pretty-printed output code. If OUTPUT-STREAM
is NIL, then the result is a string; otherwise code is output to the OUTPUT-STREAM stream.
"Compiles the given Parenscript source file and outputs the results
to the given output stream."
(setf (comp-env-compiling-toplevel-p comp-env) t)
- (error "NOT IMPLEMENTED."))
-
+ (with-open-file (input source-file :direction :input)
+ (let ((end-read-form '#:unique))
+ (flet ((read-form ()
+ (parenscript.reader:read input nil end-read-form)))
+ (macrolet ((with-output-stream ((var) &body body)
+ `(if (null output-stream)
+ (with-output-to-string (,var)
+ ,@body)
+ (let ((,var output-stream))
+ ,@body))))
+ (let* ((*compilation-environment* comp-env)
+ (compiled
+ (do ((form (read-form) (read-form))
+ (compiled-forms nil))
+ ((eql form end-read-form)
+ (compile-parenscript-form
+ comp-env
+ `(progn ,@(nreverse compiled-forms))
+ :toplevel-p nil))
+ (let ((tl-compiled-form
+ (compile-parenscript-form comp-env form :toplevel-p t)))
+ (push tl-compiled-form compiled-forms)))))
+ (with-output-stream (output)
+ (translate-ast
+ compiled
+ :comp-env comp-env
+ :output-stream output
+ :output-spec output-spec
+ :pretty-print pretty-print))))))))
+
;(defun compile-script-file (script-src-file
; &key
; (output-spec :javascript)
Body is evaluated."
`(compile-script (progn ,@body)))
-;; DEPRECATED
-(defmacro js (&body body)
- "A macro that returns a javascript string of the supplied Parenscript forms."
- `(script ,@body))
-
-(defmacro js* (&body body)
- `(script* ,@body))
-
-(defun js-to-string (expr)
- "Given an AST node, compiles it to a Javascript string."
- (string-join
- (js-to-statement-strings (compile-script-form expr) 0)
- (string #\Newline)))
-
-(defun js-to-line (expr)
- "Given an AST node, compiles it to a Javascript string."
- (string-join
- (js-to-statement-strings (compile-script-form expr) 0) " "))
-
-
;;; old file compilation functions:
-(defun compile-parenscript-file-to-string (source-file
- &key
- (log-stream nil)
- (comment nil)
- (eval-forms-p nil))
+(defun compile-parenscript-file-to-string (source-file)
"Compile SOURCE-FILE (a parenscript file) to a javascript string. (in-package ...) forms
behave as expected and all other forms are evaluated according to the value of
EVAL-FORMS-P. If the result of the evaluation is not nil then it's compiled with
js:js* and written to the output."
- (with-output-to-string (output)
- (with-open-file (input source-file :direction :input)
- (flet ((read-form ()
- (read input nil))
- (log-message (&rest args)
- (when log-stream
- (apply #'format log-stream args))))
- (let ((*package* *package*))
- (loop for form = (read-form)
- while form do
- (if (or (not (listp form))
- (not (eq (car form) 'cl:in-package)))
- (progn
- (log-message "Processing form:~%~S~%" form)
- (when comment
- (princ "/*" output)
- (print form output)
- (terpri output)
- (princ "*/" output)
- (terpri output))
- (when eval-forms-p
- (setf form (eval form)))
- (log-message "After evaluation:~%~S~%" form)
- (when form
- (let ((compiled (js:js* form)))
- (log-message "Compiled into:~%~A~%~%" compiled)
- (write-string compiled output)
- (terpri output)
- (terpri output))))
- (when (and (listp form)
- (eq (car form) 'cl:in-package))
- (log-message "Setting package to: ~S~%" (cadr form))
- (setf *package* (find-package (cadr form)))))))))))
-
+ (compile-script-file source-file :output-stream nil))
+
(defun compile-parenscript-file (source-file &rest args &key destination-file &allow-other-keys)
"Compile SOURCE-FILE (a parenscript file) to a javascript file with
compile-parenscript-file-to-string. When DESTINATION-FILE is omitted,
source-file)))
(with-open-file (output destination-file :if-exists :supersede :direction :output)
(write-string (apply #'compile-parenscript-file-to-string source-file args) output)))
+
+;; DEPRECATED
+(defmacro js (&body body)
+ "A macro that returns a javascript string of the supplied Parenscript forms."
+ `(script ,@body))
+
+(defmacro js* (&body body)
+ `(script* ,@body))
+
+(defun js-to-string (expr)
+ "Given an AST node, compiles it to a Javascript string."
+ (string-join
+ (ps-js::js-to-statement-strings (compile-script-form expr) 0)
+ (string #\Newline)))
+
+(defun js-to-line (expr)
+ "Given an AST node, compiles it to a Javascript string."
+ (string-join
+ (ps-js::js-to-statement-strings (compile-script-form expr) 0) " "))
\ No newline at end of file
(defscriptliteral this "this")
(defscriptliteral t "true")
-(defscriptliteral nil "null")
+(defscriptliteral true "true")
(defscriptliteral false "false")
+(defscriptliteral f "false")
+(defscriptliteral nil "null")
(defscriptliteral undefined "undefined")
(defmacro defscriptkeyword (name string)
-(in-package :cl-user)
-
-(defpackage parenscript.javascript
- (:use :common-lisp)
- (:nicknames javascript ps-js)
- (:export
-
- #:new
- ;; literals
- #:t
- #:nil
- #:this
- #:false
- #:undefined
-
- ;; keywords
- #:break
- #:continue
-
- ;; array literals
- #:array
- #:list
- #:aref
- #:make-array
-
- ;; operators
- #:! #:not #:~
- #:* #:/ #:%
- #:+ #:-
- #:<< #:>>
- #:>>>
- #:< #:> #:<= #:>=
- #:in
- #:eql #:== #:!= #:=
- #:=== #:!==
- #:&
- #:^
- #:\|
- #:\&\& #:and
- #:\|\| #:or
- #:>>= #:<<=
- #:*= #:/= #:%= #:+= #:\&= #:^= #:\|= #:~=
- #:++ #:--
- #:1+ #:1-
- #:incf #:decf
-
- ;; body forms
- #:progn
-
- ;; function definition
- #:defun
- #:lambda
-
- ;; object literals
- #:create
- #:slot-value
- #:with-slots
-
- ;; macros
- #:macrolet
- #:symbol-macrolet
-
- ;; if
- #:if
- #:when
- #:unless
-
- ;; single argument statements
- #:return
- #:throw
-
- ;; single argument expressions
- #:delete
- #:void
- #:typeof
- #:instanceof
- #:new
-
- ;; assignment
- #:setf
-
- ;; variables
- #:defvar
-
- ;; iteration
- #:for
- #:doeach
- #:while
-
- ;; with
- #:with
-
- ;; case
- #:switch
- #:case
- #:default
-
- ;; try throw catch
- #:try
-
- ;; regex literals
- #:regex
-
- ;; conditional compilation (IE)
- #:cc-if
-
- ;; translate
- #:js-to-strings
- #:js-to-statement-strings
- )
- (:documentation "The package used to define Javascript special forms. Most of Parenscript
-is defined as macros on top of Javascript special forms"))
-
-(defpackage :parenscript
- (:use :common-lisp :parenscript.javascript)
- (:nicknames :js :ps)
- (:export
- ;; addition js symbols
- #:new
-
- ;; literals
- #:t
- #:nil
- #:this
- #:false
- #:undefined
-
- ;; keywords
- #:break
- #:continue
-
- ;; array literals
- #:array
- #:list
- #:aref
- #:make-array
-
- ;; operators
- #:! #:not #:~
- #:* #:/ #:%
- #:+ #:-
- #:<< #:>>
- #:>>>
- #:< #:> #:<= #:>=
- #:in
- #:eql #:== #:!= #:=
- #:=== #:!==
- #:&
- #:^
- #:\|
- #:\&\& #:and
- #:\|\| #:or
- #:>>= #:<<=
- #:*= #:/= #:%= #:+= #:\&= #:^= #:\|= #:~=
- #:++ #:--
- #:1+ #:1-
- #:incf #:decf
-
- ;; body forms
- #:progn
-
- ;; function definition
- #:defun
- #:lambda
-
- ;; object literals
- #:create
- #:slot-value
- #:with-slots
-
- ;; macros
- #:macrolet
- #:symbol-macrolet
-
- ;; lisp eval
- #:lisp
-
- ;; if
- #:if
- #:when
- #:unless
-
- ;; single argument statements
- #:return
- #:throw
-
- ;; single argument expressions
- #:delete
- #:void
- #:typeof
- #:instanceof
- #:new
-
- ;; assignment
- #:setf
-
- ;; variables
- #:defvar
- #:let
-
- ;; iteration
- #:do
- #:dotimes
- #:dolist
- #:doeach
- #:while
-
- ;; with
- #:with
-
- ;; case
- #:switch
- #:case
- #:default
-
- ;; try throw catch
- #:try
-
- ;; regex literals
- #:regex
-
- ;; conditional compilation (IE)
- #:cc-if
-
- ;; math library
- #:floor
- #:random
-
- ;; html generator for javascript
- #:html
-
- ;; compiler
- #:compile-script
- #:compile-parenscript-file
- #:compile-parenscript-file-to-string
- #:script
- #:with-new-compilation-environment ; tentative
- #:with-compilation-environment ; tentative
- #:*compilation-environment*
-
- ;; package system
- #:find-script-package
- #:script-intern
- #:script-export
- #:find-script-symbol
- #:comp-env-current-package
- #:symbol-script-package
- #:script-package-name
-
- ;; for parenscript macro definition within lisp
- #:defscriptmacro #:defpsmacro ; should we use one or the other of these?
- #:defmacro/js
- #:defmacro+js
- #:import-macros-from-lisp
-
- ;; util
- #:with-unique-js-names
- #:gen-js-name
- #:gen-js-name-string
-
- ;; CSS
- #:css
- #:css-to-string
- #:css-inline
- #:css-file
-
- ;; deprecated interface
- #:defjsmacro
- #:js-compile
- #:js ; replaced by #:script
- #:js*
- #:js-inline
- #:js-inline*
- #:js-file
- #:js-script
- #:js-to-strings
- #:js-to-statement-strings
- #:js-to-string
- #:js-to-line
- )
- (:intern
- #:define-script-special-form
- #:defscriptclass
- #:symbol-to-js
- #:script-quote
- #:*package-prefix-style*
- #:*script-macro-env*
- #:compile-to-statement
- #:compile-to-block
- #:compile-to-symbol
- #:compile-to-expression
- #:list-join
- #:list-to-string
- #:append-to-last
- #:prepend-to-first
- #:string-join
- #:val-to-string
- #:string-split
- #:script-special-form-p
- #:make-macro-env-dictionary
- #:compile-script-form
- )
- )
-
-(in-package :parenscript)
-
-(import
- '(defscriptclass
- define-script-special-form
- defscriptmacro
- symbol-to-js
- script-quote
- *package-prefix-style*
- *script-macro-env*
- compile-to-statement
- compile-to-block
- compile-to-symbol
- compile-to-expression
- symbol-script-package
- script-package-name
- list-join
- list-to-string
- append-to-last
- prepend-to-first
- string-join
- val-to-string
- string-split
- script-special-form-p
- make-macro-env-dictionary
- js-equal
- compile-script-form
- )
- :parenscript.javascript)
-
-(defpackage parenscript.reader
- (:nicknames parenscript-reader)
- (:use :common-lisp :parenscript)
- (:shadow readtablep
- readtable-case
- copy-readtable
- get-macro-character
- get-dispatch-macro-character
- set-macro-character
- set-dispatch-macro-character
- make-dispatch-macro-character
- set-syntax-from-char
- read-preserving-whitespace
- read
- read-from-string
- read-delimited-list
- backquote-comma-dot
- backquote
- backquote-comma
- backquote-comma-at
-
- *read-eval*
- *read-base*
- *read-default-float-format*
- *read-suppress*
- *readtable*
- *read-suppress*
- *reader-error*
- *read-suppress*
-
- readtable
- backquote
- reader-error)
- (:export
- read
- read-from-string
- read-delimited-list))
-
-(defpackage parenscript.global
- (:nicknames global)
- (:documentation "Symbols interned in the global package are serialized in Javascript
-as non-prefixed identifiers."))
-
-(defpackage parenscript.user
- (:nicknames ps-user paren-user parenscript-user)
- (:documentation "The default package a user is inside of when compiling code."))
\ No newline at end of file
+(in-package :cl-user)
+;;;; Package definitions for the Parenscript
+;; #:
+
+(eval-when (:compile-toplevel :load-toplevel)
+ ;; exports shared between PARENSCRIPT and PARENSCRIPT.JAVASCRIPT
+ (defparameter *shared-symbols-ps-js*
+ '(
+ ;; literals
+ #:t
+ #:f
+ #:true
+ #:nil
+ #:this
+ #:false
+ #:undefined
+
+ ;; keywords
+ #:break
+ #:continue
+
+ ;; array literals
+ #:array
+ #:list
+ #:aref
+ #:make-array
+
+ ;; operators
+ #:! #:not #:~
+ #:* #:/ #:%
+ #:+ #:-
+ #:<< #:>>
+ #:>>>
+ #:< #:> #:<= #:>=
+ #:in
+ #:eql #:== #:!= #:=
+ #:=== #:!==
+ #:&
+ #:^
+ #:\|
+ #:\&\& #:and
+ #:\|\| #:or
+ #:>>= #:<<=
+ #:*= #:/= #:%= #:+= #:\&= #:^= #:\|= #:~=
+ #:++ #:--
+ #:1+ #:1-
+ #:incf #:decf
+
+ ;; body forms
+ #:progn
+
+ ;; function definition
+ #:defun
+ #:lambda
+
+ ;; object literals
+ #:create
+ #:slot-value
+ #:with-slots
+
+ ;; macros
+ #:macrolet
+ #:symbol-macrolet
+
+ ;; if
+ #:if
+ #:when
+ #:unless
+
+ ;; single argument statements
+ #:return
+ #:throw
+
+ ;; single argument expressions
+ #:delete
+ #:void
+ #:typeof
+ #:instanceof
+ #:new
+
+ ;; assignment
+ #:setf
+
+ ;; variables
+ #:defvar
+
+ ;; iteration
+ #:for
+ #:doeach
+ #:while
+
+ ;; with
+ #:with
+
+ ;; case
+ #:switch
+ #:case
+ #:default
+
+ ;; try throw catch
+ #:try
+
+ ;; regex literals
+ #:regex
+
+ ;; conditional compilation (IE)
+ #:cc-if)
+ "Symbols exported from both the Parenscript and Javascript packages
+that are also valid as Parenscript symbols for the corresponding script packages."))
+
+
+
+(defpackage parenscript.javascript
+ (:use :common-lisp)
+ (:nicknames javascript ps-js)
+ #.(cons :export *shared-symbols-ps-js*)
+ (:export
+ ;; translate
+ #:js-to-strings
+ #:js-to-statement-strings
+ )
+ (:documentation "The package used to define Javascript special forms. Most of Parenscript
+is defined as macros on top of Javascript special forms"))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *parenscript-lang-exports*
+ (append
+ *shared-symbols-ps-js*
+ '(
+ ;; package system
+ #:defpackage
+ #:in-package
+
+ ;; eval-when
+ #:eval-when
+ ;; macros
+ #:macrolet
+ #:symbol-macrolet
+
+ ;; lisp eval
+ #:lisp
+
+ ;; assignment
+ #:setf
+
+ #:let
+
+ ;; iteration
+ #:do
+ #:dotimes
+ #:dolist
+ #:doeach
+ #:while
+
+ ;; v v v STUFF WE SHOULD PROBABLY MOVE TO OTHER LIBS v v v
+
+ ;; CSS
+ #:css
+ #:css-to-string
+ #:css-inline
+ #:css-file
+
+ ;; math library
+ #:floor
+ #:random
+
+ ;; html generator for javascript
+ #:html
+ ))
+ "List of (uninterned) symbols. Contains all symbols considerred
+part of the Parenscript language. These should be exported within
+both the Lisp package and the script package for Parenscript."))
+
+(defpackage :parenscript
+ (:use :common-lisp :parenscript.javascript)
+ (:nicknames :js :ps)
+ #.(cons :export *shared-symbols-ps-js*)
+ #.(cons :export *parenscript-lang-exports*)
+ (:export
+ ;; compiler
+ #:compile-script
+ #:compile-script-file
+ #:compile-parenscript-file
+ #:compile-parenscript-file-to-string
+ #:script
+ #:with-new-compilation-environment ; tentative
+ #:with-compilation-environment ; tentative
+ #:*compilation-environment*
+
+ ;; package system
+ #:find-script-package
+ #:script-intern
+ #:script-export
+ #:find-script-symbol
+ #:comp-env-current-package
+ #:symbol-script-package
+ #:script-package-name
+
+ ;; for parenscript macro definition within lisp
+ #:defscriptmacro
+ #:defpsmacro ; should we use one or the other of these?
+ #:defmacro/js
+ #:defmacro+js
+ #:import-macros-from-lisp
+
+ ;; util
+ #:with-unique-js-names
+ #:gen-js-name
+ #:gen-js-name-string
+
+ ;; deprecated interface
+ #:defjsmacro
+ #:js-compile
+ #:js ; replaced by #:script
+ #:js*
+ #:js-inline
+ #:js-inline*
+ #:js-file
+ #:js-script
+ #:js-to-strings
+ #:js-to-statement-strings
+ #:js-to-string
+ #:js-to-line
+ ))
+
+(in-package :parenscript)
+(import
+ '(defscriptclass
+ define-script-special-form
+ defscriptmacro
+ symbol-to-js
+ script-quote
+ *package-prefix-style*
+ *script-macro-env*
+ compile-to-statement
+ compile-to-block
+ compile-to-symbol
+ compile-to-expression
+ symbol-script-package
+ script-package-name
+ list-join
+ list-to-string
+ append-to-last
+ prepend-to-first
+ string-join
+ val-to-string
+ string-split
+ script-special-form-p
+ make-macro-env-dictionary
+ js-equal
+ compile-script-form
+ )
+ :parenscript.javascript)
+
+(defpackage parenscript.reader
+ (:nicknames parenscript-reader)
+ (:use :common-lisp :parenscript)
+ (:shadow #:readtablep
+ #:readtable-case
+ #:copy-readtable
+ #:get-macro-character
+ #:get-dispatch-macro-character
+ #:set-macro-character
+ #:set-dispatch-macro-character
+ #:make-dispatch-macro-character
+ #:set-syntax-from-char
+ #:read-preserving-whitespace
+ #:read
+ #:read-from-string
+ #:read-delimited-list
+ #:backquote-comma-dot
+ #:backquote
+ #:backquote-comma
+ #:backquote-comma-at
+
+ #:*read-eval*
+ #:*read-base*
+ #:*read-default-float-format*
+ #:*read-suppress*
+ #:*readtable*
+ #:*read-suppress*
+ #:*reader-error*
+ #:*read-suppress*
+
+ #:readtable
+ #:backquote
+ #:reader-error)
+ (:export
+ #:read
+ #:read-from-string
+ #:read-delimited-list)
+ (:documentation "The Parenscript reader. Used for reading Parenscript
+forms."))
+
+(defpackage parenscript.global
+ (:nicknames "GLOBAL")
+ (:documentation "Symbols interned in the global package are serialized in Javascript
+as non-prefixed identifiers."))
+
+(defpackage parenscript.user
+ (:use :parenscript)
+ (:nicknames ps-user paren-user parenscript-user)
+ (:documentation "The default package a user is inside of when compiling code."))
\ No newline at end of file
;;;; The mechanisms for defining macros & parsing Parenscript.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *enable-package-system* t
+ "When NIL, all symbols will function as global symbols."))
+
+(eval-when (:compile-toplevel :load-toplevel)
+ (defun macro-name-hash-function ()
+ (if *enable-package-system* #'eql #'equal)))
+
(defclass script-package ()
;; configuration slots
((name :accessor script-package-name :initform nil :initarg :name :type string
; Probably not used except for built-in packages."))
)
(:documentation "A Parenscript package is a lisp object that holds information
-about a set of Suavescript code."))
+about a set of code.
+
+"))
(defclass compilation-environment ()
((script-packages :accessor comp-env-script-packages :initform nil :initarg :packages
;; as arguments.
)
-(defvar *enable-package-system* t
- "When NIL, all symbols will function as global symbols.")
-
(defvar *package-prefix-style* :prefix
"Determines how package symbols are serialized to JavaScript identifiers. NIL for
no prefixes. :prefix to prefix variables with something like packagename_identifier.")
"Find the script package with the name NAME in the given compilation environment."
(typecase name
((or symbol string)
- (find (string name) (comp-env-script-packages comp-env)
- :test #'equal :key #'script-package-name))
+ (find-if #'(lambda (script-package)
+ (find (string name)
+ (cons (script-package-name script-package)
+ (script-package-nicknames script-package))
+ :test #'equal))
+ (comp-env-script-packages comp-env)))
(script-package name)
(t (error "~A has unknown type" name))))
"Returns a Parenscript symbol with the string value STRING interned for the
given SCRIPT-PACKAGE."
(setf script-package (find-script-package script-package))
- (intern name (script-package-lisp-package script-package)))
+ (flet ((find-exported-symbol (name script-package)
+ (let ((res
+ (find name (script-package-exports script-package)
+ :key #'(lambda (exported-symbol) (string exported-symbol))
+ :test #'equal)))
+; (format t "Searching for exported symbol ~A in ~A: ~A~%"
+; name (script-package-name script-package) res)
+ res)))
+ (let ((res
+ (or
+ (some #'(lambda (used-package)
+ (find-exported-symbol name used-package))
+ (script-package-used-packages script-package))
+ (intern name (script-package-lisp-package script-package)))))
+ (declare (type symbol res))
+ res)))
+
-(defun script-export (symbols &optional (script-package (comp-env-current-package *compilation-environment*)))
- "Exports the given symbols in the given script package."
- (when (symbolp symbols)
- (setf symbols (list symbols)))
- ;; TODO check to make sure symbols are each interned under SCRIPT-PACKAGE
- (mapc #'(lambda (sym)
- (pushnew sym (script-package-exports script-package)))
- symbols)
- t)
-
(defun find-script-symbol (name script-package)
"Finds the symbol with name NAME in the script package SCRIPT-PACKAGE. NAME is a
string and SCRIPT-PACKAGE is a package designator. If NAME does not specify a symbol of
(exported? (find symbol (script-package-exports script-package))))
(values symbol (if exported? :external (when symbol :internal)))))
-;; environmental considerations
-(defgeneric install-standard-script-packages (comp-env)
- (:documentation "Creates standard script packages and installs them in the current compilation
-environment.")
- (:method ((comp-env compilation-environment))
- (list
- (create-script-package
- comp-env
- :name "GLOBAL" :lisp-package :parenscript.global
- :secondary-lisp-packages '(:keyword))
- (create-script-package
- comp-env
- :name "JAVASCRIPT" :nicknames (list "JS") :lisp-package :parenscript.javascript
- :secondary-lisp-packages '(:common-lisp))
- (create-script-package
- comp-env
- :name "PARENSCRIPT" :lisp-package :parenscript
- :used-packages '(:javascript)
- )
- (create-script-package
- comp-env
- :name "PARENSCRIPT-USER" :lisp-package :parenscript-user
- :secondary-lisp-packages (list :cl-user)
- :nicknames '("PS-USER" "PAREN-USER")))))
+(defun script-export (symbols
+ &optional (script-package (comp-env-current-package *compilation-environment*)))
+ "Exports the given symbols in the given script package."
+ (when (not (listp symbols)) (setf symbols (list symbols)))
+ (setf script-package (find-script-package script-package))
+; (format t "Exporting symbols ~A in package ~A~%"
+; symbols (script-package-name script-package))
+ (let ((symbols-not-in-package
+ (remove-if #'(lambda (symbol)
+ (declare (type symbol symbol))
+ (eql symbol (find-script-symbol (string symbol) script-package)))
+ symbols)))
+ (when symbols-not-in-package
+ (error "Invalid exports. The following symbols are not interned in the package ~A:~%~A"
+ (script-package-name script-package) symbols-not-in-package)))
+ (mapc #'(lambda (symbol)
+ (pushnew symbol (script-package-exports script-package)))
+ symbols)
+ t)
+
+(defun use-script-package (packages-to-use
+ &optional (into-package (comp-env-current-package *compilation-environment*)))
+ "use-script-package causes INTO-PACKAGE to inherit all the external symbols of packages-to-use.
+The inherited symbols become accessible as internal symbols of package."
+ (when (not (listp packages-to-use)) (setf packages-to-use (list packages-to-use)))
+ (setf packages-to-use (mapcar #'find-script-package packages-to-use))
+ (setf into-package (find-script-package into-package))
+
+ (let ((all-used-symbols (apply #'append (mapcar #'script-package-exports packages-to-use))))
+ (mapc #'(lambda (used-symbol)
+ (let ((symbol-same-name (find-script-symbol (string used-symbol) into-package)))
+ (when (not (or (null symbol-same-name)
+ (eql symbol-same-name used-symbol)))
+ (error "Import of symbol ~A into package ~A conflicts with interned symbol ~A"
+ used-symbol (script-package-name into-package) symbol-same-name))))
+ all-used-symbols))
+ (setf (script-package-used-packages into-package)
+ (append (script-package-used-packages into-package) packages-to-use)))
+
+
+;; environmental considerations
(defgeneric setup-compilation-environment (comp-env)
(:documentation "Sets up a basic compilation environment prepared for a language user.
This should do things like define packages and set the current package.
-Returns the compilation-environment.")
- (:method ((comp-env compilation-environment))
- (install-standard-script-packages comp-env)
- (setf (comp-env-current-package comp-env)
- (find-script-package :parenscript-user comp-env))
- comp-env))
+Returns the compilation-environment."))
+
+(defgeneric install-standard-script-packages (comp-env)
+ (:documentation "Creates standard script packages and installs them in the current compilation
+environment."))
(defun make-basic-compilation-environment ()
"Creates a compilation environment object from scratch. Fills it in with the default
script packages (parenscript, global, and parenscript-user)."
- (setup-compilation-environment (make-instance 'compilation-environment)))
+ (let ((*compilation-environment* (make-instance 'compilation-environment)))
+ (setup-compilation-environment *compilation-environment*)))
(defun create-script-package (comp-env
&key name nicknames secondary-lisp-packages used-packages
lisp-package exports documentation)
"Creates a script package in the given compilation environment"
- (labels ((normalize (string-like) (string string-like)))
- (let* ((explicit-lisp-package-p (not (null lisp-package)))
- (lisp-package
- (or (and explicit-lisp-package-p (find-package lisp-package))
- (make-package (gensym (string name))))))
- (labels ((package-intern (string-like)
- (intern (normalize string-like) lisp-package)))
- (let ((script-package
- (make-instance 'script-package
- :name (normalize name)
- :comp-env comp-env
- :nicknames (mapcar #'normalize nicknames)
- :lisp-package (find-package lisp-package)
- :secondary-lisp-packages (mapcar #'find-package secondary-lisp-packages)
- :exclusive-lisp-package? (not explicit-lisp-package-p)
- :exports (mapcar #'package-intern exports)
- :used-packages (mapcar #'(lambda (script-package-designator)
- (find-script-package
- script-package-designator comp-env))
- used-packages)
- :documentation documentation)))
- (push script-package (comp-env-script-packages comp-env)))))))
+ (let* ((explicit-lisp-package-p (not (null lisp-package)))
+ (lisp-package
+ (or (and explicit-lisp-package-p (find-package lisp-package))
+ (make-package (gensym (string name))))))
+ (let ((script-package
+ (make-instance 'script-package
+ :name (string name)
+ :comp-env comp-env
+ :nicknames (mapcar #'string nicknames)
+ :lisp-package (find-package lisp-package)
+ :secondary-lisp-packages (mapcar #'find-package secondary-lisp-packages)
+ :exclusive-lisp-package? (not explicit-lisp-package-p)
+ :documentation documentation)))
+ (use-script-package used-packages script-package)
+; (format t "CSP exports for ~A: ~A~%" (script-package-name script-package) exports)
+ (labels ((package-intern (string-like)
+ (script-intern (string string-like) script-package)))
+ (script-export (mapcar #'package-intern exports) script-package))
+ (push script-package (comp-env-script-packages comp-env))
+ script-package)))
(defmethod initialize-instance :after ((package script-package) &key)
(assert (script-package-comp-env package))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *toplevel-special-forms* (make-hash-table)
+ (defvar *toplevel-special-forms* (make-hash-table :test (macro-name-hash-function))
"A hash-table containing functions that implement Parenscript special forms,
indexed by name (as symbols)")
-
(defun undefine-script-special-form (name)
"Undefines the special form with the given name (name is a symbol)."
(declare (type symbol name))
(intern (format nil "PAREN-~A" (symbol-name name))
(find-package :parenscript)))
(arglist (gensym "ps-arglist-")))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun ,script-name (&rest ,arglist)
- (destructuring-bind ,lambda-list
- ,arglist
- ,@body))
- (setf (gethash (quote ,name) *toplevel-special-forms*) #',script-name))))
+ `(setf (gethash (quote ,name) *toplevel-special-forms*)
+ #'(lambda (&rest ,arglist)
+ (destructuring-bind ,lambda-list
+ ,arglist
+ ,@body)))))
+
(defun get-script-special-form (name)
"Returns the special form function corresponding to the given name."
; (declare (type symbol name))
- (when (symbolp name)
- (gethash name *toplevel-special-forms*)))
+ (cond
+ (*enable-package-system*
+ (when (symbolp name)
+ (gethash name *toplevel-special-forms*)))
+ (t
+ (when (symbolp name)
+ (maphash #'(lambda (macro-name value)
+ (when (equal (string macro-name) (string name))
+ (return-from get-script-special-form value)))
+ *toplevel-special-forms*)))))
;;; sexp form predicates
(defun script-special-form-p (form)
"Returns T if FORM is a special form and NIL otherwise."
(and (consp form)
(symbolp (car form))
- (gethash (car form) *toplevel-special-forms*)))
+ (get-script-special-form (car form))))
(defun funcall-form-p (form)
(and (listp form)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-macro-env-dictionary ()
"Creates a standard macro dictionary."
- (make-hash-table))
+ (make-hash-table :test (macro-name-hash-function)))
(defvar *script-macro-toplevel* (make-macro-env-dictionary)
"Toplevel macro environment dictionary. Key is symbol-name of the macro, value
is (symbol-macro-p . expansion-function).")
(defvar *script-macro-env* (list *script-macro-toplevel*) ;(list nil)
- "Current macro environment."))
+ "Current macro environment.")
+
+ (defun find-macro-spec (name env-dict)
+ (if *enable-package-system*
+ (gethash name env-dict)
+ (with-hash-table-iterator (next-entry env-dict)
+ (loop
+ (multiple-value-bind (exists? macro-name spec)
+ (next-entry)
+ (if exists?
+ (when (equal (string macro-name) (string name))
+ (return spec))
+ (return nil)))))))
+ (defsetf find-macro-spec (name env-dict)
+ (spec)
+ `(setf (gethash ,name ,env-dict) ,spec)))
+
(defmacro get-macro-spec (name env-dict)
"Retrieves the macro spec of the given name with the given environment dictionary.
SPEC is of the form (symbol-macro-op expansion-function)."
- `(gethash ,name ,env-dict))
+ `(find-macro-spec ,name ,env-dict))
(defun lookup-macro-spec (name &optional (environment *script-macro-env*))
"Looks up the macro spec associated with NAME in the given environment. A
(:use (setf used-packages (rest opt)))
(:documentation (setf documentation (second opt)))
(t (error "Unknown option in DEFPACKAGE: ~A" (opt-name opt)))))
+ (format t "Exports: ~A~%" exports)
(create-script-package
*compilation-environment*
:name name
(defscriptmacro in-package (package-designator)
"Changes the current script package in the parenscript compilation environment. This mostly
affects the reader and how it interns non-prefixed symbols"
- (setf (comp-env-current-package *compilation-environment*)
- (find-script-package package-designator *compilation-environment*))
- `(progn))
+ (let ((script-package
+ (find-script-package package-designator *compilation-environment*)))
+ (when (null script-package)
+ (error "~A does not designate any script package. Available script package: ~A"
+ package-designator
+ (mapcar #'script-package-name (comp-env-script-packages *compilation-environment*))))
+ (setf (comp-env-current-package *compilation-environment*)
+ script-package)
+ `(progn)))
(defscriptmacro case (value &rest clauses)
(labels ((make-clause (val body more)
"Ensures that the symbol with name NAME is external for the given script package PACKAGE.
Raises a continuable error if NAME is not external in PACKAGE. Otherwise interns NAME
in PACKAGE and returns the symbol."
- (multiple-value-bind (symbol status)
- (find-script-symbol name package)
- (unless (eq status :external)
- (cerror (if (null status)
- "Intern and export script symbol ~S in package ~S."
- "Export script symbol ~S in package ~S.")
- "There is no external symbol by the name of ~S in script package ~S."
- name package)
- (script-export (setq symbol (script-intern name package)) package))
- symbol))
+ (if package
+ (multiple-value-bind (symbol status)
+ (find-script-symbol name package)
+ (unless (eq status :external)
+ (cerror (if (null status)
+ "Intern and export script symbol ~S in package ~S."
+ "Export script symbol ~S in package ~S.")
+ "There is no external symbol by the name of ~S in script package ~S."
+ name package)
+ (script-export (setq symbol (script-intern name package)) package))
+ symbol)
+ (script-intern name "KEYWORD")))
(defun construct-symbol (lexemes &key uninterned-symbol-wanted)
(labels ((up (x) (if (listp x) (copy-list x) (list (char-upcase x))))
until (and (char= c #\|) (char= (read-char stream t nil t) #\#)))
(values))
+(defun sharp-l (stream sub-char n)
+ "#L uses the Lisp reader for the next form."
+ (declare (ignore sub-char n))
+ (cl:read stream))
+
(defvar *standard-syntax-table*
(let ((table (make-hash-table)))
(#\* sharp-asterisk) (#\: sharp-colon) (#\. sharp-dot) (#\b sharp-b)
(#\o sharp-o) (#\x sharp-x) (#\r sharp-r) (#\c sharp-c) (#\a sharp-a)
(#\s sharp-s) (#\p sharp-p) (#\= sharp-equal) (#\# sharp-sharp)
- (#\+ sharp-plus) (#\- sharp-minus) (#\| sharp-vertical-bar)))
+ (#\+ sharp-plus) (#\- sharp-minus) (#\| sharp-vertical-bar)
+ (#\L sharp-l)))
(setq *readtable* (copy-readtable nil))
+
+
-(in-package :js-test)
+(in-package :ps-test)
;; Other tests not in the reference
(eval-when (:compile-toplevel :load-toplevel :execute)
-(in-package :js-test)
+(in-package :ps-test)
;;Generates automatic tests from the reference
(defparameter +this-dir+ (asdf:component-pathname (asdf:find-component (asdf:find-system :parenscript.test) "t")))
:type "lisp"
:defaults +this-dir+))
-(defparameter +head+ "(in-package :js-test)
+(defparameter +head+ "(in-package :ps-test)
;; Tests of everything in the reference.
;; File is generated automatically from the text in reference.lisp by
;; the function make-reference-tests-dot-lisp in ref2test.lisp
:test #'char=)))
(strip-indentation (str indentation)
(if indentation
- (js::string-join (mapcar #'(lambda (str)
+ (parenscript::string-join (mapcar #'(lambda (str)
(if (> (length str) indentation)
(subseq str indentation)
str))
- (js::string-split str (list #\Newline)))
+ (parenscript::string-split str (list #\Newline)))
(string #\Newline))
str))
-(in-package :js-test)
+(in-package :ps-test)
;; Tests of everything in the reference.
;; File is generated automatically from the text in reference.lisp by
;; the function make-reference-tests-dot-lisp in ref2test.lisp
(in-package :cl-user)
(defpackage :parenscript-test
- (:nicknames :js-test)
+ (:nicknames :ps-test :ps-tests :parenscript-tests)
(:use :common-lisp :js :5am)
(:shadowing-import-from :js :!)
(:export #:run-tests
-(in-package :js-test)
+(in-package :ps-test)
;; Testcases for parenscript
HCoop / clinton / parenscript.git / commitdiff