diff --git a/doc/Makefile b/doc/Makefile index 72082542..238e7f43 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -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: diff --git a/doc/displayref.md b/doc/displayref.md index 4739a6b5..bf80468f 100644 --- a/doc/displayref.md +++ b/doc/displayref.md @@ -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)) ``` @@ -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)) ``` diff --git a/doc/doclib.lisp b/doc/doclib.lisp index 3c417351..b68b3baf 100644 --- a/doc/doclib.lisp +++ b/doc/doclib.lisp @@ -12,8 +12,11 @@ ( (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)) @@ -21,23 +24,23 @@ (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" @@ -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 @@ -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)) @@ -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)) @@ -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)) @@ -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 "\n") (rend "\n\n") (rend "\n```clj\n") - (map rend cstrs) + ;(map rend cstrs) + (rend x-str) (rend "\n```\n") (rend "\n\n\n") (rend "\n\n") @@ -262,8 +285,13 @@ (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))) { @@ -271,7 +299,8 @@ (rend "\n") (rend "\n\n") (rend "\n```clj\n") - (map rend cstrs) + ;(map rend cstrs) + (rend x-str) (rend "\n```\n") (rend "\n\n\n") ;; image diff --git a/doc/images/add_one_two.png b/doc/images/add_one_two.png index 6b1db106..8e12257c 100644 Binary files a/doc/images/add_one_two.png and b/doc/images/add_one_two.png differ diff --git a/doc/images/list_1234.png b/doc/images/list_1234.png index ec7134ae..e55ca375 100644 Binary files a/doc/images/list_1234.png and b/doc/images/list_1234.png differ diff --git a/doc/images/snoc_1234.png b/doc/images/snoc_1234.png index f8402585..7c4cf650 100644 Binary files a/doc/images/snoc_1234.png and b/doc/images/snoc_1234.png differ diff --git a/doc/images/sum_of_squares.png b/doc/images/sum_of_squares.png index ceba8103..fc45b1de 100644 Binary files a/doc/images/sum_of_squares.png and b/doc/images/sum_of_squares.png differ diff --git a/doc/lbmref.md b/doc/lbmref.md index d8681023..19c3cfaa 100644 --- a/doc/lbmref.md +++ b/doc/lbmref.md @@ -4281,11 +4281,10 @@ If no `cond-exprN` evaluates to true, the result of the entire conditional is `n ```clj -(define a 0) -(cond ((< a 0) 'abrakadabra) + (define a 0) + (cond ((< a 0) 'abrakadabra) ((> a 0) 'llama) ((= a 0) 'hello-world)) - ``` @@ -4305,11 +4304,10 @@ hello-world ```clj -(define a 5) -(cond ((= a 1) 'doughnut) + (define a 5) + (cond ((= a 1) 'doughnut) ((= a 7) 'apple-strudel) ((= a 10) 'baklava)) - ``` @@ -4698,13 +4696,12 @@ The `list-of-local-bindings` are very similar to how `let` works, just that her ```clj -(define sum 0) -(loop ((a 0)) + (define sum 0) + (loop ((a 0)) (<= a 10) (progn (setq sum (+ sum a)) (setq a (+ a 1)))) -sum - + sum ``` @@ -4834,10 +4831,9 @@ The `set` form is used to change the value of some variable in an environment. Y ```clj -(define a 10) -(set 'a 20) -a - + (define a 10) + (set 'a 20) + a ``` @@ -4865,10 +4861,9 @@ a ```clj -(progn (var a 10) + (progn (var a 10) (set 'a 20) a) - ``` @@ -4904,10 +4899,9 @@ The `setq` special-form is similar to `set` and to `setvar` but expects the firs ```clj -(define a 10) -(setq a 20) -a - + (define a 10) + (setq a 20) + a ``` @@ -4935,10 +4929,9 @@ Just like `set` and `setvar`, `setq` can be used on variables that are bound loc ```clj -(progn (var a 10) + (progn (var a 10) (setq a 20) a) - ``` @@ -6045,10 +6038,9 @@ The `setcar` is a destructive update of the car field of a cons-cell. ```clj -(define apa '(1 . 2)) -(setcar apa 42) -apa - + (define apa '(1 . 2)) + (setcar apa 42) + apa ``` @@ -6068,10 +6060,9 @@ apa ```clj -(define apa (list 1 2 3 4)) -(setcar apa 42) -apa - + (define apa (list 1 2 3 4)) + (setcar apa 42) + apa ``` @@ -6107,10 +6098,9 @@ The `setcdr` is a destructive update of the cdr field of a cons-cell. ```clj -(define apa '(1 . 2)) -(setcdr apa 42) -apa - + (define apa '(1 . 2)) + (setcdr apa 42) + apa ``` @@ -6130,10 +6120,9 @@ apa ```clj -(define apa (list 1 2 3 4)) -(setcdr apa (list 99 100)) -apa - + (define apa (list 1 2 3 4)) + (setcdr apa (list 99 100)) + apa ``` @@ -6169,9 +6158,8 @@ apa ```clj -(define apa (list 1 2 3 4 5 6 7 8 9 10)) -(take apa 5) - + (define apa (list 1 2 3 4 5 6 7 8 9 10)) + (take apa 5) ``` @@ -6207,9 +6195,8 @@ apa ```clj -(define apa (list 1 2 3 4 5 6 7 8 9 10)) -(drop apa 5) - + (define apa (list 1 2 3 4 5 6 7 8 9 10)) + (drop apa 5) ``` @@ -6245,9 +6232,8 @@ apa ```clj -(define apa (list 1 2 3 4 5 6 7 8 9 10)) -(reverse apa) - + (define apa (list 1 2 3 4 5 6 7 8 9 10)) + (reverse apa) ``` @@ -6393,10 +6379,9 @@ Rotating a list in the negative direction is slightly faster than rotating in th ```clj -(define a (list 2 4 6 8 10 12)) -(define b (list 1 3 5)) -(merge < a b) - + (define a (list 2 4 6 8 10 12)) + (define b (list 1 3 5)) + (merge < a b) ``` @@ -6432,9 +6417,8 @@ Rotating a list in the negative direction is slightly faster than rotating in th ```clj -(define a (list 1 9 2 5 1 8 3)) -(sort < a) - + (define a (list 1 9 2 5 1 8 3)) + (sort < a) ``` @@ -6580,9 +6564,8 @@ The `setassoc` function destructively updates a key-value mapping in an alist. T ```clj -(define apa (list '(1 . horse) '(2 . donkey) '(3 . shark))) -(setassoc apa 2 'llama) - + (define apa (list '(1 . horse) '(2 . donkey) '(3 . shark))) + (setassoc apa 2 'llama) ``` @@ -7658,11 +7641,10 @@ Use `spawn-trap` to spawn a child process and enable trapping of exit conditions ```clj -(defun thd nil (+ 1 2)) -(spawn-trap thd) -(recv ((exit-error (? tid) (? e)) 'crash) + (defun thd nil (+ 1 2)) + (spawn-trap thd) + (recv ((exit-error (? tid) (? e)) 'crash) ((exit-ok (? tid) (? v)) 'ok)) - ``` @@ -7682,11 +7664,10 @@ ok ```clj -(defun thd nil (+ 1 kurt-russel)) -(spawn-trap thd) -(recv ((exit-error (? tid) (? e)) 'crash) + (defun thd nil (+ 1 kurt-russel)) + (spawn-trap thd) + (recv ((exit-error (? tid) (? e)) 'crash) ((exit-ok (? tid) (? v)) 'ok)) - ``` @@ -7729,7 +7710,7 @@ Use `self` to obtain the thread-id of the thread in which `self` is evaluated. T ```clj -3197 +3131 ``` @@ -7892,10 +7873,9 @@ The `kill` function allows you to force terminate another thread. It has the sig ```clj -(defun f nil (f)) -(define id (spawn f)) -(kill id nil) - + (defun f nil (f)) + (define id (spawn f)) + (kill id nil) ``` @@ -7923,11 +7903,10 @@ The `val-expr` can be observed if the thread exit status is captured using `spaw ```clj -(defun f nil (f)) -(define id (spawn-trap f)) -(kill id 'kurt-russel) -(recv ((? x) x)) - + (defun f nil (f)) + (define id (spawn-trap f)) + (kill id 'kurt-russel) + (recv ((? x) x)) ``` @@ -7936,7 +7915,7 @@ The `val-expr` can be observed if the thread exit status is captured using `spaw ```clj -(exit-ok 178333 kurt-russel) +(exit-ok 186695 kurt-russel) ``` @@ -7977,9 +7956,8 @@ To receive a message use the `recv` command. A process will block on a `recv` un ```clj -(send (self) 28) -(recv ((? n) (+ n 1))) - + (send (self) 28) + (recv ((? n) (+ n 1))) ``` @@ -8017,11 +7995,10 @@ The form of an `recv-to` expression is ```clj (recv-to timeout-secs ```clj -(send (self) 28) -(recv-to 0.100000f32 + (send (self) 28) + (recv-to 0.100000f32 ((? n) (+ n 1)) (timeout 'no-message)) - ``` @@ -8047,11 +8024,10 @@ The form of an `recv-to` expression is ```clj (recv-to timeout-secs ```clj -(send (self) 'not-foo) -(recv-to 0.100000f32 + (send (self) 'not-foo) + (recv-to 0.100000f32 (foo 'got-foo) (timeout 'no-message)) - ``` @@ -8646,10 +8622,9 @@ A value can be moved to flash storage to save space on the normal evaluation hea ```clj -(define a [1 2 3 4 5 6]) -(move-to-flash a) -a - + (define a [1 2 3 4 5 6]) + (move-to-flash a) + a ``` @@ -8669,10 +8644,9 @@ a ```clj -(define ls '(1 2 3 4 5)) -(move-to-flash ls) -ls - + (define ls '(1 2 3 4 5)) + (move-to-flash ls) + ls ``` @@ -8692,10 +8666,9 @@ ls ```clj -(defun f (x) (+ x 1)) -(move-to-flash f) -(f 10) - + (defun f (x) (+ x 1)) + (move-to-flash f) + (f 10) ``` diff --git a/doc/runtimeref.md b/doc/runtimeref.md index 9b21cfa1..23f587b0 100644 --- a/doc/runtimeref.md +++ b/doc/runtimeref.md @@ -1,7 +1,6 @@ # LispBM Runtime Extensions Reference Manual The runtime extensions, if present, can be either compiled in a minimal or a full mode. In the minimal mode only `set-eval-quota` is present. Minimal mode is the default when compiling LBM. To get the full mode the `-DFULL_RTS_LIB` flag must be used when compiling. - ## Environments @@ -25,7 +24,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((gc-stack newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline) (pretty closure (c) (pret +((chapter-memory section 2 "Memory" ((newline (section 3 "mem-num-free" ((para ("`mem-num-free` returns the number of free words in the LBM memory." "This is the memory where arrays and strings are stored.")) (code ((mem-num-free))) nil)) newline hline) ( ``` @@ -43,7 +42,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-gc section 2 "GC" ((newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline))) (ima +((gc-stack newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline) (bold closure (str) (list ``` @@ -61,7 +60,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((environment-get newline (section 3 "env-get" ((para ("`env-get` can be used to reify, turn into value, parts of the global environment." "The global environment is stored as a hashtable and an index into this hashtable" "is used to extract the bindings +((chapter-gc section 2 "GC" ((newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline))) (pro ``` @@ -79,7 +78,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((environment-set newline (section 3 "env-set" ((para ("`env-set` destructively sets an entry in the global environment hashtable.")) (program (((if (eq (env-get 1) nil) (env-set 1 (list (quote (a . 75))))) (env-get 1)))) (para ("Note that in the example +((environment-get newline (section 3 "env-get" ((para ("`env-get` can be used to reify, turn into value, parts of the global environment." "The global environment is stored as a hashtable and an index into this hashtable" "is used to extract the bindings ``` @@ -97,7 +96,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((image-pair closure (cap0 txt0 fig0 cap1 txt1 fig1) (list (quote image-pair) cap0 txt0 fig0 cap1 txt1 fig1) nil) (png-file closure nil (progn (var n png-count) (setq png-count (+ png-count 1)) (str-merge "./images/img" (to-str png-count) ".png")) nil)) +((environment-set newline (section 3 "env-set" ((para ("`env-set` destructively sets an entry in the global environment hashtable.")) (program (((if (eq (env-get 1) nil) (env-set 1 (list (quote (a . 75))))) (env-get 1)))) (para ("Note that in the example ``` @@ -115,7 +114,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((local-environment-get newline (section 3 "local-env-get" ((para ("`local-env-get` can be used to reify, turn into value, the local environment.")) (code ((local-env-get))) (program (((let ((a 50)) (local-env-get))))) nil)) newline hline) (render-program +nil ``` @@ -133,7 +132,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-environments section 2 "Environments" ((newline (section 3 "env-get" ((para ("`env-get` can be used to reify, turn into value, parts of the global environment." "The global environment is stored as a hashtable and an index into this hashtable" " +((local-environment-get newline (section 3 "local-env-get" ((para ("`local-env-get` can be used to reify, turn into value, the local environment.")) (code ((local-env-get))) (program (((let ((a 50)) (local-env-get))))) nil)) newline hline) (png-count . 0) ``` @@ -151,7 +150,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((symbol-table-size newline (section 3 "symtab-size" ((para ("`symtab-size` returns the size of the symbol table in bytes.")) (code ((symtab-size))) nil)) newline hline) (render-code-disp-pairs closure (rend cs) (match cs (nil t) (((? x) ? xs) (let ((x-st +((chapter-environments section 2 "Environments" ((newline (section 3 "env-get" ((para ("`env-get` can be used to reify, turn into value, parts of the global environment." "The global environment is stored as a hashtable and an index into this hashtable" " ``` @@ -169,7 +168,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((symbol-table-size-flash newline (section 3 "symtab-size-flash" ((para ("`symtab-size-flash` returns the size in bytes of the portion of the symbol table" "that is stored in flash.")) (code ((symtab-size-flash))) nil)) newline hline) (intersperse closure +((symbol-table-size newline (section 3 "symtab-size" ((para ("`symtab-size` returns the size of the symbol table in bytes.")) (code ((symtab-size))) nil)) newline hline) (code-disp closure (c) (list (quote code-disp) c) nil) (defun macro (name args body) ``` @@ -187,7 +186,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((symbol-table-size-names newline (section 3 "symtab-size-names" ((para ("`symtab-size-names` returns the size in bytes of the string names stored in" "the symbol table.")) (code ((symtab-size-names))) nil)) newline hline) (info para ("This document was g +((symbol-table-size-flash newline (section 3 "symtab-size-flash" ((para ("`symtab-size-flash` returns the size in bytes of the portion of the symbol table" "that is stored in flash.")) (code ((symtab-size-flash))) nil)) newline hline) (render-code-disp-ta ``` @@ -205,7 +204,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((symbol-table-size-names-flash newline (section 3 "symtab-size-names-flash" ((para ("`symtab-size-names` returns the size in bytes of the string names stored in" "the symbol table in flash.")) (code ((symtab-size-names-flash))) nil)) newline hline)) +((symbol-table-size-names newline (section 3 "symtab-size-names" ((para ("`symtab-size-names` returns the size in bytes of the string names stored in" "the symbol table.")) (code ((symtab-size-names))) nil)) newline hline) (program-disp closure (c) (list ``` @@ -223,7 +222,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-symboltable section 2 "Symbol table" ((newline (section 3 "symtab-size" ((para ("`symtab-size` returns the size of the symbol table in bytes.")) (code ((symtab-size))) nil)) newline hline) (newline (section 3 "symtab-size-flash" ((para ("`symtab +((symbol-table-size-names-flash newline (section 3 "symtab-size-names-flash" ((para ("`symtab-size-names` returns the size in bytes of the string names stored in" "the symbol table in flash.")) (code ((symtab-size-names-flash))) nil)) newline hline) (imag ``` @@ -241,7 +240,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((version newline (section 3 "lbm-version" ((para ("`lbm-version` returns the version of the lbm runtime system.")) (code ((lbm-version))) nil)) newline hline)) +((chapter-symboltable section 2 "Symbol table" ((newline (section 3 "symtab-size" ((para ("`symtab-size` returns the size of the symbol table in bytes.")) (code ((symtab-size))) nil)) newline hline) (newline (section 3 "symtab-size-flash" ((para ("`symtab ``` @@ -259,7 +258,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((arch newline (section 3 "is-64bit" ((para ("`is-64bit` returns true if a 64bit version of lbm is running.")) (code ((is-64bit))) nil)) newline hline) (render-dot closure (filename code) (let ((dot-str (to-dot code)) (name-dot (str-merge "./images/" file +((version newline (section 3 "lbm-version" ((para ("`lbm-version` returns the version of the lbm runtime system.")) (code ((lbm-version))) nil)) newline hline) (intersperse closure (str strs) (match strs (((? s)) s) (((? s) ? ss) (str-merge s str (intersp ``` @@ -277,7 +276,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((word newline (section 3 "word-size" ((para ("`word-size` returns 4 on 32bit LBM and 8 on 64bits.")) (code ((word-size))) nil)) newline hline) (ind-spaces closure (n) (str-replicate n 32b) nil) (render-it closure (rend ss) (match ss (nil (rend "\n")) (( +((arch newline (section 3 "is-64bit" ((para ("`is-64bit` returns true if a 64bit version of lbm is running.")) (code ((is-64bit))) nil)) newline hline) (image-pair closure (cap0 txt0 fig0 cap1 txt1 fig1) (list (quote image-pair) cap0 txt0 fig0 cap1 txt1 f ``` @@ -295,7 +294,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-versioning section 2 "Version" ((newline (section 3 "lbm-version" ((para ("`lbm-version` returns the version of the lbm runtime system.")) (code ((lbm-version))) nil)) newline hline) (newline (section 3 "is-64bit" ((para ("`is-64bit` returns tru +((word newline (section 3 "word-size" ((para ("`word-size` returns 4 on 32bit LBM and 8 on 64bits.")) (code ((word-size))) nil)) newline hline) (info para ("This document was generated by LispBM version 0.26.0")) (png-file closure nil (progn (var n png-c ``` @@ -313,7 +312,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((manual (section 1 "LispBM Runtime Extensions Reference Manual" ((para ("The runtime extensions, if present, can be either compiled" "in a minimal or a full mode." "In the minimal mode only `set-eval-quota` is present." "Minimal mode is the default when +((chapter-versioning section 2 "Version" ((newline (section 3 "lbm-version" ((para ("`lbm-version` returns the version of the lbm runtime system.")) (code ((lbm-version))) nil)) newline hline) (newline (section 3 "is-64bit" ((para ("`is-64bit` returns tru ``` @@ -331,7 +330,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((render-manual closure nil (let ((h (fopen "runtimeref.md" "w")) (r (lambda (s) (fwrite-str h s)))) (progn (gc) (var t0 (systime)) (render r manual) (print "Runtime reference manual was generated in " (secs-since t0) " seconds"))) nil) (render-table clos +((manual (section 1 "LispBM Runtime Extensions Reference Manual" ((para ("The runtime extensions, if present, can be either compiled" "in a minimal or a full mode." "In the minimal mode only `set-eval-quota` is present." "Minimal mode is the default when ``` @@ -349,7 +348,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((para closure (str) (list (quote para) str) nil)) +((render-manual closure nil (let ((h (fopen "runtimeref.md" "w")) (r (lambda (s) (fwrite-str h s)))) (progn (gc) (var t0 (systime)) (render r manual) (print "Runtime reference manual was generated in " (secs-since t0) " seconds"))) nil) (tableize closure ``` @@ -367,7 +366,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((verb closure (str) (list (quote verb) str) nil) (s+ closure (s ss) (cons s ss) nil)) +nil ``` @@ -385,7 +384,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((hline closure nil (quote hline) nil) (pretty-list closure (c) (match c (nil [0]) (((? x)) (str-merge " " (pretty x))) (((? x) ? y) (if (eq (type-of y) type-list) (str-merge " " (pretty x) (pretty-list y)) (str-merge " " (pretty x) "." (pretty y)))) ((? +((to-dot closure (x) (str-merge "digraph SExpression {\n" " node [shape=ellipse, fontsize=12];\n" " edge [fontsize=10];\n" (car (cdr (dot-it 1u64 x))) "\n}") nil) (str-merge-list closure (strs) (match strs (nil [0]) (((? s) ? ss) (str-merge s (str-mer ``` @@ -403,7 +402,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((newline closure nil (quote newline) nil) (ref-entry closure (str strs) (list (quote newline) (section 3 str strs) (quote newline) (quote hline)) nil)) +((ind-spaces closure (n) (str-replicate n 32b) nil) (s-exp-graph closure (img-name code) (list (quote s-exp-graph) img-name code) nil)) ``` @@ -421,7 +420,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((bold closure (str) (list (quote bold) str) nil) (code-examples closure (c) (list (quote code-examples) c) nil)) +((str-merge closure nil (str-join (rest-args)) nil)) ``` @@ -439,7 +438,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((program closure (c) (list (quote program) c) nil) (render-code-res-pairs closure (rend cs) (match cs (nil t) (((? x) ? xs) (let ((x-str (if (is-read-eval-txt x) (ix x 1) (pretty x))) (x-code (if (is-read-eval-txt x) (read (ix x 1)) x)) (res (eval nil x- +nil ``` @@ -457,7 +456,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((str-merge closure nil (str-join (rest-args)) nil) (code closure (c) (list (quote code) c) nil)) +((end)) ``` @@ -475,7 +474,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((evaluation-quota newline (section 3 "set-eval-quota" ((para ("`set-eval-quota` sets the number of evaluation steps that is" "given to each context when given turn to execute by the round-robin" "scheduler.")) (code ((set-eval-quota 30))) nil)) newline h +((render-it closure (rend ss) (match ss (nil (rend "\n")) ((section (? i) (? x) (? xs)) (progn (match i (1 (rend (str-merge "# " x "\n\n"))) (2 (rend (str-merge "## " x "\n\n"))) (3 (rend (str-merge "### " x "\n\n"))) (4 (rend (str-merge "#### " x "\n\n") ``` @@ -493,7 +492,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-scheduling section 2 "Scheduling" ((newline (section 3 "set-eval-quota" ((para ("`set-eval-quota` sets the number of evaluation steps that is" "given to each context when given turn to execute by the round-robin" "scheduler.")) (code ((set-eval- +((evaluation-quota newline (section 3 "set-eval-quota" ((para ("`set-eval-quota` sets the number of evaluation steps that is" "given to each context when given turn to execute by the round-robin" "scheduler.")) (code ((set-eval-quota 30))) nil)) newline h ``` @@ -511,7 +510,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((num-free newline (section 3 "mem-num-free" ((para ("`mem-num-free` returns the number of free words in the LBM memory." "This is the memory where arrays and strings are stored.")) (code ((mem-num-free))) nil)) newline hline) (bullet closure (ss) (verb ( +((chapter-scheduling section 2 "Scheduling" ((newline (section 3 "set-eval-quota" ((para ("`set-eval-quota` sets the number of evaluation steps that is" "given to each context when given turn to execute by the round-robin" "scheduler.")) (code ((set-eval- ``` @@ -529,7 +528,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((longest-free newline (section 3 "mem-longest-free" ((para ("`mem-longest-free` returns the length in words of the longest" "consecutive sequence of free words in the LBM memory.")) (code ((mem-num-free))) nil)) newline hline) (dot-it closure (i x) (matc +((num-free newline (section 3 "mem-num-free" ((para ("`mem-num-free` returns the number of free words in the LBM memory." "This is the memory where arrays and strings are stored.")) (code ((mem-num-free))) nil)) newline hline) (render closure (rend ss) (m ``` @@ -547,7 +546,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((memory-size newline (section 3 "mem-size" ((para ("`mem-size` returns the size of the LBM memory.")) (code ((mem-size))) nil)) newline hline) (render-program-res-pairs closure (rend cs) (match cs (nil t) (((? x) ? xs) (let ((cstrs (map (lambda (c) (str- +((longest-free newline (section 3 "mem-longest-free" ((para ("`mem-longest-free` returns the length in words of the longest" "consecutive sequence of free words in the LBM memory.")) (code ((mem-num-free))) nil)) newline hline) (para closure (str) (list ( ``` @@ -565,7 +564,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((heap-state newline (section 3 "lbm-heap-state" ((para ("`lbm-heap-state` can be used to query information about heap usage.")) (code ((lbm-heap-state (quote get-heap-size)) (lbm-heap-state (quote get-heap-bytes)) (lbm-heap-state (quote get-num-alloc-cel +((memory-size newline (section 3 "mem-size" ((para ("`mem-size` returns the size of the LBM memory.")) (code ((mem-size))) nil)) newline hline) (verb closure (str) (list (quote verb) str) nil) (pretty-list closure (c) (match c (nil [0]) (((? x)) (str-merg ``` @@ -583,7 +582,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-memory section 2 "Memory" ((newline (section 3 "mem-num-free" ((para ("`mem-num-free` returns the number of free words in the LBM memory." "This is the memory where arrays and strings are stored.")) (code ((mem-num-free))) nil)) newline hline) ( +((heap-state newline (section 3 "lbm-heap-state" ((para ("`lbm-heap-state` can be used to query information about heap usage.")) (code ((lbm-heap-state (quote get-heap-size)) (lbm-heap-state (quote get-heap-bytes)) (lbm-heap-state (quote get-num-alloc-cel ``` @@ -610,9 +609,8 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -(if (eq (env-get 1) nil) (env-set 1 (list '(a . 75)))) -(env-get 1) - + (if (eq (env-get 1) nil) (env-set 1 (list '(a . 75)))) + (env-get 1) ``` @@ -621,7 +619,7 @@ The runtime extensions, if present, can be either compiled in a minimal or a ful ```clj -((chapter-gc section 2 "GC" ((newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline))) (ima +((gc-stack newline (section 3 "set-gc-stack-size" ((para ("With `set-gc-stack-size` you can change the size of the stack used for heap traversal" "by the garbage collector.")) (code ((set-gc-stack-size 100))) nil)) newline hline) (bold closure (str) (list ``` @@ -674,9 +672,8 @@ nil ```clj -(let ((a 50)) + (let ((a 50)) (local-env-get)) - ``` @@ -757,7 +754,7 @@ t ```clj -255008 +255094 ``` @@ -791,7 +788,7 @@ t ```clj -254938 +255024 ``` @@ -895,7 +892,7 @@ t ```clj -9500u +9926u ``` @@ -913,7 +910,7 @@ t ```clj -772u +777u ``` @@ -949,7 +946,7 @@ t ```clj -2993u +3131u ``` @@ -967,7 +964,7 @@ t ```clj -9997007u +9996869u ``` @@ -1003,7 +1000,7 @@ t ```clj -9997007u +9996869u ``` @@ -1021,7 +1018,7 @@ t ```clj -9997007u +9996869u ``` @@ -1093,7 +1090,7 @@ t ```clj -2998u +3034u ``` @@ -1161,7 +1158,7 @@ t ```clj -1252u +1276u ``` diff --git a/doc/strange.lisp b/doc/strange.lisp index bd7fdc1d..b4040ef4 100644 --- a/doc/strange.lisp +++ b/doc/strange.lisp @@ -14,10 +14,28 @@ ) +(def ch-constant + (section 2 "Constant code and data" + (list + (para (list "As LBM is targeting microcontrollers RAM is a limited resource while FLASH can be quite abundant!" + "LBM allows the usage of flash for storage of both code and data and this is a source of a lot of" + "interesting and perhaps unexpected behaviors." + "Lisps are usually very liberal about what can be mutated. In essense just about everything can be mutated." + "Constant storage destroys this property." + )) + ) + ) + (section 3 "Literals are constant in constant blocks" + (list + + ) + + (define manual (list (section 1 "The LBM guide to the strange and unexpected" (list ch-intro + ch-constant info ) ) diff --git a/repl/examples/expand.lisp b/repl/examples/expand.lisp new file mode 100644 index 00000000..4458a35b --- /dev/null +++ b/repl/examples/expand.lisp @@ -0,0 +1,29 @@ + +(defun macro? (x) + (and (eq (type-of x) type-list) + (eq (car x) 'macro))) + + +(defun macro-param-list (x) + (ix x 1)) + +(defun macro-body (x) + (ix x 2)) + +(defun zip (ls1 ls2) + (match ls1 + (((? a) . (? as)) (cons (cons a (car ls2)) (zip as (cdr ls2)))) + (_ nil))) + +(defun macro-expand (ma) + (let (((a . as) ma) + (evala (eval a))) + (if (macro? evala) { + (var params (macro-param-list evala)) + (var env (zip params as)) + (print env) + (eval env (macro-body evala)) + } + nil))) + + diff --git a/src/eval_cps.c b/src/eval_cps.c index a43e5dbe..2f01d878 100644 --- a/src/eval_cps.c +++ b/src/eval_cps.c @@ -806,10 +806,9 @@ void print_error_message(lbm_value error, error == ENC_SYM_RERROR) { printf_callback("*** Line: %u\n", row); printf_callback("*** Column: %u\n", col); - } else if (row0 != -1 || row1 != -1 ) { - printf_callback("*** Between rows: (-1 unknown) \n"); - printf_callback("*** Start: %d\n", (int32_t)row0); - printf_callback("*** End: %d\n", (int32_t)row1); + } else if (row0 >= 0) { + if (row1 < 0) printf_callback("*** Starting at row: %d\n", row0); + else printf_callback("*** Between row %d and %d\n", row0, row1); } printf_callback("\n"); @@ -3762,6 +3761,7 @@ static void cont_read_next_token(eval_context_t *ctx) { if (lbm_dec_u(grab_row0)) { ctx->row0 = (int32_t)lbm_channel_row(chan); + ctx->row1 = -1; // a new start, end is unknown } /* Attempt to extract tokens from the character stream */ @@ -4066,9 +4066,12 @@ static void cont_read_start_array(eval_context_t *ctx) { lbm_value array; if (!lbm_heap_allocate_array(&array, 0)) { - lbm_set_error_reason((char*)lbm_error_str_read_no_mem); - lbm_channel_reader_close(str); - error_ctx(ENC_SYM_FATAL_ERROR); // Terminates ctx + gc(); + if (!lbm_heap_allocate_array(&array, 0)) { + lbm_set_error_reason((char*)lbm_error_str_read_no_mem); + lbm_channel_reader_close(str); + error_ctx(ENC_SYM_FATAL_ERROR); // Terminates ctx + } } lbm_stack_drop(&ctx->K, 1); ctx->r = array; @@ -4091,12 +4094,17 @@ static void cont_read_start_array(eval_context_t *ctx) { lbm_value array; initial_size = sizeof(lbm_uint) * initial_size; + // Keep in mind that this allocation can fail for both + // lbm_memory and heap reasons. if (!lbm_heap_allocate_array(&array, initial_size)) { - lbm_set_error_reason((char*)lbm_error_str_read_no_mem); - lbm_channel_reader_close(str); - error_ctx(ENC_SYM_FATAL_ERROR); - // NOTE: If array is not created evaluation ends here. - // Static analysis seems unaware. + gc(); + if (!lbm_heap_allocate_array(&array, initial_size)) { + lbm_set_error_reason((char*)lbm_error_str_read_no_mem); + lbm_channel_reader_close(str); + error_ctx(ENC_SYM_FATAL_ERROR); + // NOTE: If array is not created evaluation ends here. + // Static analysis seems unaware. + } } sptr[0] = array;