[ prog / sol / mona ]

prog


How can I run my own instance of this

64 2020-02-22 23:53

[1/2]
Since your BIOS is being a Basic Inducer Of Suffering, here is an implementation of >>57 to eliminate delete-duplicates, in the MIT/GNU Scheme 9.1.1 from the Ubuntu LTS, while keeping as much of your structure as possible:

(define (posts-range range)
  (define (expand-range x)
    (cond ((> (length x) 1)
           (let* ((a (string->number (car x)))
                  (b (string->number (cadr x)))
                  (low (if (> a *max-posts*) *max-posts* a))
                  (high (if (> b *max-posts*) *max-posts* b))
                  (count (+ (- high low) 1)))
             (if (> high low)
                 (lambda () (iota count low))
                 (lambda () (list low)))))
          (else (let* ((a (string->number (car x)))
                       (low (if (> a *max-posts*) *max-posts* a)))
                  (lambda () (list low))))))
  (define (invoke-loop-set vector lamb)
    (for-each (lambda (e) (vector-set! vector e #t))
              (lamb)))
  (let* ((r1 (string-split range #\,))
         (r2 (map (lambda (x) (string-split x #\-)) r1))
         (r3 (map expand-range r2))
         (vec (make-vector (+ *max-posts* 1) #f)))
    (for-each (lambda (e) (invoke-loop-set vec e))
              r3)
    vec))

Here are some tests, keeping in mind that posts-range runs after the regex match:

1 ]=> (posts-range "1,3,5,7,290-300")
;Value 13: #(#f #t #f #t #f #t #f #t #f #f #f #f [...] #f #f #f #f #t #t #t #t #t #t #t #t #t #t #t)
1 ]=> (posts-range "1-9999999999")
;Value 14: #(#f #t #t #t #t #t #t #t #t #t #t #t [...] #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t)
1 ]=> (define fulltest (apply string-append (cons "1-300" (make-list (quotient (- 4096 7) 6) ",1-300"))))

At this point fulltest is >>50.

1 ]=> (posts-range fulltest)
;Value 17: #(#f #t #t #t #t #t #t #t #t #t #t #t [...] #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t)
1 ]=> (define (timeit proc)
   (with-timings proc
      (lambda (run-time gc-time real-time)
         (write (internal-time/ticks->seconds run-time))
         (write-char #\space)
         (write (internal-time/ticks->seconds gc-time))
         (write-char #\space)
         (write (internal-time/ticks->seconds real-time))
         (newline))))
1 ]=> (timeit (lambda () (posts-range "1,3,5,7,290-300")))
0. 0. 0.
1 ]=> (timeit (lambda () (posts-range fulltest)))
.04 0. .044
65 2020-02-22 23:54

[2/2]
The time for fulltest fluctuates between 4 and 5 centiseconds, but since the homepage has:

Runs well on "el cheapo" VPS

I recommend both regex refinements as well. To integrate with filter-func, here is a diff against the current gitlab version, which is the last commit of "20 Feb, 2020". This one is untested because I do not yet have a local instance, but it is simple enough that it should work.

$ TZ=GMT diff -u schemebbs/bbs.scm edit/bbs.scm
--- schemebbs/bbs.scm	2020-02-20 15:17:38.682224678 +0000
+++ edit/bbs.scm	2020-02-22 14:41:02.198743998 +0000
@@ -138,10 +138,12 @@
            (let* ((t (call-with-input-file path read))
                   (headline (lookup-def 'headline t))
                   (posts (lookup-def 'posts t))
-                  (filter-func (if (default-object? range)
-                                   identity
-                                   (lambda (e) (member (car e) (posts-range range))))))
-             (cond ((default-object? range)
+                  (norange (default-object? range))
+                  (rangeonce (if norange "unused" (posts-range range)))
+                  (filter-func (if norange
+                                   (lambda (e) #t)
+                                   (lambda (e) (vector-ref rangeonce (car e))))))
+             (cond (norange
                  (if (not (file-exists? cache))
                      (write-and-serve cache (thread-template board thread posts headline filter-func))
                      (begin (display "reverse proxy miss") (serve-file cache)))) ;; we shouldn't go here, reverse proxy fetches the page itself

Here are the two regex refinements for digit count >>47 and interval count >>49. The SYNCs are there for grep. The irregex PCRE ranges are linked in >>47.

$ TZ=GMT diff -u schemebbs/bbs.scm edit/bbs.scm
--- schemebbs/bbs.scm	2020-02-20 15:17:38.682224678 +0000
+++ edit/bbs.scm	2020-02-22 15:40:23.041388774 +0000
@@ -153,7 +153,9 @@
 
 
 (define (range? posts)
-  (irregex-match "([1-9][0-9]*|([1-9][0-9]*)-([1-9][0-9]*))(,([1-9][0-9]*|([1-9][0-9]*-[1-9][0-9]*)))*" posts))
+  (irregex-match "(([1-9][0-9]{0,2})|(([1-9][0-9]{0,2})-([1-9][0-9]{0,2})))(,(([1-9][0-9]{0,2})|(([1-9][0-9]{0,2})-([1-9][0-9]{0,2})))){0,11}" posts))
+  ; SYNC lib/markup.scm:quotelink
+  ; SYNC digit count of *max-posts*
 
 (define (posts-range range)
   (define (expand-range x)
$ TZ=GMT diff -u schemebbs/lib/markup.scm edit/lib/markup.scm
--- schemebbs/lib/markup.scm	2020-02-20 15:17:38.682224678 +0000
+++ edit/lib/markup.scm	2020-02-22 15:38:37.134770741 +0000
@@ -182,7 +182,8 @@
 (define quotelink
   (transform-rule
     'quotelink
-    (irregex ">>([1-9][0-9]*|([1-9][0-9]*)-([1-9][0-9]*))(,([1-9][0-9]*|([1-9][0-9]*-[1-9][0-9]*)))*")
+    (irregex ">>(([1-9][0-9]{0,2})|(([1-9][0-9]{0,2})-([1-9][0-9]{0,2})))(,(([1-9][0-9]{0,2})|(([1-9][0-9]{0,2})-([1-9][0-9]{0,2})))){0,11}")
+    ; SYNC bbs.scm:range?
     (lambda (sub) `(a (@ (href ,(string-append
                                   "/" *board*
                                   "/" *thread*

With all of the above applied, the maximum stress that can be put on posts-range is:

1 ]=> (define maxtest (apply string-append (cons "1-300" (make-list 11 ",1-300"))))
1 ]=> (posts-range maxtest)

which runs in zero time.
>>1-300,1-300,1-300,1-300,1-300,1-300,1-300,1-300,1-300,1-300,1-300,1-300
If the server machine is an honest-to-God potato, the 11 can be further reduced.

66 2020-02-23 14:19 *

>>64
Is there a performance reason for expand-range to have such convoluted logic?

(define (expand-range x)
  (let ((first (min *max-posts* (string->number (car x))))
        (last (min *max-posts* (string->number
                                (if (null? (cdr x)) (car x) (cadr x))))))
    (lambda ()
      (iota
       (if (> last first) (- last -1 first) 1)
       first))))

I would also recommend using the name ``thunk'' instead of ``lamb''.

>>65
Do you usually use these ``SYNC'' annotations in your projects? They seem prone to human error. I see no reason why the digit length of *max-posts* couldn't be computed at startup and added to the regex string. If you extract the string from range? into a variable, you could also easily reuse it in ==quotelink=.

67 2020-02-23 20:18 *

>>64-67
Wow! Thanks for the patches. I can't express my gratitude enough in those apocalyptic times. (I just managed to have a working system again, I'm installing MIT Scheme 9.2 and will detail the long overdue installation of SchemeBBS)

While the regex seems correct when I try it at the REPL, there's a weird bug with the transform rule, as in >>65:
>>1,10-20,30

I have to sort this out.

301


VIP:

do not edit these