Basic DEFCONSTANT

[jscl.git] / ecmalisp.lisp

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index 77495e8..ae075ed 100644 (file)
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -42,10 +42,17 @@
     `(eval-when-compile
        ,@(mapcar (lambda (decl) `(!proclaim ',decl)) decls)))
 
-  (declaim (constant nil t) (special t nil))
-  (setq nil 'nil)
+  (defmacro defconstant (name value &optional docstring)
+    `(progn
+       (declaim (special ,name))
+       (declaim (constant ,name))
+       (setq ,name ,value)
+       ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+       ',name))
+
+  (defconstant t 't)
+  (defconstant nil 'nil)
   (js-vset "nil" nil)
-  (setq t 't)
 
   (defmacro lambda (args &body body)
     `(function (lambda ,args ,@body)))
@@ -2330,31 +2337,31 @@
   (defun eval (x)
     (js-eval (ls-compile-toplevel x t)))
 
-  (export '(&rest &key &optional &body * *gensym-counter* *package*
-           + - / 1+ 1- < <= = = > >= and append apply aref arrayp
-           assoc atom block boundp boundp butlast caar cadddr caddr
-           cadr car car case catch cdar cdddr cddr cdr cdr char
-            char-code char= code-char cond cons consp constantly
-            copy-list decf declaim defparameter defun defmacro defvar
-            digit-char digit-char-p disassemble do do* documentation
-            dolist dotimes ecase eq eql equal error eval every export
-            fdefinition find-package find-symbol first flet fourth
-            fset funcall function functionp gensym get-universal-time
-            go identity if in-package incf integerp integerp intern
-            keywordp labels lambda last length let let*
-            list-all-packages list listp make-array make-package
-            make-symbol mapcar member minusp mod multiple-value-bind
-            multiple-value-call multiple-value-list
-            multiple-value-prog1 nil not nth nthcdr null numberp or
-            package-name package-use-list packagep parse-integer plusp
-            prin1-to-string print proclaim prog1 prog2 progn psetq
-            push quote remove remove-if remove-if-not return
-            return-from revappend reverse rplaca rplacd second set
-            setq some string-upcase string string= stringp subseq
-            symbol-function symbol-name symbol-package symbol-plist
-            symbol-value symbolp t tagbody third throw truncate unless
-            unwind-protect values values-list variable warn when
-            write-line write-string zerop))
+  (export '(&rest &key &optional &body * *gensym-counter* *package* +
+           - / 1+ 1- < <= = = > >= and append apply aref arrayp assoc
+           atom block boundp boundp butlast caar cadddr caddr cadr
+           car car case catch cdar cdddr cddr cdr cdr char char-code
+           char= code-char cond cons consp constantly copy-list decf
+           declaim defconstant defparameter defun defmacro defvar
+           digit-char digit-char-p disassemble do do* documentation
+           dolist dotimes ecase eq eql equal error eval every export
+           fdefinition find-package find-symbol first flet fourth
+           fset funcall function functionp gensym get-universal-time
+           go identity if in-package incf integerp integerp intern
+           keywordp labels lambda last length let let*
+           list-all-packages list listp make-array make-package
+           make-symbol mapcar member minusp mod multiple-value-bind
+           multiple-value-call multiple-value-list
+           multiple-value-prog1 nil not nth nthcdr null numberp or
+           package-name package-use-list packagep parse-integer plusp
+           prin1-to-string print proclaim prog1 prog2 progn psetq
+           push quote remove remove-if remove-if-not return
+           return-from revappend reverse rplaca rplacd second set
+           setq some string-upcase string string= stringp subseq
+           symbol-function symbol-name symbol-package symbol-plist
+           symbol-value symbolp t tagbody third throw truncate unless
+           unwind-protect values values-list variable warn when
+           write-line write-string zeropt))
 
   (setq *package* *user-package*)