X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flambdakey-v1.0%2Fao_lambdakey_const.scheme;h=a37e1a2b3cc5c5dc820b9ae084ada2fad46bc43b;hb=2f87e182d9f0b3c2856f62149371ad70b16148cf;hp=d0c0e57895d54c883ddbd82f8507bee22b7b5076;hpb=09ea349f5b37e257e8ca23ead493ba1694395530;p=fw%2Faltos

diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
index d0c0e578..a37e1a2b 100644
--- a/src/lambdakey-v1.0/ao_lambdakey_const.scheme
+++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
@@ -49,7 +49,7 @@
    )
  'append)
 
-(append '(a b c) '(d e f) '(g h i))
+(append '(a) '(b))
 
 					;
 					; Define a variable without returning the value
@@ -66,7 +66,7 @@
    (macro (a . b)
 					; check for alternate lambda definition form
 
-	  (cond ((list? a)
+	  (cond ((pair? a)
 		 (set! b
 		       (cons lambda (cons (cdr a) b)))
 		 (set! a (car a))
@@ -92,28 +92,86 @@
  'define
  )
 
-					; basic list accessors
+					; boolean operators
 
-(define (caar l) (car (car l)))
+(begin
+ (def! or
+   (macro a
+	  (def! _or
+	    (lambda (a)
+	      (cond ((null? a) #f)
+		    ((null? (cdr a))
+		     (car a))
+		    (else
+		     (list
+		      cond
+		      (list
+		       (car a))
+		      (list
+		       'else
+		       (_or (cdr a))
+		       )
+		      )
+		     )
+		    )
+	      )
+	    )
+	  (_or a)))
+ 'or)
 
-(define (cadr l) (car (cdr l)))
+					; execute to resolve macros
 
-(define (cdar l) (cdr (car l)))
+(or #f #t)
 
-(define (caddr l) (car (cdr (cdr l))))
+(begin
+ (def! and
+   (macro a
+	  (def! _and
+	    (lambda (a)
+	      (cond ((null? a) #t)
+		    ((null? (cdr a))
+		     (car a))
+		    (else
+		     (list
+		      cond
+		      (list
+		       (car a)
+		       (_and (cdr a))
+		       )
+		      )
+		     )
+		    )
+	      )
+	    )
+	  (_and a)
+	  )
+   )
+ 'and)
+
+					; execute to resolve macros
+
+(and #t #f)
+
+					; basic list accessors
+
+(define (caar a) (car (car a)))
+
+(define (cadr a) (car (cdr a)))
+
+; (define (cdar a) (cdr (car a)))
 
 					; (if <condition> <if-true>)
 					; (if <condition> <if-true> <if-false)
 
 (define if
-  (macro (test . args)
-    (cond ((null? (cdr args))
-	   (list cond (list test (car args)))
+  (macro (test . b)
+    (cond ((null? (cdr b))
+	   (list cond (list test (car b)))
 		)
 	  (else
 	   (list cond
-		 (list test (car args))
-		 (list 'else (cadr args))
+		 (list test (car b))
+		 (list 'else (cadr b))
 		 )
 	   )
 	  )
@@ -127,7 +185,7 @@
 
 					; simple math operators
 
-(define zero? (macro (value) (list eqv? value 0)))
+(define zero? (macro (value) (list eq? value 0)))
 
 (zero? 1)
 (zero? 0)
@@ -189,26 +247,10 @@
 (odd? -1)
 
 
-(define (list-tail a b)
-  (if (zero? b)
-      a
-    (list-tail (cdr a (- b 1)))
-    )
-  )
-
 (define (list-ref a b)
   (car (list-tail a b))
   )
 
-(define (list-tail a b)
-  (if (zero? b)
-      a
-    (list-tail (cdr a) (- b 1))))
-
-(list-tail '(1 2 3) 2)
-
-(define (list-ref a b) (car (list-tail a b)))
-
 (list-ref '(1 2 3) 2)
     
 
@@ -231,7 +273,7 @@
 					;
 					; (let* ((x 1) (y)) (set! y (+ x 1)) y)
 
-(define let*
+(define letrec
   (macro (a . b)
 
 					;
@@ -252,7 +294,8 @@
 					; expressions to evaluate
 
 	 (define (_v a b)
-	   (cond ((null? a) b)		 (else
+	   (cond ((null? a) b)
+		 (else
 		  (cons
 		   (list set
 			 (list quote
@@ -281,9 +324,10 @@
 	 )
      )
 
-(let* ((a 1) (y a)) (+ a y))
+(letrec ((a 1) (y a)) (+ a y))
 
-(define let let*)
+(define let letrec)
+(define let* letrec)
 					; recursive equality
 
 (define (equal? a b)
@@ -302,25 +346,24 @@
 (equal? '(a b c) '(a b c))
 (equal? '(a b c) '(a b b))
 
-(define member (lambda (obj a . test?)
-		      (cond ((null? a)
-			     #f
-			     )
-			    (else
-			     (if (null? test?) (set! test? equal?) (set! test? (car test?)))
-			     (if (test? obj (car a))
-				 a
-			       (member obj (cdr a) test?))
-			     )
-			    )
-		      )
+(define (member a b . t?)
+  (cond ((null? b)
+	 #f
+	 )
+	(else
+	 (if (null? t?) (set! t? equal?) (set! t? (car t?)))
+	 (if (t? a (car b))
+	     b
+	     (member a (cdr b) t?))
+	 )
+	)
   )
 
 (member '(2) '((1) (2) (3)))
 
 (member '(4) '((1) (2) (3)))
 
-(define (memq obj a) (member obj a eq?))
+(define (memq a b) (member a b eq?))
 
 (memq 2 '(1 2 3))
 
@@ -328,62 +371,56 @@
 
 (memq '(2) '((1) (2) (3)))
 
-(define (_assoc a b t?)
+(define (assoc a b . t?)
+  (if (null? t?)
+      (set! t? equal?)
+      (set! t? (car t?))
+      )
   (if (null? b)
       #f
     (if (t? a (caar b))
 	(car b)
-      (_assoc a (cdr b) t?)
+      (assoc a (cdr b) t?)
       )
     )
   )
 
-(define (assq a b) (_assoc a b eq?))
-(define (assoc a b) (_assoc a b equal?))
+(define (assq a b) (assoc a b eq?))
 
 (assq 'a '((a 1) (b 2) (c 3)))
 (assoc '(c) '((a 1) (b 2) ((c) 3)))
 
 (define string (lambda a (list->string a)))
 
-(display "apply\n")
-(apply cons '(a b))
-
 (define map
   (lambda (a . b)
-	 (define (args b)
+	 (define (_a b)
 	   (cond ((null? b) ())
 		 (else
-		  (cons (caar b) (args (cdr b)))
+		  (cons (caar b) (_a (cdr b)))
 		  )
 		 )
 	   )
-	 (define (next b)
+	 (define (_n b)
 	   (cond ((null? b) ())
 		 (else
-		  (cons (cdr (car b)) (next (cdr b)))
+		  (cons (cdr (car b)) (_n (cdr b)))
 		  )
 		 )
 	   )
-	 (define (domap b)
+	 (define (_d b)
 	   (cond ((null? (car b)) ())
 		 (else
-		  (cons (apply a (args b)) (domap (next b)))
+		  (cons (apply a (_a b)) (_d (_n b)))
 		  )
 		 )
 	   )
-	 (domap b)
+	 (_d b)
 	 )
   )
 
 (map cadr '((a b) (d e) (g h)))
 
-(define for-each (lambda (a . b)
-			(apply map a b)
-			#t))
-
-(for-each display '("hello" " " "world" "\n"))
-
 (define (newline) (write-char #\newline))
 
 (newline)