diff options
| author | 2024-08-29 22:24:33 -0400 | |
|---|---|---|
| committer | 2024-08-29 22:24:33 -0400 | |
| commit | f160ecaae1532cb61e3158756b24193fb67c895e (patch) | |
| tree | 05bc9c2e02a174da3732ab9f104460c59f2b1eb6 /miniscm | |
| parent | miniscm: add mutable string emulation and char->integer (diff) | |
add sets
Diffstat (limited to 'miniscm')
| -rw-r--r-- | miniscm/init.scm | 60 | ||||
| -rw-r--r-- | miniscm/miniscm.c | 3 |
2 files changed, 62 insertions, 1 deletions
diff --git a/miniscm/init.scm b/miniscm/init.scm index c3f5612..91abe72 100644 --- a/miniscm/init.scm +++ b/miniscm/init.scm @@ -114,3 +114,63 @@ (if (< (char->integer x) (char->integer y)) '< '>)))))) + +(define max + (lambda (curmax . rest) + (if (null? rest) + curmax + (let ((next-num (car rest))) + (apply max + (cons (if (> next-num curmax) next-num curmax) + (cdr rest))))))) + +(define all + (lambda (f l) + (cond + ((null? l) #t) + ((not (f (car l))) (all f (cdr l))) + (else #f)))) + +(define any + (lambda (f l) + (cond + ((null? l) #f) + ((f (car l)) #t) + (else (any f (cdr l)))))) + +(macro + cond-expand + (lambda (body) + (letrec + ((loop + (lambda (body) + (if (null? body) + #f + (let ((elem (car body))) + (cond + ((eqv? (car elem) 'else) + (cons 'begin (cdr elem))) + ((and (pair? elem) + (passes? (car elem))) + (cons 'begin (cdr elem))) + (else (loop (cdr body)))))))) + (passes? + (lambda (boolean-form) + (cond + ((eqv? boolean-form 'miniscm-unslisp) #t) + ((eqv? boolean-form 'r3rs) #t) + ((symbol? boolean-form) #f) + ((not (pair? boolean-form)) (error "invalid boolean form")) + ((eqv? (car boolean-form) 'and) + (all passes? (cdr boolean-form))) + ((eqv? (car boolean-form) 'or) + (any passes? (cdr boolean-form))) + ((eqv? (car boolean-form) 'not) + (not (passes? (cadr boolean-form)))) + (else (error "invalid boolean function")))))) + (loop (cdr body))))) + +(define (abs x) + (if (< x 0) + (- x) + x)) diff --git a/miniscm/miniscm.c b/miniscm/miniscm.c index e7597c9..6708a1a 100644 --- a/miniscm/miniscm.c +++ b/miniscm/miniscm.c @@ -79,7 +79,6 @@ * Define or undefine following symbols as you need. */ /* #define VERBOSE */ /* define this if you want verbose GC */ -#define VERBOSE #define AVOID_HACK_LOOP /* define this if your compiler is poor * enougth to complain "do { } while (0)" * construction. @@ -91,6 +90,8 @@ #define USE_MACRO /* undef this if you do not need macro */ #endif +#define USE_MACRO + #ifdef USE_QQUOTE /*-- * If your machine can't support "forward single quotation character" |
