X-Git-Url: https://git.gag.com/?a=blobdiff_plain;ds=sidebyside;f=src%2Flisp%2Fao_lisp_const.lisp;h=d9b1c1f2ed3e250cb21fcb1dae899e53594917bb;hb=e1acf5eb12aceda7aa838df031c1da1129d0fa5d;hp=1750904496af4ddd36c1ce03ec7eb57c25f5c3a8;hpb=a4e18a13029cc7b16b2ed9da84d6e606bc725ac3;p=fw%2Faltos diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index 17509044..d9b1c1f2 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -219,16 +219,18 @@ ; expressions to evaluate (set! make-exprs (lambda (vars exprs) - (cond ((not (null? vars)) (cons - (list set - (list quote - (car (car vars)) - ) - (cadr (car vars)) - ) - (make-exprs (cdr vars) exprs) - ) - ) + (cond ((not (null? vars)) + (cons + (list set + (list quote + (car (car vars)) + ) + (cond ((null? (cdr (car vars))) ()) + (else (cadr (car vars)))) + ) + (make-exprs (cdr vars) exprs) + ) + ) (exprs) ) ) @@ -461,6 +463,58 @@ (define string (lexpr (chars) (list->string chars))) +(patom "apply\n") +(apply cons '(a b)) + +(define save ()) + +(define map (lexpr (proc lists) + (let ((args (lambda (lists) + (if (null? lists) () + (cons (caar lists) (args (cdr lists)))))) + (next (lambda (lists) + (if (null? lists) () + (cons (cdr (car lists)) (next (cdr lists)))))) + (domap (lambda (lists) + (if (null? (car lists)) () + (cons (apply proc (args lists)) (domap (next lists))) + ))) + ) + (domap lists)))) + +(map cadr '((a b) (d e) (g h))) + +(define for-each (lexpr (proc lists) + (apply map proc lists) + #t)) + +(for-each patom '("hello" " " "world" "\n")) + +(define string-map (lexpr (proc strings) + (let ((make-lists (lambda (strings) + (if (null? strings) () + (cons (string->list (car strings)) (make-lists (cdr strings)))))) + ) + (list->string (apply map proc (make-lists strings)))))) + +(string-map 1+ "HAL") + +(define string-for-each (lexpr (proc strings) + (apply string-map proc strings) + #t)) + +(string-for-each patom "IBM") + + +(call-with-current-continuation + (lambda (exit) + (for-each (lambda (x) + (print "test" x) + (if (negative? x) + (exit x))) + '(54 0 37 -3 245 19)) + #t)) + ;(define number->string (lexpr (arg opt) ; (let ((base (if (null? opt) 10 (car opt))) ;