ref: 6007bba597de871030e8ac15ebd364c8b063437f
parent: ee64888896c356a8d3fab62a529e3719b9fdebee
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Dec 31 18:06:58 EST 2024
<= and >=: 1 and >2 arguments support Fixes: https://todo.sr.ht/~ft/femtolisp/32
--- a/flisp.boot
+++ b/flisp.boot
@@ -48,10 +48,10 @@
1+ #fn("6000n10KM:" #() 1+) 1-
#fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?
length=) 1arg-lambda?)
- <= #fn("6000n210L2;IB0470051;380470151S:" #(nan?) <=) >
+ <= #fn("9000z0700f2;I:047172052S:" #(> every nan?) <=) >
#fn("<000z1\x8d\x8a620862186>1_51486<0162:" #(#0#
#fn("7000n21V;IE041<0L2;3;04A<1<1=62:" #() f)) >)
- >= #fn("6000n201L2;IB0470051;380470151S:" #(nan?) >=) Instructions
+ >= #fn("9000z0700f2;I:047172052S:" #(< every nan?) >=) Instructions
#table(call.l 81 trycatch 75 largc 79 loadg.l 68 aref2 23 box 90 cadr 36 argc 62 setg 71 load0 21 vector? 45 fixnum? 41 loadc0 17 loada0 0 div0 59 keyargs 89 call 5 loada.l 69 brt.l 50 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 loadvoid 93 loada1 1 shift 46 boolean? 39 atom? 24 cdr 13 brne.l 83 / 58 loadf 31 equal? 52 apply 54 dup 11 loadt 20 jmp.l 48 null? 38 not 35 = 60 set-cdr! 30 eq? 33 * 57 load1 27 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 94 + 55 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 cons? 18 brf.l 49 aref 92 symbol? 34 aset! 64 car 12 cons 32 tcall.l 82 - 56 brn.l 86 optargs 87 closure 14 pop 4 eqv? 51 list 53 seta 15 seta.l 73 brnn 26 loadnil 65 loadg 7 loada 8 tcall 6)
__init_globals #fn("5000n020w1422w3424w5476w7478w947:w;:" #(#fn("6000n0702161:" #(princ
"#;> ")) *prompt* "/" *directory-separator* "\n" *linefeed* *stdout* *output-stream* *stdin*
binary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/system.lsp
+++ b/system.lsp
@@ -184,11 +184,13 @@
(define-macro (> a . rest)
`(< ,@(reverse! rest) ,a))
-(define (<= a b) (not (or (< b a)
- (and (nan? a) (nan? b)))))
+(define (<= . rest)
+ (not (or (apply > rest)
+ (every nan? rest))))
-(define (>= a b) (not (or (< a b)
- (and (nan? a) (nan? b)))))
+(define (>= . rest)
+ (not (or (apply < rest)
+ (every nan? rest))))
(define (negative? x) (< x 0))
(define (zero? x) (= x 0))
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -138,15 +138,15 @@
(assert (< "a" "b"))
(assert (< "a" "b" "c"))
(assert (> "b" "a"))
-(assert (> "c" "b" "a")) ; FIXME
+(assert (> "c" "b" "a"))
(assert (not (< "a" "a")))
(assert (not (< "a" "a" "a")))
(assert (<= "a" "a"))
-;(assert (<= "a" "a" "a")) ; FIXME
+(assert (<= "a" "a" "a"))
(assert (>= "a" "a"))
-;(assert (>= "a" "a" "a")) ; FIXME
+(assert (>= "a" "a" "a"))
(assert (>= "ab" "aa"))
-;(assert (>= "ab" "aa" "aa")) ; FIXME
+(assert (>= "ab" "aa" "aa"))
; comparing numbers and runes
(assert (< 9 #\newline))