Skip to content

Commit

Permalink
Squashed 'main/lispBM/' changes from 34066d00..cd6b6e2a
Browse files Browse the repository at this point in the history 
cd6b6e2a fix bug in reader that would abort on full heap in particular situation without doing a gc-retry
269c2122 update how error rows is reported
b82c78f8 tweak to expand.lisp in repl/examples
ae1ffea6 small tweak to program rendering in doclib
13d4d47e update to documentation
d0eccb6f added an example to repl/examples

git-subtree-dir: main/lispBM
git-subtree-split: cd6b6e2a853e67c4bfd69e871d86b3078ec2335e
  • Loading branch information
@vedderb
vedderb committed Oct 25, 2024
1 parent 5e5ba26 commit 4d048d2
Show file tree
Hide file tree
Showing 12 changed files with 249 additions and 197 deletions.
2 changes: 1 addition & 1 deletion doc/Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ runtimeref.md: doclib.env runtimeref.lisp
strange.md: doclib.env strange.lisp
lbm -H 10000000 --src="strange.lisp" --eval="(render-manual)" --load_env="doclib.env" --terminate

strange.md: doclib.env efficient.lisp
efficient.md: doclib.env efficient.lisp
lbm -H 10000000 --src="efficient.lisp" --eval="(render-manual)" --load_env="doclib.env" --terminate

clean:
Expand Down
24 changes: 11 additions & 13 deletions doc/displayref.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -334,9 +334,8 @@ Allocate an image buffer from lbm memory or from a compactible region. The form


```clj
(define my-dm (dm-create 10000))
(define my-img (img-buffer my-dm 'indexed2 320 200))

(define my-dm (dm-create 10000))
(define my-img (img-buffer my-dm 'indexed2 320 200))
```


Expand Down Expand Up @@ -1312,22 +1311,21 @@ t


```clj
(define w 320)
(define h 200)
(define corners (list (cons 10 (- h 10)) (cons (- w 10) (- h 10)) (cons (/ w 2) 10)))
(define s-img (img-buffer 'indexed2 w h))
(defun point (p) (img-setpix s-img (car p) (cdr p) 1))
(defun mid-point (p1 p2) (progn (let ((x (/ (+ (car p1) (car p2)) 2))
(define w 320)
(define h 200)
(define corners (list (cons 10 (- h 10)) (cons (- w 10) (- h 10)) (cons (/ w 2) 10)))
(define s-img (img-buffer 'indexed2 w h))
(defun point (p) (img-setpix s-img (car p) (cdr p) 1))
(defun mid-point (p1 p2) (progn (let ((x (/ (+ (car p1) (car p2)) 2))
(y (/ (+ (cdr p1) (cdr p2)) 2)))
(cons x y))))
(defun sierp (n corners p) (if (= n 0) nil (let ((i (mod (rand) 3))
(defun sierp (n corners p) (if (= n 0) nil (let ((i (mod (rand) 3))
(target (ix corners i))
(mid (mid-point p target)))
(progn (point mid)
(sierp (- n 1) corners mid)))))
(sierp 25000 corners (car corners))
(disp-render s-img 0 0 '(0 16777215))

(sierp 25000 corners (car corners))
(disp-render s-img 0 0 '(0 16777215))
```


Expand Down
79 changes: 54 additions & 25 deletions doc/doclib.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,32 +12,35 @@
( (read-eval . _) true)
(_ false)))

(defun pretty (c)
(pretty-ind 0 c))
(defun pretty (toplevel c)
(if (and toplevel (list? c))
(pretty-toplevel-list c)
(pretty-ind 0 c)
))

(defun ind-spaces (n)
(str-replicate n 32b))

(defun pretty-ind (n c)
(match c
( (loop (? e) . (? es))
(str-merge (ind-spaces n) "(loop " (pretty e) (pretty-aligned-ontop (+ n 6) es) ")" ))
(str-merge (ind-spaces n) "(loop " (pretty nil e) (pretty-aligned-ontop (+ n 6) es) ")" ))
( (atomic (? e) . (? es))
(str-merge (ind-spaces n) "(atomic " (pretty e) (pretty-aligned-ontop (+ n 8) es) ")" ))
(str-merge (ind-spaces n) "(atomic " (pretty nil e) (pretty-aligned-ontop (+ n 8) es) ")" ))
( (recv (? e) . (? es))
(str-merge (ind-spaces n) "(recv " (pretty e) (pretty-aligned-ontop (+ n 6) es) ")" ))
(str-merge (ind-spaces n) "(recv " (pretty nil e) (pretty-aligned-ontop (+ n 6) es) ")" ))
( (recv-to (? e) . (? es))
(str-merge (ind-spaces n) "(recv-to " (pretty e) (pretty-aligned-ontop (+ n 9) es) ")" ))
(str-merge (ind-spaces n) "(recv-to " (pretty nil e) (pretty-aligned-ontop (+ n 9) es) ")" ))
( (match (? e) . (? es))
(str-merge (ind-spaces n) "(match " (pretty e) (pretty-aligned-ontop (+ n 7) es) ")" ))
(str-merge (ind-spaces n) "(match " (pretty nil e) (pretty-aligned-ontop (+ n 7) es) ")" ))
( (progn (? e ) . (? es))
(str-merge (ind-spaces n) "(progn " (pretty e) (pretty-aligned-ontop (+ n 7) es) ")" ))
( (quote (? e)) (str-merge (ind-spaces n) "'" (pretty e)))
(str-merge (ind-spaces n) "(progn " (pretty nil e) (pretty-aligned-ontop (+ n 7) es) ")" ))
( (quote (? e)) (str-merge (ind-spaces n) "'" (pretty nil e)))
( (let ((? b0) . (? brest)) (? body)) ;; pattern
(str-merge (ind-spaces n)
"(let ("

(pretty b0)
(pretty nil b0)
(pretty-aligned-ontop (+ n 6) brest)
")\n"

Expand All @@ -46,24 +49,35 @@
))
( (cond (? x) . (? xs) )
(let ( (conds (pretty-aligned-ontop (+ n 6) xs))
(cond0 (pretty x)))
(cond0 (pretty nil x)))
(str-merge (ind-spaces n) "(cond " cond0 conds ")")
)
)
( ((? x) . (? xs)) (str-merge (ind-spaces n) "(" (pretty x) (pretty-list xs) ")" ))
( ((? x) . (? xs)) (str-merge (ind-spaces n) "(" (pretty nil x) (pretty-list xs) ")" ))
(_ (str-merge (ind-spaces n) (to-str c))))
)

