+ (equal s1 s2))
+
+ (defun fdefinition (x)
+ (cond
+ ((functionp x)
+ x)
+ ((symbolp x)
+ (symbol-function x))
+ (t
+ (error "Invalid function"))))
+
+ (defun disassemble (function)
+ (write-line (lambda-code (fdefinition function)))
+ nil)
+
+ (defun documentation (x type)
+ "Return the documentation of X. TYPE must be the symbol VARIABLE or FUNCTION."
+ (ecase type
+ (function
+ (let ((func (fdefinition x)))
+ (oget func "docstring")))
+ (variable
+ (unless (symbolp x)
+ (error "Wrong argument type! it should be a symbol"))
+ (oget x "vardoc"))))
+
+ ;; Packages
+
+ (defvar *package-list* nil)
+
+ (defun make-package (name)
+ (let ((package (new)))
+ (oset package "packageName" name)
+ (oset package "symbols" (new))
+ (push package *package-list*)
+ package))
+
+ (defun packagep (x)
+ (and (objectp x) (in "symbols" x)))
+
+ (defun find-package (package-designator)
+ (when (packagep package-designator)
+ (return-from find-package package-designator))
+ (let ((name (string package-designator)))
+ (dolist (package *package-list*)
+ (when (string= (package-name package) name)
+ (return package)))))
+
+ (defun find-package-or-fail (package-designator)
+ (or (find-package package-designator)
+ (error "Package unknown.")))
+
+ (defun package-name (package-designator)
+ (let ((package (find-package-or-fail package-designator)))
+ (oget package "packageName")))
+
+ (defun %package-symbols (package-designator)
+ (let ((package (find-package-or-fail package-designator)))
+ (oget package "symbols")))
+
+ (defvar *package*
+ (make-package "CL"))
+
+ ;; This function is used internally to initialize the CL package
+ ;; with the symbols built during bootstrap.
+ (defun %intern-symbol (symbol)
+ (let ((symbols (%package-symbols *package*)))
+ (oset symbols (symbol-name symbol) symbol)))
+
+ (defun intern (name &optional (package *package*))
+ (let ((symbols (%package-symbols package)))
+ (if (in name symbols)
+ (oget symbols name)
+ (oset symbols name (make-symbol name)))))
+
+ (defun find-symbol (name &optional (package *package*))
+ (let ((symbols (%package-symbols package)))
+ (oget *package* name))))
+