X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_const.lisp;h=f8a709799ff5b05b580246bc176910b4345545d2;hb=00bf2ca86b60e6501880011897cea073865c5a03;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..f8a70979 100644
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -25,7 +25,7 @@
 
 (set (quote define) (macro (name val rest)
 			(list
-			 'progn
+			 'begin
 			 (list
 			  'set
 			  (list 'quote name)
@@ -60,10 +60,17 @@
 
 (defun caddr (l) (car (cdr (cdr l))))
 
-(defun nth (list n)
-  (cond ((= n 0) (car list))
-	((nth (cdr list) (1- n)))
-	)
+(define list-tail (lambda (x k)
+		    (if (zero? k)
+			x
+		      (list-tail (cdr x (- k 1)))
+		      )
+		    )
+  )
+
+(define list-ref (lambda (x k)
+		   (car (list-tail x k))
+		   )
   )
 
 					; simple math operators
@@ -152,9 +159,6 @@
 (odd? 3)
 (odd? -1)
 
-(define exact? number?)
-(defun inexact? (x) #f)
-
 					; (if <condition> <if-true>)
 					; (if <condition> <if-true> <if-false)
 
@@ -219,16 +223,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)
 					    )
 				      )
@@ -262,6 +268,7 @@
 
 (let ((x 1)) x)
 
+(define let* let)
 					; boolean operators
 
 (define or (lexpr (l)
@@ -461,6 +468,78 @@
 
 (define string (lexpr (chars) (list->string chars)))
 
+(display "apply\n")
+(apply cons '(a b))
+
+(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 display '("hello" " " "world" "\n"))
+
+(define -string-ml (lambda (strings)
+			     (if (null? strings) ()
+			       (cons (string->list (car strings)) (-string-ml (cdr strings))))))
+
+(define string-map (lexpr (proc strings)
+			  (list->string (apply map proc (-string-ml strings))))))
+
+(string-map 1+ "HAL")
+
+(define string-for-each (lexpr (proc strings)
+			       (apply for-each proc (-string-ml strings))))
+
+(string-for-each write-char "IBM\n")
+
+(define newline (lambda () (write-char #\newline)))
+
+(newline)
+
+(call-with-current-continuation
+ (lambda (exit)
+   (for-each (lambda (x)
+	       (write "test" x)
+	       (if (negative? x)
+		   (exit x)))
+	     '(54 0 37 -3 245 19))
+   #t))
+
+(define repeat (macro (count rest)
+			(list
+			 let
+			 (list
+			  (list '__count__ count))
+			 (append
+			  (list
+			   while
+			   (list
+			    <=
+			    0
+			    (list
+			     set!
+			     '__count__
+			     (list
+			      -
+			      '__count__
+			      1))))
+			  rest))))
+
 ;(define number->string (lexpr (arg opt)
 ;			      (let ((base (if (null? opt) 10 (car opt)))
 					;