(defun pretty-list (c)
(match c
( nil "" )
( ((? x) . nil) (str-merge " " (pretty x) ))
( ((? x) . nil) (str-merge " " (pretty nil x) ))
( ((? x) . (? y))
(if (eq (type-of y) type-list)
(str-merge " " (pretty x) (pretty-list y))
(str-merge " " (pretty x) "." (pretty y)))
(str-merge " " (pretty nil x) (pretty-list y))
(str-merge " " (pretty nil x) "." (pretty nil y)))
)
( (? x) (str-merge " . " (pretty x)))))
( (? x) (str-merge " . " (pretty nil x)))))

(defun pretty-toplevel-list (c)
(match c
( nil "" )
( ((? x) . nil) (str-merge " " (pretty nil x) ))
( ((? x) . (? y))
(if (eq (type-of y) type-list)
(str-merge " " (pretty nil x) "\n" (pretty-toplevel-list y))
(str-merge " " (pretty nil x) "." (pretty nil y)))
)
( (? x) (str-merge " . " (pretty nil x)))))

(defun pretty-aligned-ontop (n cs)
(match cs
Expand All @@ -78,7 +92,7 @@
( ((? x) . (? xs))
(let ((x-str (if (is-read-eval-txt x)
(ix x 1)
(pretty x)))
(pretty nil x)))
(x-code (if (is-read-eval-txt x)
(read (ix x 1))
x))
Expand Down Expand Up @@ -116,7 +130,7 @@
( ((? x) . (? xs))
(let ((x-str (if (is-read-eval-txt x)
(ix x 1)
(pretty x)))
(pretty nil x)))
(x-code (if (is-read-eval-txt x)
(read (ix x 1))
x))
Expand Down Expand Up @@ -164,7 +178,7 @@
( ((? x) . (? xs))
(let ((x-str (if (is-read-eval-txt x)
(ix x 1)
(pretty x)))
(pretty nil x)))
(x-code (if (is-read-eval-txt x)
(read (ix x 1))
x))
Expand Down Expand Up @@ -229,14 +243,23 @@
(match cs
(nil t)
( ((? x) . (? xs))
(let ((cstrs (map (lambda (c) (str-merge (pretty c) "\n")) x))
(res (eval-program nil x))
(let ((x-str (if (is-read-eval-txt x)
(ix x 1)
(pretty 't x)))
(x-code (if (is-read-eval-txt x)
(read-program (ix x 1))
x))
(res (eval-program nil x-code))
(rstr (to-str res)))
;(let ((cstrs (map (lambda (c) (str-merge (pretty c) "\n")) x))
; (res (eval-program nil x))
; (rstr (to-str res)))
{
(rend "<tr>\n")
(rend "<td>\n\n")
(rend "\n```clj\n")
(map rend cstrs)
;(map rend cstrs)
(rend x-str)
(rend "\n```\n")
(rend "\n\n</td>\n")
(rend "<td>\n\n")
Expand All @@ -262,16 +285,22 @@
(match cs
(nil t)
( ((? x) . (? xs))
(let ((cstrs (map (lambda (c) (str-merge (pretty c) "\n")) x))
(res (eval-program nil x))
(let ((x-str (if (is-read-eval-txt x)
(ix x 1)
(pretty 't x)))
(x-code (if (is-read-eval-txt x)
(read-program (ix x 1))
x))
(res (eval-program nil x-code))
(rstr (to-str res))
(png (png-file)))
{
(save-active-image png)
(rend "<tr>\n")
(rend "<td>\n\n")
(rend "\n```clj\n")
(map rend cstrs)
;(map rend cstrs)
(rend x-str)
(rend "\n```\n")
(rend "\n\n</td>\n")
;; image
Expand Down
Binary file modified doc/images/add_one_two.png
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file modified doc/images/list_1234.png
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file modified doc/images/snoc_1234.png
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file modified doc/images/sum_of_squares.png
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading

0 comments on commit 4d048d2

Please sign in to comment.