add /= and update the docs for comparison operators

Sigrid Solveig Haflínudóttir committed 1 year ago

Commit 1b155961 parent 049f0336 files · +28 −26Browse files

Unified · Split

6 files

docs_extra.lsp +2 −15
flisp.boot +8 −6
flisp.boot.builtin +0 −0
system.lsp +14 −1
test/color.lsp +2 −2
test/unittest.lsp +3 −3

@@ -9,21 +9,8 @@ · 8 unmodified lines
9	(error "docs: " sym ": funvars set but isn't a function")))	9	(error "docs: " sym ": funvars set but isn't a function")))
10	`(symbol-set-doc ',sym ',doc ',funvars)))	10	`(symbol-set-doc ',sym ',doc ',funvars)))
11		11
12	(doc-for (< a . rest)	12	(doc-for (= a . rest)
13	"Return #t if the arguments are in strictly increasing order (previous	13	"Return #t if the arguments are equal.")
14	one is less than the next one).")
15
16	(doc-for (<= a . rest)
17	"Return #t if the arguments are in non-decreasing order (previous
18	one is less than or equal to the next one).")
19
20	(doc-for (> a . rest)
21	"Return #t if the arguments are in strictly decreasing order (previous
22	one is greater than the next one).")
23
24	(doc-for (>= a . rest)
25	"Return #t if the arguments are in non-increasing order (previous
26	one is greater than or equal to the next one).")
27		14
28	(doc-for (vm-stats)	15	(doc-for (vm-stats)
29	"Print various VM-related information, such as the number of GC calls	16	"Print various VM-related information, such as the number of GC calls

flisp.boot+8−6

 	      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
+  (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))  + ((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."))
+  (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
   λ #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)
   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
+								       reverse!))  quasiquote #fn("7000n1700E62:" #(bq-process))  when #fn(";000z1200211POe4:" #(if
-  list quote thrown-value))  quasiquote #fn("7000n1700E62:" #(bq-process)))
+  begin)))
 	    1+ #fn("6000n10KM:" #() 1+) 1-
 	    #fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?
   length=) 1arg-lambda?)

flisp.boot.builtin+0−0

Binary file not shown.

system.lsp+14−1

         ((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)
   `(< ,@(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)
   (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))
           (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))
 (define (positive? x) (> x 0))

test/color.lsp+2−2

@@ -84,6 +84,6 @@ · 83 unmodified lines
84	(let ((result ()))	84	(let ((result ()))
85	(dotimes (x 25)	85	(dotimes (x 25)
86	(dotimes (y 25)	86	(dotimes (y 25)
87	(if (and (not (= x y)) (can-attack x y))	87	(when (and (/= x y) (can-attack x y))
88	(set! result (cons (cons x y) result)) ())))	88	(set! result (cons (cons x y) result)))))
89	result))	89	result))

test/unittest.lsp+3−3

@@ -120,9 +120,9 @@ · 119 unmodified lines
120	; NaNs	120	; NaNs
121	(assert (equal? +nan.0 +nan.0))	121	(assert (equal? +nan.0 +nan.0))
122	(assert (equal? -nan.0 -nan.0))	122	(assert (equal? -nan.0 -nan.0))
123	(assert (not (= +nan.0 +nan.0)))	123	(assert (/= +nan.0 +nan.0))
124	(assert (not (= +nan.0 -nan.0)))	124	(assert (/= +nan.0 -nan.0))
125	(assert (not (= -nan.0 -nan.0)))	125	(assert (/= -nan.0 -nan.0))
126	(assert (equal? (< +nan.0 3) (> 3 +nan.0)))	126	(assert (equal? (< +nan.0 3) (> 3 +nan.0)))
127	(assert (equal? (< +nan.0 (double 3)) (> (double 3) +nan.0)))	127	(assert (equal? (< +nan.0 (double 3)) (> (double 3) +nan.0)))
128	(assert (equal? (< +nan.0 3) (> (double 3) +nan.0)))	128	(assert (equal? (< +nan.0 3) (> (double 3) +nan.0)))

add /= and update the docs for comparison operators

Keyboard shortcuts

General

Issues and pull requests

Issues, pull requests and Inbox

Repository code