X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_const.lisp;h=3c8fd21b73165a6c3d2bd95c40b5c73ddec010bb;hb=97cf9df882291b9e494b2f64f84eb37357a6ab31;hp=6fbc35b67993fc2798effb659063db749d247c9a;hpb=daa06c8dedc6dc1cf21936ee2769d9d25f0567bd;p=fw%2Faltos diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index 6fbc35b6..3c8fd21b 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -46,17 +46,11 @@ (list def name - (list - 'lambda - args - (cond ((cdr exprs) - (cons progn exprs)) - ((car exprs)) - ) - ) + (cons 'lambda (cons args exprs)) ) ) ) + ; basic list accessors @@ -95,69 +89,58 @@ (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) + ) ) () () @@ -199,4 +182,3 @@ ; execute to resolve macros (and t nil) -