shithub: femtolisp

Info  •  Files  •  Log  •  Branches

member/memv/assoc/assv: make sure it fails on non-lists

--- a/flisp.boot

+++ b/flisp.boot

@@ -67,7 +67,7 @@

 	    argc-error #fn(";000n2702102211Kl37023@402465:" #(error "compile error: " " expects "

 							      " argument." " arguments.") argc-error)

 	    array? #fn("7000n10];IF042005185B;390485<21Q:" #(#fn(typeof) array) array?) assoc

-	    #fn("7000n21H340O:701510d3501<:7101=62:" #(caar assoc) assoc) assv #fn("7000n21H340O:701510c3501<:7101=62:" #(caar

+	    #fn("7000n21J40O:701510d3501<:7101=62:" #(caar assoc) assoc) assv #fn("7000n21J40O:701510c3501<:7101=62:" #(caar

   assv) assv)

 	    bcode:cenv #fn("6000n10r3G:" #() bcode:cenv) bcode:code

 	    #fn("6000n10EG:" #() bcode:code) bcode:ctable #fn("6000n10KG:" #() bcode:ctable)

@@ -300,8 +300,8 @@

 	    map! #fn("8000n21\x8d1B3B04101<51_41=?1@\x1d/4:" #() map!) map-int

 	    #fn(";000n2701E52340q:0E51qPq\x8a78786_4K7115122870>2|486:" #(<= 1- #fn("7000n1A<F051qPN4AA<=_:" #())) map-int)

 	    mark-label #fn("8000n270021163:" #(emit label) mark-label) max

-	    #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3401:0:" #())) max) member #fn("7000n21H340O:1<0d3401:7001=62:" #(member) member)

-	    memv #fn("7000n21H340O:1<0c3401:7001=62:" #(memv) memv) min

+	    #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3401:0:" #())) max) member #fn("7000n21J40O:1<0d3401:7001=62:" #(member) member)

+	    memv #fn("7000n21J40O:1<0c3401:7001=62:" #(memv) memv) min

 	    #fn(";000z11J400:70210163:" #(foldl #fn("6000n201L3400:1:" #())) min) mod #fn("8000n207001521i2~:" #(div) mod)

 	    mod0 #fn("7000n2001k1i2~:" #() mod0) nan?

 	    #fn("6000n1020d;I704021d:" #(+nan.0 -nan.0) nan?) negative? #fn("6000n10EL:" #() negative?)

--- a/system.lsp

+++ b/system.lsp

@@ -90,22 +90,22 @@

 ; standard procedures ---------------------------------------------------------

 (define (member item lst)

-  (cond ((atom? lst) #f)

-        ((equal?     (car lst) item) lst)

-        (#t          (member item (cdr lst)))))

+  (cond ((null? lst)             #f)

+        ((equal? (car lst) item) lst)

+        (#t                      (member item (cdr lst)))))

 (define (memv item lst)

-  (cond ((atom? lst) #f)

-        ((eqv?       (car lst) item) lst)

-        (#t          (memv item (cdr lst)))))

+  (cond ((null? lst)           #f)

+        ((eqv? (car lst) item) lst)

+        (#t                    (memv item (cdr lst)))))

 (define (assoc item lst)

-  (cond ((atom? lst) #f)

-        ((equal?     (caar lst) item) (car lst))

-        (#t          (assoc item (cdr lst)))))

+  (cond ((null? lst)              #f)

+        ((equal? (caar lst) item) (car lst))

+        (#t                       (assoc item (cdr lst)))))

 (define (assv item lst)

-  (cond ((atom? lst) #f)

-        ((eqv?       (caar lst) item) (car lst))

-        (#t          (assv item (cdr lst)))))

+  (cond ((null? lst)            #f)

+        ((eqv? (caar lst) item) (car lst))

+        (#t                     (assv item (cdr lst)))))

 (define (>  a b) (< b a))

 (define (nan? x) (or (equal? x +nan.0) (equal? x -nan.0)))