Author: bernhard Date: Mon Jun 4 12:05:05 2007 New Revision: 18806 Modified: trunk/languages/lisp/lisp/bootstrap.l trunk/languages/lisp/lisp/core.l trunk/languages/lisp/lisp/list.l trunk/languages/lisp/lisp/logic.l trunk/languages/lisp/lisp/math.l trunk/languages/lisp/lisp/objects.l trunk/languages/lisp/lisp/pred.l
Log: [languages/lisp] Move the commenting out from lisp/bootstrap.l to the other lisp/*.l files. Modified: trunk/languages/lisp/lisp/bootstrap.l ============================================================================== --- trunk/languages/lisp/lisp/bootstrap.l (original) +++ trunk/languages/lisp/lisp/bootstrap.l Mon Jun 4 12:05:05 2007 @@ -88,12 +88,12 @@ ;; Create the KEYWORD package. (sys:%make-package "KEYWORD") -; (sys:load "lisp/objects.l") -; (sys:load "lisp/core.l") -; (sys:load "lisp/logic.l") -; (sys:load "lisp/pred.l") -; (sys:load "lisp/list.l") -; (sys:load "lisp/math.l") +(sys:load "lisp/objects.l") +(sys:load "lisp/core.l") +(sys:load "lisp/logic.l") +(sys:load "lisp/pred.l") +(sys:load "lisp/list.l") +(sys:load "lisp/math.l") ;; Create and alias the COMMON-LISP-USER package. (sys:%make-package "COMMON-LISP-USER") Modified: trunk/languages/lisp/lisp/core.l ============================================================================== --- trunk/languages/lisp/lisp/core.l (original) +++ trunk/languages/lisp/lisp/core.l Mon Jun 4 12:05:05 2007 @@ -1,21 +1,21 @@ -(setq cl:*package* (sys:%find-package "COMMON-LISP")) - -;; Define a temporary, primitive version of the defun macro. -(sys:set-symbol-function 'defun - (sys:%make-macro - #'(lambda (form env) - (let ((name (car form)) (body (cdr form))) - (list 'progn - (list 'sys:set-symbol-function - (list 'quote name) - (list 'function (cons 'lambda body))) - (list 'sys:set-function-name - (list 'sys:get-symbol-function (list 'quote name)) - (list 'symbol-name (list 'quote name))) - (list 'sys:get-symbol-function (list 'quote name))))))) - -(defun in-package (pkg) - (setq *package* (sys:%find-package pkg))) - - - +; (setq cl:*package* (sys:%find-package "COMMON-LISP")) +; +; ;; Define a temporary, primitive version of the defun macro. +; (sys:set-symbol-function 'defun +; (sys:%make-macro +; #'(lambda (form env) +; (let ((name (car form)) (body (cdr form))) +; (list 'progn +; (list 'sys:set-symbol-function +; (list 'quote name) +; (list 'function (cons 'lambda body))) +; (list 'sys:set-function-name +; (list 'sys:get-symbol-function (list 'quote name)) +; (list 'symbol-name (list 'quote name))) +; (list 'sys:get-symbol-function (list 'quote name))))))) +; +; (defun in-package (pkg) +; (setq *package* (sys:%find-package pkg))) +; +; +; Modified: trunk/languages/lisp/lisp/list.l ============================================================================== --- trunk/languages/lisp/lisp/list.l (original) +++ trunk/languages/lisp/lisp/list.l Mon Jun 4 12:05:05 2007 @@ -1,68 +1,68 @@ -(in-package "COMMON-LISP") - -;; Define some list accessing functions. -(defun caar (x) (car (car x))) -(defun cadr (x) (car (cdr x))) -(defun cdar (x) (cdr (car x))) -(defun cddr (x) (cdr (cdr x))) - -(defun caaar (x) (car (car (car x)))) -(defun caadr (x) (car (car (cdr x)))) -(defun cadar (x) (car (cdr (car x)))) -(defun caddr (x) (car (cdr (cdr x)))) -(defun cdaar (x) (cdr (car (car x)))) -(defun cdadr (x) (cdr (car (cdr x)))) -(defun cddar (x) (cdr (cdr (car x)))) -(defun cdddr (x) (cdr (cdr (cdr x)))) - -(defun caaaar (x) (car (car (car (car x))))) -(defun caaadr (x) (car (car (car (cdr x))))) -(defun caadar (x) (car (car (cdr (car x))))) -(defun caaddr (x) (car (car (cdr (cdr x))))) -(defun cadaar (x) (car (cdr (car (car x))))) -(defun cadadr (x) (car (cdr (car (cdr x))))) -(defun caddar (x) (car (cdr (cdr (car x))))) -(defun cadddr (x) (car (cdr (cdr (cdr x))))) -(defun cdaaar (x) (cdr (car (car (car x))))) -(defun cdaadr (x) (cdr (car (car (cdr x))))) -(defun cdadar (x) (cdr (car (cdr (car x))))) -(defun cdaddr (x) (cdr (car (cdr (cdr x))))) -(defun cddaar (x) (cdr (cdr (car (car x))))) -(defun cddadr (x) (cdr (cdr (car (cdr x))))) -(defun cdddar (x) (cdr (cdr (cdr (car x))))) -(defun cddddr (x) (cdr (cdr (cdr (cdr x))))) - -(defun endp (x) (eq x nil)) - -(defun first (x) (car x)) -(defun second (x) (cadr x)) -(defun third (x) (caddr x)) -(defun fourth (x) (cadddr x)) -(defun fifth (x) (car (cddddr x))) -(defun sixth (x) (cadr (cddddr x))) -(defun seventh (x) (caddr (cddddr x))) -(defun eighth (x) (cadddr (cddddr x))) -(defun ninth (x) (car (cddddr (cddddr x)))) -(defun tenth (x) (cadr (cddddr (cddddr x)))) - -;; Appends list A to list B -(sys:set-symbol-function 'append - #'(lambda (a b) - (if (null a) - b - (cons (car a) (append (cdr a) b))))) - -;; Copies and returns the passed tree. -(defun copy-tree (tree) - (if (consp tree) - (cons (copy-tree (car tree)) - (copy-tree (cdr tree))) - tree)) - -;; Identity returns whatever was passed to the function -(defun identity (object) object) - -;; For working with association lists. -(defun acons (key val list) - (cons (cons key val) list)) - +; (in-package "COMMON-LISP") +; +; ;; Define some list accessing functions. +; (defun caar (x) (car (car x))) +; (defun cadr (x) (car (cdr x))) +; (defun cdar (x) (cdr (car x))) +; (defun cddr (x) (cdr (cdr x))) +; +; (defun caaar (x) (car (car (car x)))) +; (defun caadr (x) (car (car (cdr x)))) +; (defun cadar (x) (car (cdr (car x)))) +; (defun caddr (x) (car (cdr (cdr x)))) +; (defun cdaar (x) (cdr (car (car x)))) +; (defun cdadr (x) (cdr (car (cdr x)))) +; (defun cddar (x) (cdr (cdr (car x)))) +; (defun cdddr (x) (cdr (cdr (cdr x)))) +; +; (defun caaaar (x) (car (car (car (car x))))) +; (defun caaadr (x) (car (car (car (cdr x))))) +; (defun caadar (x) (car (car (cdr (car x))))) +; (defun caaddr (x) (car (car (cdr (cdr x))))) +; (defun cadaar (x) (car (cdr (car (car x))))) +; (defun cadadr (x) (car (cdr (car (cdr x))))) +; (defun caddar (x) (car (cdr (cdr (car x))))) +; (defun cadddr (x) (car (cdr (cdr (cdr x))))) +; (defun cdaaar (x) (cdr (car (car (car x))))) +; (defun cdaadr (x) (cdr (car (car (cdr x))))) +; (defun cdadar (x) (cdr (car (cdr (car x))))) +; (defun cdaddr (x) (cdr (car (cdr (cdr x))))) +; (defun cddaar (x) (cdr (cdr (car (car x))))) +; (defun cddadr (x) (cdr (cdr (car (cdr x))))) +; (defun cdddar (x) (cdr (cdr (cdr (car x))))) +; (defun cddddr (x) (cdr (cdr (cdr (cdr x))))) +; +; (defun endp (x) (eq x nil)) +; +; (defun first (x) (car x)) +; (defun second (x) (cadr x)) +; (defun third (x) (caddr x)) +; (defun fourth (x) (cadddr x)) +; (defun fifth (x) (car (cddddr x))) +; (defun sixth (x) (cadr (cddddr x))) +; (defun seventh (x) (caddr (cddddr x))) +; (defun eighth (x) (cadddr (cddddr x))) +; (defun ninth (x) (car (cddddr (cddddr x)))) +; (defun tenth (x) (cadr (cddddr (cddddr x)))) +; +; ;; Appends list A to list B +; (sys:set-symbol-function 'append +; #'(lambda (a b) +; (if (null a) +; b +; (cons (car a) (append (cdr a) b))))) +; +; ;; Copies and returns the passed tree. +; (defun copy-tree (tree) +; (if (consp tree) +; (cons (copy-tree (car tree)) +; (copy-tree (cdr tree))) +; tree)) +; +; ;; Identity returns whatever was passed to the function +; (defun identity (object) object) +; +; ;; For working with association lists. +; (defun acons (key val list) +; (cons (cons key val) list)) +; Modified: trunk/languages/lisp/lisp/logic.l ============================================================================== --- trunk/languages/lisp/lisp/logic.l (original) +++ trunk/languages/lisp/lisp/logic.l Mon Jun 4 12:05:05 2007 @@ -1,5 +1,5 @@ -(in-package "COMMON-LISP") - -;; Define some logical functions -(defun not (x) (null x)) - +; (in-package "COMMON-LISP") +; +; ;; Define some logical functions +; (defun not (x) (null x)) +; Modified: trunk/languages/lisp/lisp/math.l ============================================================================== --- trunk/languages/lisp/lisp/math.l (original) +++ trunk/languages/lisp/lisp/math.l Mon Jun 4 12:05:05 2007 @@ -1,7 +1,7 @@ -(in-package "COMMON-LISP") - -(defun 1+ (x) (+ x 1)) -(defun 1- (x) (- x 1)) -(defun evenp (x) (eql (mod x 2) 0)) -(defun oddp (x) (eql (mod x 2) 1)) -(defun zerop (x) (eql x 0)) +; (in-package "COMMON-LISP") +; +; (defun 1+ (x) (+ x 1)) +; (defun 1- (x) (- x 1)) +; (defun evenp (x) (eql (mod x 2) 0)) +; (defun oddp (x) (eql (mod x 2) 1)) +; (defun zerop (x) (eql x 0)) Modified: trunk/languages/lisp/lisp/objects.l ============================================================================== --- trunk/languages/lisp/lisp/objects.l (original) +++ trunk/languages/lisp/lisp/objects.l Mon Jun 4 12:05:05 2007 @@ -1,90 +1,90 @@ -(cl:setq cl:*package* (sys:%find-package "SYSTEM")) - -;; Set up some of the accessors for the LispSymbol class attributes. -(%set-object-attribute 'set-symbol-function - "LispSymbol" - "function" - #'(lambda (s f) - (%set-object-attribute s "LispSymbol" "function" f))) - -(set-symbol-function 'get-symbol-function - #'(lambda (s) - (%get-object-attribute s "LispSymbol" "function"))) - -(set-symbol-function 'set-symbol-documentation - #'(lambda (s d) - (%set-object-attribute s "LispSymbol" "documentation" d))) - -(set-symbol-function 'get-symbol-documentation - #'(lambda (s) - (%get-object-attribute s "LispSymbol" "documentation"))) - -(set-symbol-function 'set-symbol-name - #'(lambda (s n) - (%set-object-attribute s "LispSymbol" "name" n))) - -(set-symbol-function 'get-symbol-name - #'(lambda (s) - (%get-object-attribute s "LispSymbol" "name"))) - -(set-symbol-function 'set-symbol-package - #'(lambda (s p) - (%set-object-attribute s "LispSymbol" "package" p))) - -(set-symbol-function 'get-symbol-package - #'(lambda (s) - (%get-object-attribute s "LispSymbol" "package"))) - -(set-symbol-function 'set-symbol-value - #'(lambda (s v) - (%set-object-attribute s "LispSymbol" "value" v))) - -(set-symbol-function 'get-symbol-value - #'(lambda (s) - (%get-object-attribute s "LispSymbol" "value"))) - -;; Set up some of the accessors for the LispPackage class attributes. -(set-symbol-function 'set-package-name - #'(lambda (p n) - (%set-object-attribute p "LispPackage" "name" n))) - -(set-symbol-function 'get-package-name - #'(lambda (p) - (%get-object-attribute p "LispPackage" "name"))) - -;; Set up some of the accessors for the LispFunction class attributes. -(set-symbol-function 'set-function-documentation - #'(lambda (f d) - (%set-object-attribute f "LispFunction" "documentation" d))) - -(set-symbol-function 'get-function-documentation - #'(lambda (f) - (%get-object-attribute f "LispFunction" "documentation"))) - -(set-symbol-function 'get-function-name - #'(lambda (f) - (%get-object-attribute f "LispFunction" "name"))) - -(set-symbol-function 'set-function-name - #'(lambda (f n) - (%set-object-attribute f "LispFunction" "name" n))) - - -;; The following functions should be created in the COMMON-LISP package. -(setq *package* (%find-package "COMMON-LISP")) - -(sys:set-symbol-function 'symbol-function - #'(lambda (s) - (sys:get-symbol-function s))) - -(sys:set-symbol-function 'symbol-name - #'(lambda (s) - (sys:get-symbol-name s))) - -(sys:set-symbol-function 'symbol-package - #'(lambda (s) - (sys:get-symbol-package s))) - -(sys:set-symbol-function 'package-name - #'(lambda (p) - (sys:get-package-name p))) +; (cl:setq cl:*package* (sys:%find-package "SYSTEM")) +; +; ;; Set up some of the accessors for the LispSymbol class attributes. +; (%set-object-attribute 'set-symbol-function +; "LispSymbol" +; "function" +; #'(lambda (s f) +; (%set-object-attribute s "LispSymbol" "function" f))) +; +; (set-symbol-function 'get-symbol:% s/^/; /-function +; #'(lambda (s) +; (%get-object-attribute s "LispSymbol" "function"))) +; +; (set-symbol-function 'set-symbol-documentation +; #'(lambda (s d) +; (%set-object-attribute s "LispSymbol" "documentation" d))) +; +; (set-symbol-function 'get-symbol-documentation +; #'(lambda (s) +; (%get-object-attribute s "LispSymbol" "documentation"))) +; +; (set-symbol-function 'set-symbol-name +; #'(lambda (s n) +; (%set-object-attribute s "LispSymbol" "name" n))) +; +; (set-symbol-function 'get-symbol-name +; #'(lambda (s) +; (%get-object-attribute s "LispSymbol" "name"))) +; +; (set-symbol-function 'set-symbol-package +; #'(lambda (s p) +; (%set-object-attribute s "LispSymbol" "package" p))) +; +; (set-symbol-function 'get-symbol-package +; #'(lambda (s) +; (%get-object-attribute s "LispSymbol" "package"))) +; +; (set-symbol-function 'set-symbol-value +; #'(lambda (s v) +; (%set-object-attribute s "LispSymbol" "value" v))) +; +; (set-symbol-function 'get-symbol-value +; #'(lambda (s) +; (%get-object-attribute s "LispSymbol" "value"))) +; +; ;; Set up some of the accessors for the LispPackage class attributes. +; (set-symbol-function 'set-package-name +; #'(lambda (p n) +; (%set-object-attribute p "LispPackage" "name" n))) +; +; (set-symbol-function 'get-package-name +; #'(lambda (p) +; (%get-object-attribute p "LispPackage" "name"))) +; +; ;; Set up some of the accessors for the LispFunction class attributes. +; (set-symbol-function 'set-function-documentation +; #'(lambda (f d) +; (%set-object-attribute f "LispFunction" "documentation" d))) +; +; (set-symbol-function 'get-function-documentation +; #'(lambda (f) +; (%get-object-attribute f "LispFunction" "documentation"))) +; +; (set-symbol-function 'get-function-name +; #'(lambda (f) +; (%get-object-attribute f "LispFunction" "name"))) +; +; (set-symbol-function 'set-function-name +; #'(lambda (f n) +; (%set-object-attribute f "LispFunction" "name" n))) +; +; +; ;; The following functions should be created in the COMMON-LISP package. +; (setq *package* (%find-package "COMMON-LISP")) +; +; (sys:set-symbol-function 'symbol-function +; #'(lambda (s) +; (sys:get-symbol-function s))) +; +; (sys:set-symbol-function 'symbol-name +; #'(lambda (s) +; (sys:get-symbol-name s))) +; +; (sys:set-symbol-function 'symbol-package +; #'(lambda (s) +; (sys:get-symbol-package s))) +; +; (sys:set-symbol-function 'package-name +; #'(lambda (p) +; (sys:get-package-name p))) Modified: trunk/languages/lisp/lisp/pred.l ============================================================================== --- trunk/languages/lisp/lisp/pred.l (original) +++ trunk/languages/lisp/lisp/pred.l Mon Jun 4 12:05:05 2007 @@ -1,51 +1,51 @@ -(in-package "COMMON-LISP") - -;; XXX - This should also compare characters (which we don't have yet). -(defun eql (x y) - (if (eq x y) - t - (if (numberp x) - (if (numberp y) - (if (eq (type-of x) (type-of y)) - (= x y)))))) - -;; Define some predicate functions. -(defun characterp (x) (eq (type-of x) 'base-char)) - -(defun consp (x) (eq (type-of x) 'cons)) - -(defun floatp (x) (eq (type-of x) 'float)) - -(defun functionp (x) (eq (type-of x) 'function)) - -(defun hash-table-p (x) (eq (type-of x) 'hash-table)) - -(defun integerp (x) (eq (type-of x) 'integer)) - -(defun keywordp (x) - (if (symbolp x) - (eq (symbol-package x) (sys:%find-package "KEYWORD")) - nil)) - -(defun listp (x) - (if (eq x 'nil) - t - (eq (type-of x) 'cons))) - -(defun numberp (x) - (if (eq (type-of x) 'integer) - t - (eq (type-of x) 'float))) - -(defun packagep (x) - (eq (type-of x) 'package)) - -(defun streamp (x) - (eq (type-of x) 'stream)) - -(defun stringp (x) - (eq (type-of x) 'string)) - -(defun symbolp (x) - (eq (type-of x) 'symbol)) - +; (in-package "COMMON-LISP") +; +; ;; XXX - This should also compare characters (which we don't have yet). +; (defun eql (x y) +; (if (eq x y) +; t +; (if (numberp x) +; (if (numberp y) +; (if (eq (type-of x) (type-of y)) +; (= x y)))))) +; +; ;; Define some predicate functions. +; (defun characterp (x) (eq (type-of x) 'base-char)) +; +; (defun consp (x) (eq (type-of x) 'cons)) +; +; (defun floatp (x) (eq (type-of x) 'float)) +; +; (defun functionp (x) (eq (type-of x) 'function)) +; +; (defun hash-table-p (x) (eq (type-of x) 'hash-table)) +; +; (defun integerp (x) (eq (type-of x) 'integer)) +; +; (defun keywordp (x) +; (if (symbolp x) +; (eq (symbol-package x) (sys:%find-package "KEYWORD")) +; nil)) +; +; (defun listp (x) +; (if (eq x 'nil) +; t +; (eq (type-of x) 'cons))) +; +; (defun numberp (x) +; (if (eq (type-of x) 'integer) +; t +; (eq (type-of x) 'float))) +; +; (defun packagep (x) +; (eq (type-of x) 'package)) +; +; (defun streamp (x) +; (eq (type-of x) 'stream)) +; +; (defun stringp (x) +; (eq (type-of x) 'string)) +; +; (defun symbolp (x) +; (eq (type-of x) 'symbol)) +;
