shithub: sl

--- a/compiler.lsp

+++ b/compiler.lsp

@@ -391,7 +391,9 @@

              (not (length= (cdr x) count)))

         (argc-error b count))

     (case b  ; handle special cases of vararg builtins

-      (list (if (= nargs 0) (emit g 'loadnil) (emit g b nargs)))

+      (list (if (= nargs 0)

+                (emit g 'loadnil)

+                (emit g b nargs)))

       (<    (num-compare))

       (=    (num-compare))

       (+    (cond ((= nargs 0) (emit g 'load0))

--- a/flisp.boot

+++ b/flisp.boot

@@ -15,8 +15,7 @@

 	      #fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #())))

 	      0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 #fn("5000n10\x8e:" #())

0)

-	    *os-version* "6.12.9-0-edge" *properties*

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

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

   :to destination)

   (data :size decompressed-bytes))  = ((a . rest))  <= ((a . rest))  car ((lst))  /= ((a . rest))  void (rest)  *prompt* (#f)  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."  *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"."  nan? "Return #t if the argument is NaN, regardless of the sign."  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."))

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

 	    make-system-image #fn("@000n120021222354202402552212223542650277879Dw84Dw942:898:>22;88878586>42<8;>1{8;504:" #(#fn(file)

   :write :create :truncate #fn(string) ".builtin" #fn(buffer)

   (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width* *print-readably*

-	      *print-level* *print-length* *os-name* *interactive* *prompt*) *print-pretty*

-  *print-readably* #fn("5000n0Aw04Fw1:" #(*print-pretty* *print-readably*))

+	      *print-level* *print-length* *os-name* *interactive* *prompt* *os-version*)

+  *print-pretty* *print-readably* #fn("5000n0Aw04Fw1:" #(*print-pretty* *print-readably*))

   #fn("?000n07021A>17223505152742576842577845253f22885F52428859252429927:52^1^142;F512<2=F51r:522>2?E2@2A84522B84r(522B84r 522B84r\x18525629938652429938552^1^1^142C925142C9361:" #(filter

   #fn("8000n10Z;3u0420051S;3j0421051[S;IC0422051222105151dS;3I04230A52S;3=04242105151S:" #(#fn(constant?)

   #fn(top-level-value) #fn(string) #fn(memq) #fn(iostream?))) simple-sort #fn(environment) nconc #fn(map)

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

--- a/system.lsp

+++ b/system.lsp

@@ -995,8 +995,8 @@

           (throw 'ffound path)

           (let ((v (function:vals f)))

             (for 0 (1- (length v))

-                 (λ (i) (if (closure? (aref v i))

-                                 (find-in-f (aref v i) tgt path))))))))

+                 (λ (i) (when (closure? (aref v i))

+                          (find-in-f (aref v i) tgt path))))))))

   (define (fn-name f e)

     (let ((p (catch 'ffound

                     (begin

@@ -1083,7 +1083,7 @@

         (excludes '(*linefeed* *directory-separator* *argv* that

                     *print-pretty* *print-width* *print-readably*

                     *print-level* *print-length* *os-name* *interactive*

-                    *prompt*)))

+                    *prompt* *os-version*)))

     (with-bindings ((*print-pretty* #t)

                     (*print-readably* #t))

       (let* ((syms