shithub: femtolisp

--- a/docs_extra.lsp

+++ b/docs_extra.lsp

@@ -9,21 +9,8 @@

           (error "docs: " sym ": funvars set but isn't a function")))

     `(symbol-set-doc ',sym ',doc ',funvars)))

-(doc-for (< a . rest)

-  "Return #t if the arguments are in strictly increasing order (previous

-one is less than the next one).")

-(doc-for (<= a . rest)

-  "Return #t if the arguments are in non-decreasing order (previous

-one is less than or equal to the next one).")

-(doc-for (> a . rest)

-  "Return #t if the arguments are in strictly decreasing order (previous

-one is greater than the next one).")

-(doc-for (>= a . rest)

-  "Return #t if the arguments are in non-increasing order (previous

-one is greater than or equal to the next one).")

+(doc-for (= a . rest)

+  "Return #t if the arguments are equal.")

 (doc-for (vm-stats)

   "Print various VM-related information, such as the number of GC calls

--- a/flisp.boot

+++ b/flisp.boot

@@ -16,10 +16,11 @@

 	      0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 0)

 	    *properties* #table(*funvars* #table(>= ((a . rest))  void? ((x))  length= ((lst n))  help ((term))  lz-unpack ((data

   :to destination)

-  (data :size decompressed-bytes))  <= ((a . rest))  car ((lst))  < ((a . rest))  void (rest)  *prompt* (nil)  lz-pack ((data

-  (level 0)))  cons? ((value))  vm-stats (nil)  * ((number…))  cdr ((lst))  + ((number…))  > ((a . rest)))  *doc* #table(+ "Return sum of the numbers or 0 with no arguments."  >= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)."  void? "Return #t if x is #<void> and #f otherwise."  length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates."  help "Display documentation for the specified term, if available."  lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)."  *builtins* "VM instructions as closures."  car "Returns the first element of a list or nil if not available."  < "Return #t if the arguments are in strictly increasing order (previous\none is less than the next one)."  void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit."  arg-counts "VM instructions mapped to their expected arguments count."  *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"."  lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10.  With level 0 a simple LZSS\nusing hashing will be performed.  Levels between 1 and 9 offer a\ntrade-off between time/space and ratio.  Level 10 is optimal but very\nslow."  Instructions "VM instructions mapped to their encoded byte representation."  cons? "Returns #t if the value is a cons cell."  vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc."  * "Return product of the numbers or 1 with no arguments."  > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  cdr "Returns the tail of a list or nil if not available."  *properties* "All properties of symbols recorded with putprop are recorded in this table."))

+  (data :size decompressed-bytes))  = ((a . rest))  <= ((a . rest))  car ((lst))  /= ((a . rest))  void (rest)  *prompt* (nil)  nan? ((x))  lz-pack ((data

+  (level 0)))  cons? ((value))  vm-stats (nil)  * ((number…))  cdr ((lst))  > ((a . rest))  + ((number…)))  *doc* #table(+ "Return sum of the numbers or 0 with no arguments."  >= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)."  void? "Return #t if x is #<void> and #f otherwise."  length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates."  help "Display documentation for the specified term, if available."  lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  = "Return #t if the arguments are equal."  <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)."  *builtins* "VM instructions as closures."  car "Returns the first element of a list or nil if not available."  /= "Return #t if not all arguments are equal. Shorthand for (not (= …))."  void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit."  arg-counts "VM instructions mapped to their expected arguments count."  nan? "Return #t if the argument is equal to NaN, regardless of the sign."  *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"."  Instructions "VM instructions mapped to their encoded byte representation."  lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10.  With level 0 a simple LZSS\nusing hashing will be performed.  Levels between 1 and 9 offer a\ntrade-off between time/space and ratio.  Level 10 is optimal but very\nslow."  vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc."  cons? "Returns #t if the value is a cons cell."  * "Return product of the numbers or 1 with no arguments."  > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  cdr "Returns the tail of a list or nil if not available."  *properties* "All properties of symbols recorded with putprop are recorded in this table."))

 	    *runestring-type* (array rune) *string-type* (array byte)

-	    *syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin))  unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym)

+	    *syntax-environment* #table(throw #fn("9000n220212223e201e4e2:" #(raise list quote

+									      thrown-value))  unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym)

   let λ prog1 trycatch begin raise))  help #fn(";000n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getprop

   *doc* princ newline #fn(for-each) #fn("7000n17050471A0P61:" #(newline print)) *funvars* "no help for "

   #fn(string) void))  with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings

@@ -28,7 +29,8 @@

   λ #fn(copy-list) caar let* cadar))  with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *input-stream* #fn(copy-list)))  unless #fn("<000z1200O211Pe4:" #(if begin))  letrec #fn(">000z1202021e12273052e122240522515154e1222605262:" #(#fn(nconc)

   λ #fn(map) car #fn("8000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))

-  #fn(copy-list) #fn("5000n17060:" #(void))))  time #fn(">000n12050218522e1e2e123024252622e185e32728e5e3e3:" #(#fn(gensym)

+  #fn(copy-list) #fn("5000n17060:" #(void))))  /= #fn("=000z1202122e10e12315153e2:" #(not #fn(nconc)

+										      = #fn(copy-list)))  time #fn(">000n12050218522e1e2e123024252622e185e32728e5e3e3:" #(#fn(gensym)

   let time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*))  cond #fn(";000z0\x8d\x8a520852185>1_51485<061:" #(#0=#fn("7000z0\x8d:" #() void)

   #fn(">000n10H340O:0<85<20Q;I80485<DQ3C085=J6085<:2185=P:85=J@02285<A<0=51e3:85T23C\x98074758551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:2:50278685<e2e1288675855186e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else

   begin or => 1arg-lambda? caddr caadr let if cddr #fn(gensym)) cond-clauses->if)))  do #fn("J000z220501<2172052217305221240522587268927882829e12:1=51522829e12:82512887e18;52e153e4e3e2e12887e18:52e3:" #(#fn(gensym)

@@ -44,8 +46,8 @@

   symbol-set-doc set-syntax! quote #fn(nconc) λ #fn(copy-list)))  receive #fn("?000z22021q1e32221e10e123825153e3:" #(call-with-values

   λ #fn(nconc) #fn(copy-list)))  dotimes #fn("A000z10<0T20E2187Ke32223e186e1e12415153e4:" #(for -

   #fn(nconc) λ #fn(copy-list)))  > #fn("<000z12021e12273151510e163:" #(#fn(nconc) < #fn(copy-list)

-								       reverse!))  throw #fn("9000n220212223e201e4e2:" #(raise

-  list quote thrown-value))  quasiquote #fn("7000n1700E62:" #(bq-process)))

+								       reverse!))  quasiquote #fn("7000n1700E62:" #(bq-process))  when #fn(";000z1200211POe4:" #(if

+  begin)))

 	    1+ #fn("6000n10KM:" #() 1+) 1-

 	    #fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?

   length=) 1arg-lambda?)

binary files a/flisp.boot.builtin b/flisp.boot.builtin differ

--- a/system.lsp

+++ b/system.lsp

@@ -173,9 +173,14 @@

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

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

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

+(define (nan? x)

+  "Return #t if the argument is equal to NaN, regardless of the sign."

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

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

 (define (> a . rest)

+  "Return #t if the arguments are in strictly decreasing order (previous

+one is greater than the next one)."

   (define (f a rest)

     (or (null? rest)

         (and (< (car rest) a)

@@ -185,6 +190,8 @@

   `(< ,@(reverse! rest) ,a))

 (define (<= a . rest)

+  "Return #t if the arguments are in non-decreasing order (previous

+one is less than or equal to the next one)."

   (define (f a rest)

     (unless (null? rest)

       (or (< (car rest) a)

@@ -193,6 +200,8 @@

   (not (f a rest)))

 (define (>= a . rest)

+  "Return #t if the arguments are in non-increasing order (previous

+one is greater than or equal to the next one)."

   (define (f a rest)

     (unless (null? rest)

       (or (< a (car rest))

@@ -199,6 +208,10 @@

           (nan? a)

           (f (car rest) (cdr rest)))))

   (not (f a rest)))

+(define-macro (/= a . rest)

+  "Return #t if not all arguments are equal. Shorthand for (not (= …))."

+  `(not (= ,a ,@rest)))

 (define (negative? x) (< x 0))

 (define (zero? x)     (= x 0))

--- a/test/color.lsp

+++ b/test/color.lsp

@@ -84,6 +84,6 @@

   (let ((result ()))

     (dotimes (x 25)

       (dotimes (y 25)

-        (if (and (not (= x y)) (can-attack x y))

-            (set! result (cons (cons x y) result)) ())))

+        (when (and (/= x y) (can-attack x y))

+          (set! result (cons (cons x y) result)))))

     result))

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -120,9 +120,9 @@

 ; NaNs

 (assert (equal? +nan.0 +nan.0))

 (assert (equal? -nan.0 -nan.0))

-(assert (not (= +nan.0 +nan.0)))

-(assert (not (= +nan.0 -nan.0)))

-(assert (not (= -nan.0 -nan.0)))

+(assert (/= +nan.0 +nan.0))

+(assert (/= +nan.0 -nan.0))

+(assert (/= -nan.0 -nan.0))

 (assert (equal? (< +nan.0 3) (> 3 +nan.0)))

 (assert (equal? (< +nan.0 (double 3)) (> (double 3) +nan.0)))

 (assert (equal? (< +nan.0 3) (> (double 3) +nan.0)))