diff options
author | Keith Packard <keithp@keithp.com> | 2017-12-03 19:54:18 -0800 |
---|---|---|
committer | Keith Packard <keithp@keithp.com> | 2017-12-03 19:54:18 -0800 |
commit | 9dbc686ad7d3289dc0f9bcf4a973f71100e02ded (patch) | |
tree | c64a5e1c981ef3fb6995d361f4b65c1aa8a0f51a /src/lisp/ao_lisp_const.lisp | |
parent | a1d013ab8cc508d4e17ae8876bc5465d1a2dfc1e (diff) |
altos/lisp: Switch to scheme formal syntax for varargs
Scheme uses bare symbols to indicate a varargs parameter; any bare
(i.e., not wrapped in a cons cell) parameter will get the 'rest' of
the parameter list. This works for lambdas, nlambdas and macros. As a
result, the 'lexpr' form has been removed as it is equivalent to a
lambda with a varargs formal.
Signed-off-by: Keith Packard <keithp@keithp.com>
Diffstat (limited to 'src/lisp/ao_lisp_const.lisp')
-rw-r--r-- | src/lisp/ao_lisp_const.lisp | 90 |
1 files changed, 48 insertions, 42 deletions
diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index bb413e7d..422bdd63 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -14,10 +14,10 @@ ; Lisp code placed in ROM ; return a list containing all of the arguments -(def (quote list) (lexpr (l) l)) +(def (quote list) (lambda l l)) (def (quote def!) - (macro (name value rest) + (macro (name value) (list def (list quote name) @@ -27,7 +27,7 @@ (begin (def! append - (lexpr (args) + (lambda args (def! append-list (lambda (a b) (cond ((null? a) b) @@ -55,7 +55,7 @@ (begin (def! or - (macro (l) + (macro l (def! _or (lambda (l) (cond ((null? l) #f) @@ -84,7 +84,7 @@ (begin (def! and - (macro (l) + (macro l (def! _and (lambda (l) (cond ((null? l) #t) @@ -102,7 +102,9 @@ ) ) ) - (_and l))) + (_and l) + ) + ) 'and) ; execute to resolve macros @@ -111,7 +113,7 @@ (begin (def! quasiquote - (macro (x rest) + (macro (x) (def! constant? ; A constant value is either a pair starting with quote, ; or anything which is neither a pair nor a symbol @@ -225,10 +227,12 @@ ) ) ) - (expand-quasiquote x 0) + (def! result (expand-quasiquote x 0)) + result ) ) 'quasiquote) + ; ; Define a variable without returning the value ; Useful when defining functions to avoid @@ -241,7 +245,7 @@ (begin (def! define - (macro (first rest) + (macro (first . rest) ; check for alternate lambda definition form (cond ((list? first) @@ -257,9 +261,11 @@ (set! rest (car rest)) ) ) - `(begin - (def (quote ,first) ,rest) - (quote ,first)) + (def! result `(,begin + (,def (,quote ,first) ,rest) + (,quote ,first)) + ) + result ) ) 'define @@ -275,22 +281,11 @@ (define (caddr l) (car (cdr (cdr l)))) -(define (list-tail x k) - (if (zero? k) - x - (list-tail (cdr x (- k 1))) - ) - ) - -(define (list-ref x k) - (car (list-tail x k)) - ) - ; (if <condition> <if-true>) ; (if <condition> <if-true> <if-false) (define if - (macro (test args) + (macro (test . args) (cond ((null? (cdr args)) `(cond (,test ,(car args))) ) @@ -309,18 +304,18 @@ ; simple math operators -(define zero? (macro (value rest) `(eq? ,value 0))) +(define zero? (macro (value) `(eq? ,value 0))) (zero? 1) (zero? 0) (zero? "hello") -(define positive? (macro (value rest) `(> ,value 0))) +(define positive? (macro (value) `(> ,value 0))) (positive? 12) (positive? -12) -(define negative? (macro (value rest) `(< ,value 0))) +(define negative? (macro (value) `(< ,value 0))) (negative? 12) (negative? -12) @@ -330,7 +325,7 @@ (abs 12) (abs -12) -(define max (lexpr (first rest) +(define max (lambda (first . rest) (while (not (null? rest)) (cond ((< first (car rest)) (set! first (car rest))) @@ -343,7 +338,7 @@ (max 1 2 3) (max 3 2 1) -(define min (lexpr (first rest) +(define min (lambda (first . rest) (while (not (null? rest)) (cond ((> first (car rest)) (set! first (car rest))) @@ -371,6 +366,17 @@ (odd? -1) +(define (list-tail x k) + (if (zero? k) + x + (list-tail (cdr x (- k 1))) + ) + ) + +(define (list-ref x k) + (car (list-tail x k)) + ) + ; define a set of local ; variables all at once and ; then evaluate a list of @@ -391,7 +397,7 @@ ; (let ((x 1) (y)) (set! y (+ x 1)) y) (define let - (macro (vars exprs) + (macro (vars . exprs) (define (make-names vars) (cond ((not (null? vars)) (cons (car (car vars)) @@ -445,7 +451,7 @@ ; (let* ((x 1) (y)) (set! y (+ x 1)) y) (define let* - (macro (vars exprs) + (macro (vars . exprs) ; ; make the list of names in the let @@ -497,11 +503,11 @@ (let* ((x 1) (y x)) (+ x y)) -(define when (macro (test l) `(cond (,test ,@l)))) +(define when (macro (test . l) `(cond (,test ,@l)))) (when #t (write 'when)) -(define unless (macro (test l) `(cond ((not ,test) ,@l)))) +(define unless (macro (test . l) `(cond ((not ,test) ,@l)))) (unless #f (write 'unless)) @@ -542,7 +548,7 @@ (equal? '(a b c) '(a b c)) (equal? '(a b c) '(a b b)) -(define member (lexpr (obj list test?) +(define member (lambda (obj list . test?) (cond ((null? list) #f ) @@ -651,13 +657,13 @@ (char-downcase #\0) (char-downcase #\space) -(define string (lexpr (chars) (list->string chars))) +(define string (lambda chars (list->string chars))) (display "apply\n") (apply cons '(a b)) (define map - (lexpr (proc lists) + (lambda (proc . lists) (define (args lists) (cond ((null? lists) ()) (else @@ -685,7 +691,7 @@ (map cadr '((a b) (d e) (g h))) -(define for-each (lexpr (proc lists) +(define for-each (lambda (proc . lists) (apply map proc lists) #t)) @@ -697,12 +703,12 @@ ) ) -(define string-map (lexpr (proc strings) +(define string-map (lambda (proc . strings) (list->string (apply map proc (_string-ml strings)))))) (string-map (lambda (x) (+ 1 x)) "HAL") -(define string-for-each (lexpr (proc strings) +(define string-for-each (lambda (proc . strings) (apply for-each proc (_string-ml strings)))) (string-for-each write-char "IBM\n") @@ -732,7 +738,7 @@ (define repeat - (macro (count rest) + (macro (count . rest) (define counter '__count__) (cond ((pair? count) (set! counter (car count)) @@ -754,7 +760,7 @@ (repeat (x 3) (write 'goodbye x)) (define case - (macro (test l) + (macro (test . l) ; construct the body of the ; case, dealing with the ; lambda version ( => lambda) @@ -800,7 +806,7 @@ (case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) -;(define number->string (lexpr (arg opt) +;(define number->string (lambda (arg . opt) ; (let ((base (if (null? opt) 10 (car opt))) ; ; |