altos/lisp: Take advantage of implicit progn in ROM code
authorKeith Packard <keithp@keithp.com>
Fri, 18 Nov 2016 00:51:34 +0000 (16:51 -0800)
committerKeith Packard <keithp@keithp.com>
Mon, 20 Feb 2017 19:16:51 +0000 (11:16 -0800)
Signed-off-by: Keith Packard <keithp@keithp.com>
src/lisp/ao_lisp_const.lisp

index 13bb81391fd570e95a41544a1a4e921a65705c4d..3c8fd21b73165a6c3d2bd95c40b5c73ddec010bb 100644 (file)
                  (list
                   def
                   name
-                  (list
-                   'lambda
-                   args
-                   (cond (exprs
-                          (cond ((cdr exprs)
-                                 (cons progn exprs))
-                                ((car exprs))
-                                )
-                          )
-                         )
-                   )
+                  (cons 'lambda (cons args exprs))
                   )
                  )
      )
+
                                        ; basic list accessors
 
 
 
 (def let (macro (vars exprs)
                ((lambda (make-names make-exprs make-nils)
-                  (progn
 
                                        ;
                                        ; make the list of names in the let
                                        ;
 
-                    (setq make-names (lambda (vars)
-                                      (cond (vars
-                                             (cons (car (car vars))
-                                                   (make-names (cdr vars))))
-                                            )
-                                      )
-                         )
+                  (setq make-names (lambda (vars)
+                                     (cond (vars
+                                            (cons (car (car vars))
+                                                  (make-names (cdr vars))))
+                                           )
+                                     )
+                        )
 
                                        ; the set of expressions is
                                        ; the list of set expressions
                                        ; pre-pended to the
                                        ; expressions to evaluate
 
-                    (setq make-exprs (lambda (vars exprs)
-                                      (progn
-                                        (cond (vars (cons
-                                                     (list set
-                                                           (list quote
-                                                                 (car (car vars))
-                                                                 )
-                                                           (cadr (car vars))
-                                                           )
-                                                     (make-exprs (cdr vars) exprs)
-                                                     )
-                                                    )
-                                              (exprs)
-                                              )
-                                        )
-                                      )
-                         )
+                  (setq make-exprs (lambda (vars exprs)
+                                     (cond (vars (cons
+                                                  (list set
+                                                        (list quote
+                                                              (car (car vars))
+                                                              )
+                                                        (cadr (car vars))
+                                                        )
+                                                  (make-exprs (cdr vars) exprs)
+                                                  )
+                                                 )
+                                           (exprs)
+                                           )
+                                     )
+                        )
 
                                        ; the parameters to the lambda is a list
                                        ; of nils of the right length
 
-                    (setq make-nils (lambda (vars)
-                                     (cond (vars (cons nil (make-nils (cdr vars))))
-                                           )
-                                     )
-                         )
+                  (setq make-nils (lambda (vars)
+                                    (cond (vars (cons nil (make-nils (cdr vars))))
+                                          )
+                                    )
+                        )
                                        ; prepend the set operations
                                        ; to the expressions
 
-                    (setq exprs (make-exprs vars exprs))
+                  (setq exprs (make-exprs vars exprs))
 
                                        ; build the lambda.
 
-                    (cons
-                     (list
-                      'lambda
-                      (make-names vars)
-                      (cond ((cdr exprs) (cons 'progn exprs))
-                            ((car exprs))
-                            )
-                      )
-                     (make-nils vars)
-                     )
-                    )
+                  (cons (cons 'lambda (cons (make-names vars) exprs))
+                        (make-nils vars)
+                        )
                   )
                 ()
                 ()
                                        ; execute to resolve macros
 
 (and t nil)
-