X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_basic_syntax.scheme;fp=src%2Fscheme%2Fao_scheme_basic_syntax.scheme;h=0000000000000000000000000000000000000000;hp=4cd3e167a1ebaa7128d0c243d3d90a0a6c081986;hb=f26cc1a677f577da533425a15485fcaa24626b23;hpb=4b52fc6eea9a478cb3dd42dcd32c92838df39734

diff --git a/src/scheme/ao_scheme_basic_syntax.scheme b/src/scheme/ao_scheme_basic_syntax.scheme
deleted file mode 100644
index 4cd3e167..00000000
--- a/src/scheme/ao_scheme_basic_syntax.scheme
+++ /dev/null
@@ -1,414 +0,0 @@
-;
-; Copyright © 2018 Keith Packard <keithp@keithp.com>
-;
-; This program is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation, either version 2 of the License, or
-; (at your option) any later version.
-;
-; This program is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-; General Public License for more details.
-;
-; Basic syntax placed in ROM
-
-(def (quote list) (lambda l l))
-
-(def (quote def!)
-     (macro (a b)
-	    (list
-	     def
-	     (list quote a)
-	     b)
-	    )
-     )
-
-(begin
- (def! append
-   (lambda a
-	  (def! _a
-	    (lambda (a b)
-	      (cond ((null? a) b)
-		    (else (cons (car a) (_a (cdr a) b)))
-		    )
-	      )
-	    )
-	    
-	  (def! _b
-	    (lambda (l)
-	      (cond ((null? l) l)
-		    ((null? (cdr l)) (car l))
-		    (else (_a (car l) (_b (cdr l))))
-		    )
-	      )
-	    )
-	  (_b a)
-	  )
-   )
- 'append)
-
-(append '(a) '(b))
-
-
-					;
-					; Define a variable without returning the value
-					; Useful when defining functions to avoid
-					; having lots of output generated.
-					;
-					; Also accepts the alternate
-					; form for defining lambdas of
-					; (define (name x y z) sexprs ...) 
-					;
-
-(begin
- (def! define
-   (macro (a . b)
-					; check for alternate lambda definition form
-
-	  (cond ((pair? a)
-		 (set! b
-		       (cons
-			lambda
-			(cons (cdr a) b)))
-		 (set! a (car a))
-		 )
-		(else
-		 (set! b (car b))
-		 )
-		)
-	  (cons begin
-		(cons
-		 (cons def
-		       (cons (cons quote (cons a '()))
-			     (cons b '())
-			     )
-		       )
-		 (cons
-		  (cons quote (cons a '()))
-		  '())
-		 )
-		)
-	  )
-   )
- 'define
- )
-					; boolean operators
-
-(define or
-  (macro a
-    (def! b
-      (lambda (a)
-	(cond ((null? a) #f)
-	      ((null? (cdr a))
-	       (car a))
-	      (else
-	       (list
-		cond
-		(list
-		 (car a))
-		(list
-		 'else
-		 (b (cdr a))
-		 )
-		)
-	       )
-	      )
-	)
-      )
-    (b a)))
-
-					; execute to resolve macros
-
-(or #f #t)
-
-(define and
-  (macro a
-    (def! b
-      (lambda (a)
-	(cond ((null? a) #t)
-	      ((null? (cdr a))
-	       (car a))
-	      (else
-	       (list
-		cond
-		(list
-		 (car a)
-		 (b (cdr a))
-		 )
-		)
-	       )
-	      )
-	)
-      )
-    (b a)
-    )
-  )
-
-					; execute to resolve macros
-
-(and #t #f)
-
-					; (if <condition> <if-true>)
-					; (if <condition> <if-true> <if-false)
-
-(define if
-  (macro (a . b)
-    (cond ((null? (cdr b))
-	   (list cond (list a (car b)))
-		)
-	  (else
-	   (list cond
-		 (list a (car b))
-		 (list 'else (car (cdr b)))
-		 )
-	   )
-	  )
-    )
-  )
-
-(if (> 3 2) 'yes)
-(if (> 3 2) 'yes 'no)
-(if (> 2 3) 'no 'yes)
-(if (> 2 3) 'no)
-
-(define letrec
-  (macro (a . b)
-
-					;
-					; make the list of names in the let
-					;
-
-	 (define (_a a)
-	   (cond ((not (null? a))
-		  (cons (car (car a))
-			(_a (cdr a))))
-		 (else ())
-		 )
-	   )
-
-					; the set of expressions is
-					; the list of set expressions
-					; pre-pended to the
-					; expressions to evaluate
-
-	 (define (_b a b)
-	   (cond ((null? a) b)
-		 (else
-		  (cons
-		   (list set
-			 (list quote
-			       (car (car a))
-			       )
-			 (cond ((null? (cdr (car a)))
-				()
-				)
-			       (else
-				(car (cdr (car a)))
-				)
-			       )
-			 )
-		   (_b (cdr a) b)
-		   )
-		  )
-		 )
-	   )
-
-					; the parameters to the lambda is a list
-					; of nils of the right length
-
-	 (define (_c a)
-	   (cond ((null? a) ())
-		 (else (cons () (_c (cdr a))))
-		 )
-	   )
-					; build the lambda.
-
-	 (cons (cons lambda (cons (_a a) (_b a b))) (_c a))
-	 )
-     )
-
-(letrec ((a 1) (b a)) (+ a b))
-
-					; letrec is sufficient for let*
-
-(define let* letrec)
-
-					; use letrec for let in basic
-					; syntax
-
-(define let letrec)
-
-					; Basic recursive
-					; equality. Replaced with
-					; vector-capable version in
-					; advanced syntax
-
-(define (equal? a b)
-  (cond ((eq? a b) #t)
-	((pair? a)
-	 (cond ((pair? b)
-		(cond ((equal? (car a) (car b))
-		       (equal? (cdr a) (cdr b)))
-		      )
-		)
-	       )
-	 )
-	)
-  )
-
-(equal? '(a b c) '(a b c))
-
-					; basic list accessors
-
-(define (caar a) (car (car a)))
-
-(define (cadr a) (car (cdr a)))
-
-(define (list-ref a b)
-  (car (list-tail a b))
-  )
-
-(list-ref '(1 2 3) 2)
-
-(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 a b) (member a b eq?))
-
-(memq 2 '(1 2 3))
-(memq 4 '(1 2 3))
-(memq '(2) '((1) (2) (3)))
-
-(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 '(c) '((a 1) (b 2) ((c) 3)))
-
-(define (assq a b) (assoc a b eq?))
-
-(assq 'a '((a 1) (b 2) (c 3)))
-
-(define map
-  (lambda (proc . lists)
-	 (define (_a lists)
-	   (cond ((null? lists) ())
-		 (else
-		  (cons (caar lists) (_a (cdr lists)))
-		  )
-		 )
-	   )
-	 (define (_n lists)
-	   (cond ((null? lists) ())
-		 (else
-		  (cons (cdr (car lists)) (_n (cdr lists)))
-		  )
-		 )
-	   )
-	 (define (_m lists)
-	   (cond ((null? (car lists)) ())
-		 (else
-		  (cons (apply proc (_a lists)) (_m (_n lists)))
-		  )
-		 )
-	   )
-	 (_m lists)
-	 )
-  )
-
-(map cadr '((a b) (d e) (g h)))
-
-					; use map as for-each in basic
-					; mode
-
-(define for-each map)
-					; simple math operators
-
-(define zero? (macro (value) (list eq? value 0)))
-
-(zero? 1)
-(zero? 0)
-(zero? "hello")
-
-(define positive? (macro (value) (list > value 0)))
-
-(positive? 12)
-(positive? -12)
-
-(define negative? (macro (value) (list < value 0)))
-
-(negative? 12)
-(negative? -12)
-
-(define (abs a) (if (>= a 0) a (- a)))
-
-(abs 12)
-(abs -12)
-
-(define max (lambda (a . b)
-		   (while (not (null? b))
-		     (cond ((< a (car b))
-			    (set! a (car b)))
-			   )
-		     (set! b (cdr b))
-		     )
-		   a)
-  )
-
-(max 1 2 3)
-(max 3 2 1)
-
-(define min (lambda (a . b)
-		   (while (not (null? b))
-		     (cond ((> a (car b))
-			    (set! a (car b)))
-			   )
-		     (set! b (cdr b))
-		     )
-		   a)
-  )
-
-(min 1 2 3)
-(min 3 2 1)
-
-(define (even? a) (zero? (% a 2)))
-
-(even? 2)
-(even? -2)
-(even? 3)
-(even? -1)
-
-(define (odd? a) (not (even? a)))
-
-(odd? 2)
-(odd? -2)
-(odd? 3)
-(odd? -1)
-
-(define (newline) (write-char #\newline))
-
-(newline)