remove booting into mes (would need VM), boot.mes; rewrite test.mes.
This commit is contained in:
Jan Nieuwenhuizen
parent
8706d7e938
commit
3a28828bdf
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -2,7 +2,6 @@
|
|||
*.go
|
||||
*.o
|
||||
*~
|
||||
/boot.mes
|
||||
/mes
|
||||
/mes.h
|
||||
/environment.i
|
||||
|
|
|
|||
|
|
@ -4,9 +4,8 @@ CFLAGS=-std=c99 -O3 -finline-functions
|
|||
|
||||
default: all
|
||||
|
||||
all: mes boot.mes
|
||||
all: mes
|
||||
|
||||
#mes.o: mes.c mes.h
|
||||
mes: mes.c mes.h
|
||||
|
||||
mes.h: mes.c GNUmakefile
|
||||
|
|
@ -36,12 +35,6 @@ check: all
|
|||
./mes.test ./mes
|
||||
cat scm.mes test.mes | ./mes
|
||||
|
||||
boot.mes: mes.mes loop2.mes scm.mes test.mes
|
||||
cat $^ > $@
|
||||
|
||||
boot: all
|
||||
./mes < boot.mes
|
||||
|
||||
run: all
|
||||
cat scm.mes test.mes | ./mes
|
||||
|
||||
|
|
|
|||
7
c1.mes
7
c1.mes
|
|
@ -6,10 +6,9 @@
|
|||
(define b 1)
|
||||
(define (y) b)
|
||||
(set! b 0)
|
||||
(display b)
|
||||
(let ((b 2))
|
||||
(y))
|
||||
)
|
||||
(list b
|
||||
(let ((b 2))
|
||||
(y))))
|
||||
|
||||
(display (x))
|
||||
(newline)
|
||||
|
|
|
|||
90
mes.c
90
mes.c
|
|
@ -277,7 +277,7 @@ assq (scm *x, scm *a)
|
|||
}
|
||||
|
||||
scm *
|
||||
apply_env_ (scm *fn, scm *x, scm *a)
|
||||
apply_env (scm *fn, scm *x, scm *a)
|
||||
{
|
||||
#if DEBUG
|
||||
printf ("apply_env fn=");
|
||||
|
|
@ -316,9 +316,9 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
|||
display (x);
|
||||
puts ("");
|
||||
#endif
|
||||
//return apply_env_ (eval_ (fn, a), x, a);
|
||||
scm *e = eval_ (fn, a);
|
||||
return apply_env_ (e, x, a);
|
||||
//return apply_env (eval (fn, a), x, a);
|
||||
scm *e = eval (fn, a);
|
||||
return apply_env (e, x, a);
|
||||
//return &scm_unspecified;
|
||||
}
|
||||
#if MACROS
|
||||
|
|
@ -333,13 +333,13 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
|||
puts ("");
|
||||
#endif
|
||||
//scm *r = apply_env (cdr (macro), cdr (fn), a);
|
||||
scm *r = apply_env (eval_ (cdr (macro), a), cdr (fn), a);
|
||||
scm *r = apply_env (eval (cdr (macro), a), cdr (fn), a);
|
||||
#if DEBUG
|
||||
printf ("APPLY MACRO GOT: ==> ");
|
||||
display (r);
|
||||
puts ("");
|
||||
#endif
|
||||
scm *e = eval_ (r, a);
|
||||
scm *e = eval (r, a);
|
||||
return apply_env (e, x, a);
|
||||
}
|
||||
#endif // MACROS
|
||||
|
|
@ -347,7 +347,7 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
|||
}
|
||||
|
||||
scm *
|
||||
eval_ (scm *e, scm *a)
|
||||
eval (scm *e, scm *a)
|
||||
{
|
||||
#if DEBUG
|
||||
printf ("eval e=");
|
||||
|
|
@ -413,7 +413,7 @@ eval_ (scm *e, scm *a)
|
|||
display (cdr (e));
|
||||
puts ("");
|
||||
#endif
|
||||
return eval (apply_env_ (cdr (macro), cdr (e), a), a);
|
||||
return eval (apply_env (cdr (macro), cdr (e), a), a);
|
||||
}
|
||||
#endif // MACROS
|
||||
return apply_env (car (e), evlis (cdr (e), a), a);
|
||||
|
|
@ -465,6 +465,9 @@ closure_body (scm *body, scm *a)
|
|||
scm *p = pairlis (cdadr (e), cdadr (e), cons (cons (caar (e), caar (e)), a));
|
||||
return cons (cons (car (e), cons (cadr (e), closure_body (cddr (e), p))), cdr (body));
|
||||
}
|
||||
if (eq_p (car (e), &scm_symbol_set_x) == &scm_t)
|
||||
return cons (e, closure_body (cdr (body), a));
|
||||
// skip closure-body-ing macros
|
||||
if (eq_p (car (e), &scm_symbol_define_macro) == &scm_t)
|
||||
return cons (e, closure_body (cdr (body), a));
|
||||
return cons (cons (car (e), cons (cadr (e), closure_body (cddr (e), a))), cdr (body));
|
||||
|
|
@ -787,10 +790,10 @@ values (scm *x/*...*/)
|
|||
scm *
|
||||
call_with_values_env (scm *producer, scm *consumer, scm *a)
|
||||
{
|
||||
scm *v = apply_env_ (producer, &scm_nil, a);
|
||||
scm *v = apply_env (producer, &scm_nil, a);
|
||||
if (v->type == VALUES)
|
||||
v = v->cdr;
|
||||
return apply_env_ (consumer, v, a);
|
||||
return apply_env (consumer, v, a);
|
||||
}
|
||||
|
||||
scm *
|
||||
|
|
@ -882,6 +885,20 @@ list_to_vector (scm *x)
|
|||
return v;
|
||||
}
|
||||
|
||||
scm*
|
||||
integer_to_char (scm *x)
|
||||
{
|
||||
assert (x->type == NUMBER);
|
||||
return make_char (x->value);
|
||||
}
|
||||
|
||||
scm*
|
||||
char_to_integer (scm *x)
|
||||
{
|
||||
assert (x->type == CHAR);
|
||||
return make_number (x->value);
|
||||
}
|
||||
|
||||
scm*
|
||||
number_to_string (scm *x)
|
||||
{
|
||||
|
|
@ -891,6 +908,13 @@ number_to_string (scm *x)
|
|||
return make_string (buf);
|
||||
}
|
||||
|
||||
scm*
|
||||
builtin_exit (scm *x)
|
||||
{
|
||||
assert (x->type == NUMBER);
|
||||
exit (x->value);
|
||||
}
|
||||
|
||||
scm*
|
||||
string_to_symbol (scm *x)
|
||||
{
|
||||
|
|
@ -1271,13 +1295,19 @@ eval_quasiquote (scm *e, scm *a)
|
|||
}
|
||||
puts ("");
|
||||
#endif
|
||||
// bool have_unquote = assq (&scm_unquote, a) != &scm_f;
|
||||
// #if DEBUG
|
||||
// printf ("eval_quasiquote[%d] ==> ", have_unquote);
|
||||
// display (e);
|
||||
// puts ("");
|
||||
// #endif
|
||||
if (e == &scm_nil) return e;
|
||||
else if (atom_p (e) == &scm_t) return e;
|
||||
else if (eq_p (car (e), &scm_symbol_unquote) == &scm_t)
|
||||
return eval (cadr (e), a);
|
||||
else if (e->type == PAIR && e->car->type == PAIR
|
||||
&& eq_p (caar (e), &scm_symbol_unquote_splicing) == &scm_t)
|
||||
return append2 (eval_ (cadar (e), a), eval_quasiquote (cdr (e), a));
|
||||
return append2 (eval (cadar (e), a), eval_quasiquote (cdr (e), a));
|
||||
return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1427,44 +1457,6 @@ read_file (scm *e, scm *a)
|
|||
return cons (e, read_file (readenv (a), a));
|
||||
}
|
||||
|
||||
scm *
|
||||
apply_env (scm *fn, scm *x, scm *a)
|
||||
{
|
||||
#if DEBUG
|
||||
printf ("\nc:apply_env fn=");
|
||||
display (fn);
|
||||
printf (" x=");
|
||||
display (x);
|
||||
puts ("");
|
||||
#endif
|
||||
if (fn == &scm_apply_env_)
|
||||
return eval_ (x, a);
|
||||
return apply_env_ (fn, x, a);
|
||||
}
|
||||
|
||||
bool evalling_p = false;
|
||||
|
||||
scm *
|
||||
eval (scm *e, scm *a)
|
||||
{
|
||||
#if DEBUG
|
||||
printf ("\nc:eval e=");
|
||||
display (e);
|
||||
puts ("");
|
||||
#endif
|
||||
|
||||
scm *eval__ = assq (&scm_symbol_eval, a);
|
||||
assert (eval__ != &scm_f);
|
||||
eval__ = cdr (eval__);
|
||||
if (builtin_p (eval__) == &scm_t
|
||||
|| evalling_p)
|
||||
return eval_ (e, a);
|
||||
evalling_p = true;
|
||||
scm *r = apply_env (eval__, cons (e, cons (a, &scm_nil)), a);
|
||||
evalling_p = false;
|
||||
return r;
|
||||
}
|
||||
|
||||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
|
|
|
|||
8
scm.mes
8
scm.mes
|
|
@ -36,7 +36,7 @@
|
|||
(define (vector . rest) (list->vector rest))
|
||||
|
||||
(define (apply f args)
|
||||
(c:eval (cons f args) (current-module)))
|
||||
(eval (cons f args) (current-module)))
|
||||
|
||||
(define (defined? x)
|
||||
(assq x (current-module)))
|
||||
|
|
@ -171,3 +171,9 @@
|
|||
;; (let ((val (number->string counter)))
|
||||
;; (set! counter (+ counter 1))
|
||||
;; (string->symbol (string-append "g" val))))))
|
||||
|
||||
(define *gensym* 0)
|
||||
(define (gensym)
|
||||
(set! *gensym* (+ *gensym* 1))
|
||||
(string->symbol (string-append "g" (number->string *gensym*))))
|
||||
|
||||
|
|
|
|||
19
syntax.mes
19
syntax.mes
|
|
@ -156,6 +156,7 @@
|
|||
(display "make-transformer") (newline)
|
||||
`(lambda (,%input ,%rename ,%compare)
|
||||
(let ((,%tail (cdr ,%input)))
|
||||
(display "TEEL:") (display ,%tail) (newline)
|
||||
(cond ,@(map process-rule rules)
|
||||
(#t ;;else
|
||||
(syntax-error
|
||||
|
|
@ -169,6 +170,24 @@
|
|||
(null? (cddr rule)))
|
||||
(let ((pattern (cdar rule))
|
||||
(template (cadr rule)))
|
||||
(let ((xx `,(process-pattern pattern
|
||||
%tail
|
||||
(lambda (x) x)))
|
||||
(tt `,%tail)
|
||||
(yy (process-match %tail pattern)))
|
||||
(display "METS>>>") (newline)
|
||||
(display yy)
|
||||
(newline)
|
||||
(display "TEEL>>>") (newline)
|
||||
(display tt)
|
||||
(newline)
|
||||
(display "<<<METS") (newline)
|
||||
(display "PETTERN>>>") (newline)
|
||||
(display xx)
|
||||
(newline)
|
||||
(display "<<<PETTERN") (newline)
|
||||
)
|
||||
|
||||
`((and ,@(process-match %tail pattern))
|
||||
(let* ,(process-pattern pattern
|
||||
%tail
|
||||
|
|
|
|||
412
test.mes
412
test.mes
|
|
@ -21,251 +21,93 @@
|
|||
;; The Maxwell Equations of Software -- John McCarthy page 13
|
||||
;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf
|
||||
|
||||
(display 123)
|
||||
;; haha, broken. lat0r
|
||||
(define pass 0)
|
||||
(define fail 0)
|
||||
(define result #f)
|
||||
(let ((pass 0)
|
||||
(fail 0))
|
||||
(set! result
|
||||
(lambda (. t)
|
||||
(cond ((null? t) (list pass fail))
|
||||
((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
|
||||
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
|
||||
|
||||
4
|
||||
(newline)
|
||||
(define-macro (pass-if name t)
|
||||
`(let ()
|
||||
(display "test: ") (display ,name)
|
||||
(result ,t)))
|
||||
|
||||
(cons (display 'one-) (display 'two))
|
||||
(newline)
|
||||
(define-macro (pass-if-not name f)
|
||||
`(let ()
|
||||
(display "test: ") (display ,name)
|
||||
(result (not ,f))))
|
||||
|
||||
(display 'hello-display-symbol)
|
||||
(newline)
|
||||
(pass-if "first dummy" #t)
|
||||
(pass-if-not "second dummy" #f)
|
||||
|
||||
(display '(0 1 2))
|
||||
(newline)
|
||||
(pass-if "and" (eq? (and 1) 1))
|
||||
(pass-if "and 2" (eq? (and 1 (= 0 1) #f) #f))
|
||||
(pass-if "or" (eq? (or) #f))
|
||||
(pass-if "or 2" (eq? (or 1) 1))
|
||||
(pass-if "or 3" (eq? (or #f (= 0 1) 3) 3))
|
||||
(pass-if "let" (eq? (let ((p 5) (q 6)) (+ p q)) 11))
|
||||
(pass-if "let loop" (equal? (let loop ((lst '(3 2 1)))
|
||||
(if (null? lst) '()
|
||||
(cons (car lst)
|
||||
(loop (cdr lst))))) '(3 2 1)))
|
||||
(pass-if "quasiquote" (let ((cc 'bb)) (equal? `(aa bb ,cc) '(aa bb bb))))
|
||||
(pass-if "let* comments" (eq? (let* ((aa 2)
|
||||
(bb (+ aa 3))
|
||||
#! boo !#
|
||||
;;(bb 4)
|
||||
)
|
||||
bb)
|
||||
5))
|
||||
|
||||
(display (- 12 3))
|
||||
(newline)
|
||||
|
||||
(display (+ 3 4))
|
||||
|
||||
(newline)
|
||||
|
||||
(display "(and): ")
|
||||
(display (and))
|
||||
(newline)
|
||||
(display "(and 1): ")
|
||||
(display (and 1))
|
||||
(newline)
|
||||
(display "(and 1 (= 0 1)): ")
|
||||
(display (and 1 (= 0 1)))
|
||||
(newline)
|
||||
|
||||
(display "(or): ")
|
||||
(display (or))
|
||||
(newline)
|
||||
(display "(or 1): ")
|
||||
(display (or 1))
|
||||
(newline)
|
||||
(display "(or #f (= 0 1) 3): ")
|
||||
(display (or #f (= 0 1) 3))
|
||||
(newline)
|
||||
(display (or (= 0 1) #f (and (display "YEAH") (newline) 'woet)))
|
||||
(newline)
|
||||
|
||||
(let ((p 5)
|
||||
(q 6))
|
||||
(display 'let-p:3-q:4)
|
||||
(newline)
|
||||
(display 'p:)
|
||||
(display p)
|
||||
(newline)
|
||||
(display 'q:)
|
||||
(display q)
|
||||
(newline))
|
||||
|
||||
|
||||
(display
|
||||
(let ((p 5)
|
||||
(q 6))
|
||||
(display 'hallo)
|
||||
(display p)
|
||||
(display 'daar)
|
||||
(display q)
|
||||
(display 'dan)))
|
||||
|
||||
(newline)
|
||||
(display 'let-dun)
|
||||
(newline)
|
||||
|
||||
(let loop ((lst '(3 2 1)))
|
||||
(display "loop")
|
||||
(newline)
|
||||
(if (null? lst) (begin (display "dun") 'dun)
|
||||
(begin
|
||||
(display "looping: ")
|
||||
(display (car lst))
|
||||
(newline)
|
||||
(loop (cdr lst)))))
|
||||
(newline)
|
||||
|
||||
(define c 'b)
|
||||
`(aa bb ,c)
|
||||
(display `(pp qq ,c))
|
||||
(newline)
|
||||
|
||||
(display
|
||||
(let* ((aa 2)
|
||||
(bb (+ aa 3))
|
||||
#! boo !#
|
||||
;;(bb 4)
|
||||
)
|
||||
(display 'allo:)
|
||||
bb))
|
||||
|
||||
(newline)
|
||||
(display 'let*-dun)
|
||||
(newline)
|
||||
(map display '(1 2 3 4))
|
||||
(newline)
|
||||
(map (lambda (x) (display x) (newline)) '(5 6 7 8))
|
||||
(newline)
|
||||
|
||||
(map (lambda (i a) (display i) (display ':) (display a) (newline)) '(1 2 3 4) '(a b c d))
|
||||
(newline)
|
||||
|
||||
(define a 0)
|
||||
(display 'a=0:)
|
||||
(display a)
|
||||
(newline)
|
||||
(display "set!")
|
||||
(display (set! a 1))
|
||||
(set! a 1)
|
||||
(display 'a=1:)
|
||||
(display a)
|
||||
(newline)
|
||||
|
||||
(display
|
||||
((lambda (x)
|
||||
(display 'x:)
|
||||
(display x)
|
||||
(newline)
|
||||
(display 'setting-x=2)
|
||||
(newline)
|
||||
(set! x 2)
|
||||
(display 'x:)
|
||||
(display x)
|
||||
(newline))
|
||||
1))
|
||||
|
||||
(display (+ 11 12))
|
||||
(newline)
|
||||
(display (* 3 3))
|
||||
(newline)
|
||||
(display (/ 9 3))
|
||||
(newline)
|
||||
(display (= 3 '3))
|
||||
(newline)
|
||||
|
||||
(display (if #t 'true))
|
||||
(newline)
|
||||
(display (if (eq? 0 '0) 'true 'false))
|
||||
(newline)
|
||||
(display (if (= 1 2) 'true 'false))
|
||||
(newline)
|
||||
|
||||
(display 'factorial4=)
|
||||
(display
|
||||
(letrec ((factorial (lambda (n)
|
||||
;; (display 'factorial:)
|
||||
;; (display n)
|
||||
;; (newline)
|
||||
(if (= n 1) 1
|
||||
(* n (factorial (- n 1)))))))
|
||||
(factorial 4)))
|
||||
(newline)
|
||||
|
||||
(define a 2)
|
||||
(begin
|
||||
(display 'a+3=)
|
||||
(display (+ a 3)))
|
||||
(newline)
|
||||
|
||||
" a b c"
|
||||
(display "string me")
|
||||
(newline)
|
||||
(display (string-append "a" "b" "c"))
|
||||
(newline)
|
||||
(display (string-length (string-append "a" "b" "c")))
|
||||
(newline)
|
||||
|
||||
#\m
|
||||
(display #\m)
|
||||
(newline)
|
||||
(display #\101)
|
||||
(newline)
|
||||
(display #\newline)
|
||||
(newline)
|
||||
(display #\space)
|
||||
(newline)
|
||||
|
||||
(display (string #\a #\space #\s #\t #\r #\i #\n #\g #\newline))
|
||||
(newline)
|
||||
|
||||
(display "length of nil: ")
|
||||
(display (length '()))
|
||||
(newline)
|
||||
(display "length of '(a b c): ")
|
||||
(display (length '(a b c)))
|
||||
(newline)
|
||||
|
||||
#(a b c)
|
||||
(display #(0 1 2))
|
||||
(newline)
|
||||
(define v #("a" "b" "c"))
|
||||
(display "vector?: ")
|
||||
(display (vector? v))
|
||||
(newline)
|
||||
(display "length of ")
|
||||
(display v)
|
||||
(display ": ")
|
||||
(display (vector-length v))
|
||||
(newline)
|
||||
(display "as list: ")
|
||||
(define lv (vector->list v))
|
||||
(display lv)
|
||||
(newline)
|
||||
(display "again as vector: ")
|
||||
(display (list->vector lv))
|
||||
(newline)
|
||||
|
||||
(display "(vector 0 1 2): ")
|
||||
(display (vector 0 1 2))
|
||||
(newline)
|
||||
|
||||
(display "v[1]: ")
|
||||
(display (vector-ref v 1))
|
||||
(newline)
|
||||
|
||||
(display "v[1]=q: ")
|
||||
(vector-set! v 1 'q)
|
||||
(display v)
|
||||
(newline)
|
||||
|
||||
(display "memq a: ")
|
||||
(display (memq 'a '(a b c)))
|
||||
(newline)
|
||||
|
||||
(display "memq b: ")
|
||||
(display (memq 'b '(a b c)))
|
||||
(newline)
|
||||
|
||||
(display "memq c: ")
|
||||
(display (memq 'c '(a b c)))
|
||||
(newline)
|
||||
|
||||
(display "memq d: ")
|
||||
(display (memq 'd '(a b c)))
|
||||
(newline)
|
||||
|
||||
(display "member a: ")
|
||||
(display (member '(a) '((a) b c)))
|
||||
(newline)
|
||||
|
||||
(display "plus: ")
|
||||
(display (+ 1 1 1 1))
|
||||
(newline)
|
||||
(pass-if "map" (equal? (map identity '(1 2 3 4)) '(1 2 3 4)))
|
||||
(pass-if "map 2 " (equal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
|
||||
'((1 . a) (2 . b) (3 . c) (4 . d))))
|
||||
(define xxxa 0)
|
||||
(pass-if "set! " (eq? (begin (set! xxxa 1) xxxa) 1))
|
||||
(pass-if "set! 2" (eq? (let ((a 0)) (set! a 1) a) 1))
|
||||
(pass-if "+" (eq? (+ 1 2 3) 6))
|
||||
(pass-if "*" (eq? (* 3 3 3) 27))
|
||||
(pass-if "/" (eq? (/ 9 3) 3))
|
||||
(pass-if "=" (= 3 '3))
|
||||
(pass-if "= 2" (not (= 3 '4)))
|
||||
(pass-if "if" (eq? (if #t 'true) 'true))
|
||||
(pass-if "if 2" (eq? (if (eq? 0 '0) 'true 'false) 'true))
|
||||
(pass-if "if 3" (eq? (if (= 1 2) 'true 'false) 'false))
|
||||
(pass-if "letrec" (= (letrec ((factorial (lambda (n)
|
||||
(if (= n 1) 1
|
||||
(* n (factorial (- n 1)))))))
|
||||
(factorial 4))
|
||||
24))
|
||||
(pass-if "begin" (eq? (begin 'a 'b (+ 1 2)) 3))
|
||||
(pass-if "string-append" (equal? (string-append "a" "b" "c") "abc"))
|
||||
(pass-if "eq?" (not (eq? (string-append "a" "b" "c") "abc")))
|
||||
(pass-if "string-length" (= (string-length (string-append "a" "b" "c")) 3))
|
||||
(pass-if "char" (= (char->integer #\A) 65))
|
||||
(pass-if "char 2" (= (char->integer #\101) (char->integer #\A)))
|
||||
(pass-if "char 3" (eq? (integer->char 10) #\newline))
|
||||
(pass-if "char 4" (eq? (integer->char 32) #\space))
|
||||
(pass-if "string " (equal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
|
||||
(pass-if "length" (eq? (length '()) 0))
|
||||
(pass-if "length 2" (= (length '(a b c)) 3))
|
||||
(pass-if "vector?" (vector? #(1 2 c)))
|
||||
(pass-if "vector-length" (= (vector-length #(1)) 1))
|
||||
(pass-if "list->vector" (equal? (list->vector '(a b c)) #(a b c)))
|
||||
(pass-if "vector" (equal? #(vector 0 1 2) #(vector 0 1 2)))
|
||||
(pass-if "vector-ref" (eq? (vector-ref #(0 1) 1) 1))
|
||||
;;(pass-if "vector-set" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
|
||||
;;(pass-if "vector-set" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #()))
|
||||
(pass-if "equal?" (equal? #(1) #(1)))
|
||||
(pass-if "equal?" (not (equal? #() #(1))))
|
||||
(pass-if "memq" (equal? (memq 'a '(a b c)) '(a b c)))
|
||||
(pass-if "memq" (equal? (memq 'b '(a b c)) '(b c)))
|
||||
(pass-if "memq" (eq? (memq 'd '(a b c)) #f))
|
||||
(pass-if "member" (equal? (member '(a) '((a) b c)) '((a) b c)))
|
||||
|
||||
;; works, but debugging is foo
|
||||
;; (cond ((defined? 'loop2)
|
||||
|
|
@ -286,53 +128,47 @@
|
|||
;; (display ((lambda (x) x) (values 1 2 3)))
|
||||
;; (newline)))
|
||||
|
||||
(display "(procedure? builtin?: ")
|
||||
(display (procedure? builtin?))
|
||||
(define (guile?) (defined? 'gc))
|
||||
(if (guile?)
|
||||
(module-define! (current-module) 'builtin? (lambda (. x) #t)))
|
||||
|
||||
(pass-if "builtin?" (builtin? eval))
|
||||
;;(pass-if "builtin?" (builtin? cond))
|
||||
(pass-if "procedure?" (procedure? builtin?))
|
||||
(pass-if "procedure?" (procedure? procedure?))
|
||||
(when (not (guile?))
|
||||
(pass-if "gensym" (eq? (gensym) 'g0))
|
||||
(pass-if "gensym" (eq? (gensym) 'g1))
|
||||
(pass-if "gensym" (eq? (gensym) 'g2)))
|
||||
(pass-if "unquote" (equal? `,(list 1 2 3 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (equal? `('boo ,@'(bah baz) 1 2) '((quote boo) bah baz 1 2)))
|
||||
(pass-if "splice" (equal? `(1 ,@(list 2 3) 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (equal? (let ((s-r '(2 3))) `(1 ,@s-r 4)) '(1 2 3 4)))
|
||||
(pass-if "unquote" (equal? `(1 2 '(,(+ 1 2))) '(1 2 '(3))))
|
||||
(pass-if "when" (eq? (when #t 'true) 'true))
|
||||
(pass-if "when 2" (eq? (when #f 'true) *unspecified*))
|
||||
|
||||
(define b 0)
|
||||
(define x (lambda () b))
|
||||
(define (x) b)
|
||||
(pass-if "closure" (= (x) 0))
|
||||
(define (c b)
|
||||
(x))
|
||||
(pass-if "closure 2" (= (c 1) 0))
|
||||
|
||||
(define (x)
|
||||
(define b 1)
|
||||
(define (y) b)
|
||||
(set! b 0)
|
||||
(list b
|
||||
(let ((b 2))
|
||||
(y))))
|
||||
|
||||
(pass-if "closure 3" (equal? (x) '(0 0)))
|
||||
|
||||
(newline)
|
||||
(display "passed: ") (display (car (result))) (newline)
|
||||
(display "failed: ") (display (cadr (result))) (newline)
|
||||
(display "total: ") (display (apply + (result))) (newline)
|
||||
|
||||
(display "(procedure? procedure?): ")
|
||||
(display (procedure? procedure?))
|
||||
(newline)
|
||||
|
||||
(define *gensym* 0)
|
||||
(define (gensym)
|
||||
(set! *gensym* (+ *gensym* 1))
|
||||
(string->symbol (string-append "g" (number->string *gensym*))))
|
||||
|
||||
(display (gensym))
|
||||
(newline)
|
||||
(display (gensym))
|
||||
(newline)
|
||||
(display (gensym))
|
||||
(newline)
|
||||
|
||||
(display "unquote:")
|
||||
(display `,(list 1 2 3 4))
|
||||
(newline)
|
||||
|
||||
(display `('boo ,@'(bah baz) 1 2))
|
||||
(newline)
|
||||
|
||||
(display "splice:")
|
||||
(display `(1 ,@(list 2 3) 4))
|
||||
(newline)
|
||||
|
||||
(define s-r '(2 3))
|
||||
(display "splice:")
|
||||
(display `(1 ,@s-r 4))
|
||||
(newline)
|
||||
|
||||
(display "`(1 2 '(,(+ 1 2))): ")
|
||||
(display `(1 2 '(,(+ 1 2))))
|
||||
(newline)
|
||||
|
||||
(display "when:")
|
||||
(when #t
|
||||
(display "true")
|
||||
(newline))
|
||||
|
||||
(when #f
|
||||
(display "must not see")
|
||||
(newline))
|
||||
|
||||
'()
|
||||
(exit (cadr (result)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue