projects
/
fw
/
altos
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
altos/lisp: Fix some scheme compat issues
[fw/altos]
/
src
/
lisp
/
ao_lisp_const.lisp
diff --git
a/src/lisp/ao_lisp_const.lisp
b/src/lisp/ao_lisp_const.lisp
index d9b1c1f2ed3e250cb21fcb1dae899e53594917bb..861a4fc80eed91314a76453f63528fef4d21340e 100644
(file)
--- a/
src/lisp/ao_lisp_const.lisp
+++ b/
src/lisp/ao_lisp_const.lisp
@@
-60,10
+60,17
@@
(defun caddr (l) (car (cdr (cdr l))))
(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
)
; simple math operators
@@
-264,6
+271,7
@@
(let ((x 1)) x)
(let ((x 1)) x)
+(define let* let)
; boolean operators
(define or (lexpr (l)
; boolean operators
(define or (lexpr (l)
@@
-463,11
+471,9
@@
(define string (lexpr (chars) (list->string chars)))
(define string (lexpr (chars) (list->string chars)))
-(
patom
"apply\n")
+(
display
"apply\n")
(apply cons '(a b))
(apply cons '(a b))
-(define save ())
-
(define map (lexpr (proc lists)
(let ((args (lambda (lists)
(if (null? lists) ()
(define map (lexpr (proc lists)
(let ((args (lambda (lists)
(if (null? lists) ()
@@
-488,28
+494,30
@@
(apply map proc lists)
#t))
(apply map proc lists)
#t))
-(for-each patom '("hello" " " "world" "\n"))
+(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)
(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))))))
+ (list->string (apply map proc (-string-ml strings))))))
(string-map 1+ "HAL")
(define string-for-each (lexpr (proc strings)
(string-map 1+ "HAL")
(define string-for-each (lexpr (proc strings)
- (apply string-map proc strings)
- #t))
+ (apply for-each proc (-string-ml strings))))
+
+(string-for-each write-char "IBM\n")
-(
string-for-each patom "IBM"
)
+(
define newline (lambda () (write-char #\newline))
)
+(newline)
(call-with-current-continuation
(lambda (exit)
(for-each (lambda (x)
(call-with-current-continuation
(lambda (exit)
(for-each (lambda (x)
- (
print
"test" x)
+ (
write
"test" x)
(if (negative? x)
(exit x)))
'(54 0 37 -3 245 19))
(if (negative? x)
(exit x)))
'(54 0 37 -3 245 19))