Changeset 32323 for lang/commonlisp

Timestamp:

04/13/09 08:40:37 (4 years ago)

Author:

mokehehe

Message:

修正

Location:

lang/commonlisp/paip

Files:

• 22/22.5.l (modified) (1 diff)
• 22/22.7.l (added)
• 23/23.1.l (modified) (4 diffs)

lang/commonlisp/paip/22/22.5.l

@@ -89 +89 @@
 (defun extend-env (vars vals env)
   "Add some variables and values to an environment."
-  (cond ((null vars)
-                 (assert (null vals) () "Too many arguments supplied")
-                 env)
-                ((atom vars)
-                 (cons (list vars vals) env))
-                (t (assert (rest vals) (first vals))
-                   (extend-env (rest args) (rest vals) env))))
+  (nconc (mapcar #'list vars vals) env))
 
 (defun scheme-macro (symbol)

lang/commonlisp/paip/23/23.1.l

@@ -76 +76 @@
          (comp-if (second pred) else then env val? more?))
         (t (let ((pcode (comp pred env t t))
-                         (tcode (comp pred env val? more?))
-                         (ecode (comp pred env val? more?)))
+                         (tcode (comp then env val? more?))
+                         (ecode (comp else env val? more?)))
                  (cond
                    ((equal tcode ecode) ; (if p x x) => (begin p x)
@@ -114 +114 @@
            (assert (null args) () "Too many arguments supplied")
            (comp-begin (rest2 f) env val? more?))
-          (moer? ; Need to save the continuation point
+          (more? ; Need to save the continuation point
            (let ((k (gen-label 'k)))
                  (seq (gen 'SAVE k)
@@ -123 +123 @@
                           (if (not val?) (gen 'POP)))))
           (t   ; function call as rename plus goto
+           (assert (or (symbolp f)
+                                   (consp f))
+                           () "Function must be symbol or cons")
            (seq (comp-list args env)
                         (comp f env t t)
@@ -218 +221 @@
 (defun scheme-macro-expand (x)
   "Macro-expand this Scheme expression."
+(print (list 'scheme-macro-expand x))
   (if (and (listp x) (scheme-macro (first x)))
           (scheme-macro-expand