miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added more to to_compile.kp and runtime started growing again - main bottleneck was the silly using lists as sets thing, changed the small-int uses of these to a new custom bitset and brought the time from 47s back down to 6s. There is a remaining hotspot where partial_eval_helper matches needed_for_progress vs the bitset, but that'll have to wait for tomorrow. Thinking of maintaining a env_stack bitset and adding a bitset_union_nonempty function. Note the new bitset does use some cons/car/cdr operations that'll be a bit different in Kraken, which I'll need to look at. Maybe when porting I can just use indexing if there's not a great way to unify them.

Browse Source
This commit is contained in:
Nathan Braswell
2022-03-08 02:54:26 -05:00
parent 90fe8e1bfa
commit 7fed3a58f5
2 changed files with 317 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files

258
partial_eval.scm
View File

@@ -7,7 +7,7 @@
; Chez ; Chez
(define print pretty-print) (define arithmetic-shift bitwise-arithmetic-shift) (define foldl fold-left) (define foldr fold-right) (define write_file (lambda (file bytes) (let* ( (port (open-file-output-port file)) (_ (foldl (lambda (_ o) (put-u8 port o)) (void) bytes)) (_ (close-port port))) '()))) (define print pretty-print) (define arithmetic-shift bitwise-arithmetic-shift) (define foldl fold-left) (define foldr fold-right) (define write_file (lambda (file bytes) (let* ( (port (open-file-output-port file)) (_ (foldl (lambda (_ o) (put-u8 port o)) (void) bytes)) (_ (close-port port))) '())))
(compile-profile 'source) ;(compile-profile 'source)
; Gambit - Gambit also has a problem with the dlet definition (somehow recursing and making (cdr nil) for (cdr ls)?), even if using the unstable one that didn't break syntax-rules ; Gambit - Gambit also has a problem with the dlet definition (somehow recursing and making (cdr nil) for (cdr ls)?), even if using the unstable one that didn't break syntax-rules
;(define print pretty-print) ;(define print pretty-print)
@@ -60,6 +60,7 @@
(#t (begin (cons x (loop (read-char input-port))))))))))) (#t (begin (cons x (loop (read-char input-port)))))))))))
(define speed_hack #t) (define speed_hack #t)
;(define GLOBAL_MAX 0)
(let* ( (let* (
(lapply apply) (lapply apply)
@@ -103,62 +104,6 @@
(zip (lambda args (apply map list args))) (zip (lambda args (apply map list args)))
;(my-alist-ref alist-ref)
(empty_dict-list (array))
(put-list (lambda (m k v) (cons (array k v) m)))
(get-list (lambda (d k) ((rec-lambda recurse (k d len_d i) (cond ((= len_d i) false)
((= k (idx (idx d i) 0)) (idx d i))
(true (recurse k d len_d (+ 1 i)))))
k d (len d) 0)))
;(combine_hash (lambda (a b) (+ (* 37 a) b)))
(combine_hash (lambda (a b) (bitwise-and #xFFFFFFFFFFFFFF (+ (* 37 a) b))))
(hash_bool (lambda (b) (if b 2 3)))
(hash_num (lambda (n) (combine_hash 5 n)))
(hash_string (lambda (s) (foldl combine_hash 7 (map char->integer (string->list s)))))
;(hash_string (lambda (s) (foldl combine_hash 102233 (map char->integer (string->list s)))))
(empty_dict-tree nil)
(trans-key (lambda (k) (cond ((string? k) (cons (hash_string k) k))
((symbol? k) (cons (hash_string (symbol->string k)) k))
(true (cons k k)))))
(put-helper (rec-lambda put-helper (m k v) (cond ((nil? m) (cons (list k v) (cons nil nil)))
((and (= (car k) (caaar m))
(= (cdr k) (cdaar m))) (cons (list k v) (cons (cadr m) (cddr m))))
((< (car k) (caaar m)) (cons (car m) (cons (put-helper (cadr m) k v) (cddr m))))
(true (cons (car m) (cons (cadr m) (put-helper (cddr m) k v)))))))
(put-tree (lambda (m k v) (put-helper m (trans-key k) v)))
(get-helper (rec-lambda get-helper (m k) (cond ((nil? m) false)
((and (= (car k) (caaar m))
(= (cdr k) (cdaar m))) (car m))
((< (car k) (caaar m)) (get-helper (cadr m) k))
(true (get-helper (cddr m) k)))))
(get-tree (lambda (m k) (get-helper m (trans-key k))))
;(empty_dict empty_dict-list)
;(put put-list)
;(get get-list)
(empty_dict empty_dict-tree)
(put put-tree)
(get get-tree)
;(empty_dict (list empty_dict-list empty_dict-tree))
;(put (lambda (m k v) (list (put-list (idx m 0) k v) (put-tree (idx m 1) k v))))
;(get (lambda (m k) (dlet ( ;(_ (true_print "doing a get " m " " k))
; (list-result (get-list (idx m 0) k))
; (tree-result (get-tree (idx m 1) k))
; (_ (if (and (!= list-result tree-result) (!= (idx list-result 1) (idx tree-result 1))) (error "BAD GET " list-result " vs " tree-result)))
; ) tree-result)))
(get-value (lambda (d k) (let ((result (get d k)))
(if (pair? result) (cadr result)
(error (str "could not find " k " in " d))))))
(get-value-or-false (lambda (d k) (let ((result (get d k)))
(if (pair? result) (cadr result)
false))))
(% modulo) (% modulo)
(int? integer?) (int? integer?)
(str? string?) (str? string?)
@@ -187,17 +132,142 @@
(#t (append (f (car l)) (recurse f (cdr l))))) (#t (append (f (car l)) (recurse f (cdr l)))))
)) f l))) )) f l)))
;;;;;;;;;;;;;;;;;;
; End kludges
;;;;;;;;;;;;;;;;;;
(empty_dict-list (array))
(put-list (lambda (m k v) (cons (array k v) m)))
(get-list (lambda (d k) ((rec-lambda recurse (k d len_d i) (cond ((= len_d i) false)
((= k (idx (idx d i) 0)) (idx d i))
(true (recurse k d len_d (+ 1 i)))))
k d (len d) 0)))
;(combine_hash (lambda (a b) (+ (* 37 a) b)))
(combine_hash (lambda (a b) (band #xFFFFFFFFFFFFFF (+ (* 37 a) b))))
(hash_bool (lambda (b) (if b 2 3)))
(hash_num (lambda (n) (combine_hash 5 n)))
(hash_string (lambda (s) (foldl combine_hash 7 (map char->integer (string->list s)))))
;(hash_string (lambda (s) (foldl combine_hash 7 s)))
;(hash_string (lambda (s) (foldl combine_hash 102233 (map char->integer (string->list s)))))
(empty_dict-tree nil)
;(trans-key (lambda (k) (cond ((string? k) (cons (hash_string k) k))
; ((symbol? k) (cons (hash_string (symbol->string k)) k))
; (true (cons k k)))))
;(put-helper (rec-lambda put-helper (m k v) (cond ((nil? m) (cons (list k v) (cons nil nil)))
; ((and (= (car k) (caaar m))
; (= (cdr k) (cdaar m))) (cons (list k v) (cons (cadr m) (cddr m))))
; ((< (car k) (caaar m)) (cons (car m) (cons (put-helper (cadr m) k v) (cddr m))))
; (true (cons (car m) (cons (cadr m) (put-helper (cddr m) k v)))))))
;(put-tree (lambda (m k v) (put-helper m (trans-key k) v)))
;(get-helper (rec-lambda get-helper (m k) (cond ((nil? m) false)
; ((and (= (car k) (caaar m))
; (= (cdr k) (cdaar m))) (car m))
; ((< (car k) (caaar m)) (get-helper (cadr m) k))
; (true (get-helper (cddr m) k)))))
(trans-key (lambda (k) (cond ((string? k) (hash_string k))
((symbol? k) (hash_string (get-text k)))
(true k))))
(put-helper (rec-lambda put-helper (m hk k v) (cond ((nil? m) (array hk k v nil nil))
((and (= hk (idx m 0))
(= k (idx m 1))) (array hk k v (idx m 3) (idx m 4)))
((< hk (idx m 0)) (array (idx m 0) (idx m 1) (idx m 2) (put-helper (idx m 3) hk k v) (idx m 4)))
(true (array (idx m 0) (idx m 1) (idx m 2) (idx m 3) (put-helper (idx m 4) hk k v))))))
(put-tree (lambda (m k v) (put-helper m (trans-key k) k v)))
(get-helper (rec-lambda get-helper (m hk k) (cond ((nil? m) false)
((and (= hk (idx m 0))
(= k (idx m 1))) (array k (idx m 2)))
((< hk (idx m 0)) (get-helper (idx m 3) hk k))
(true (get-helper (idx m 4) hk k)))))
(get-tree (lambda (m k) (get-helper m (trans-key k) k)))
;(empty_dict empty_dict-list)
;(put put-list)
;(get get-list)
(empty_dict empty_dict-tree)
(put put-tree)
(get get-tree)
;(empty_dict (list empty_dict-list empty_dict-tree))
;(put (lambda (m k v) (list (put-list (idx m 0) k v) (put-tree (idx m 1) k v))))
;(get (lambda (m k) (dlet ( ;(_ (true_print "doing a get " m " " k))
; (list-result (get-list (idx m 0) k))
; (tree-result (get-tree (idx m 1) k))
; (_ (if (and (!= list-result tree-result) (!= (idx list-result 1) (idx tree-result 1))) (error "BAD GET " list-result " vs " tree-result)))
; ) tree-result)))
(get-value (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
(error (str "could not find " k " in " d))))))
(get-value-or-false (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
false))))
; Ok, actual definitions
(in_array (dlet ((helper (rec-lambda recurse (x a len_a i) (cond ((= i len_a) false) (in_array (dlet ((helper (rec-lambda recurse (x a len_a i) (cond ((= i len_a) false)
((= x (idx a i)) true) ((= x (idx a i)) true)
(true (recurse x a len_a (+ i 1))))))) (true (recurse x a len_a (+ i 1)))))))
(lambda (x a) (helper x a (len a) 0)))) (lambda (x a) (helper x a (len a) 0))))
(array_item_union (lambda (a bi) (if (in_array bi a) a (cons bi a)))) (array_item_union (lambda (a bi) (if (in_array bi a) a (cons bi a))))
(array_union (lambda (a b) (foldl array_item_union a b))) (array_union (lambda (a b) (foldl array_item_union a b)))
(array_union_without (lambda (wo a b)
(foldl (lambda (o xi) (if (or (= wo xi) (in_array xi o)) o (cons xi o)))
(array) (concat a b)))) (intset_word_size 64)
(in_intset (rec-lambda in_intset (x a) (cond ((nil? a) false)
((>= x intset_word_size) (in_intset (- x intset_word_size) (cdr a)))
(true (!= (band (>> (car a) x) 1) 0)))))
(intset_item_union (rec-lambda intset_item_union (a bi) (cond ((nil? a) (intset_item_union (list 0) bi))
((>= bi intset_word_size) (cons (car a) (intset_item_union (cdr a) (- bi intset_word_size))))
(true (cons (bor (car a) (<< 1 bi)) (cdr a))))))
(intset_item_remove (rec-lambda intset_item_remove (a bi) (cond ((nil? a) nil)
((>= bi intset_word_size) (dlet ((new_tail (intset_item_remove (cdr a) (- bi intset_word_size))))
(if (and (nil? new_tail) (= 0 (car a))) nil
(cons (car a) new_tail))))
(true (dlet ((new_int (band (car a) (bnot (<< 1 bi)))))
(if (and (nil? (cdr a)) (= 0 new_int)) nil
(cons new_int (cdr a))))))))
(intset_union (rec-lambda intset_union (a b) (cond ((and (nil? a) (nil? b)) nil)
((nil? a) b)
((nil? b) a)
(true (cons (bor (car a) (car b)) (intset_union (cdr a) (cdr b)))))))
;(_ (true_print "of 1 " (intset_item_union nil 1)))
;(_ (true_print "of 1 and 2 " (intset_item_union (intset_item_union nil 1) 2)))
;(_ (true_print "of 1 and 2 union 3 4" (intset_union (intset_item_union (intset_item_union nil 1) 2) (intset_item_union (intset_item_union nil 3) 4))))
;(_ (true_print "of 100 " (intset_item_union nil 100)))
;(_ (true_print "of 100 and 200 " (intset_item_union (intset_item_union nil 100) 200)))
;(_ (true_print "of 100 and 200 union 300 400" (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400))))
;(_ (true_print "1 in 1 " (in_intset 1 (intset_item_union nil 1))))
;(_ (true_print "1 in 1 and 2 " (in_intset 1 (intset_item_union (intset_item_union nil 1) 2))))
;(_ (true_print "1 in 1 and 2 union 3 4" (in_intset 1 (intset_union (intset_item_union (intset_item_union nil 1) 2) (intset_item_union (intset_item_union nil 3) 4)))))
;(_ (true_print "1 in 1 " (in_intset 1 (intset_item_union nil 1))))
;(_ (true_print "1 in 1 and 2 " (in_intset 1 (intset_item_union (intset_item_union nil 1) 2))))
;(_ (true_print "1 in 1 and 2 union 3 4" (in_intset 1 (intset_union (intset_item_union (intset_item_union nil 1) 2) (intset_item_union (intset_item_union nil 3) 4)))))
;(_ (true_print "5 in 1 " (in_intset 5 (intset_item_union nil 1))))
;(_ (true_print "5 in 1 and 2 " (in_intset 5 (intset_item_union (intset_item_union nil 1) 2))))
;(_ (true_print "5 in 1 and 2 union 3 4" (in_intset 5 (intset_union (intset_item_union (intset_item_union nil 1) 2) (intset_item_union (intset_item_union nil 3) 4)))))
;(_ (true_print "1 in 100 " (in_intset 1 (intset_item_union nil 100))))
;(_ (true_print "1 in 100 and 200 " (in_intset 1 (intset_item_union (intset_item_union nil 100) 200))))
;(_ (true_print "1 in 100 and 200 union 300 400" (in_intset 1 (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400)))))
;(_ (true_print "5 in 100 " (in_intset 5 (intset_item_union nil 100))))
;(_ (true_print "5 in 100 and 200 " (in_intset 5 (intset_item_union (intset_item_union nil 100) 200))))
;(_ (true_print "5 in 100 and 200 union 300 400" (in_intset 5 (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400)))))
;(_ (true_print "100 in 100 " (in_intset 100 (intset_item_union nil 100))))
;(_ (true_print "100 in 100 and 200 " (in_intset 100 (intset_item_union (intset_item_union nil 100) 200))))
;(_ (true_print "100 in 100 and 200 union 300 400" (in_intset 100 (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400)))))
;(_ (true_print "500 in 100 " (in_intset 500 (intset_item_union nil 100))))
;(_ (true_print "500 in 100 and 200 " (in_intset 500 (intset_item_union (intset_item_union nil 100) 200))))
;(_ (true_print "500 in 100 and 200 union 300 400" (in_intset 500 (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400)))))
;(_ (true_print "all removed in 100 and 200 union 300 400" (intset_item_remove (intset_item_remove (intset_item_remove (intset_item_remove (intset_union (intset_item_union (intset_item_union nil 100) 200) (intset_item_union (intset_item_union nil 300) 400)) 100) 200) 300) 400)))
(intset_union_without (lambda (wo a b) (intset_item_remove (intset_union a b) wo)))
(val? (lambda (x) (= 'val (idx x 0)))) (val? (lambda (x) (= 'val (idx x 0))))
(marked_array? (lambda (x) (= 'marked_array (idx x 0)))) (marked_array? (lambda (x) (= 'marked_array (idx x 0))))
@@ -250,20 +320,22 @@
; of an evaluation of, then it could progress futher. These are all caused by ; of an evaluation of, then it could progress futher. These are all caused by
; the infinite recursion stopper. ; the infinite recursion stopper.
(needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x)) (needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x))
((marked_symbol? x) (array (.marked_symbol_needed_for_progress x) nil nil)) ((marked_symbol? x) (dlet ((n (.marked_symbol_needed_for_progress x))) (array (if (int? n) (intset_item_union nil n) n) nil nil)))
((marked_env? x) (.marked_env_needed_for_progress x)) ((marked_env? x) (.marked_env_needed_for_progress x))
((comb? x) (dlet ((id (.comb_id x)) ((comb? x) (dlet ((id (.comb_id x))
((body_needed _hashes extra1) (needed_for_progress (.comb_body x))) ((body_needed _hashes extra1) (needed_for_progress (.comb_body x)))
((se_needed _hashes extra2) (needed_for_progress (.comb_env x)))) ((se_needed _hashes extra2) (needed_for_progress (.comb_env x))))
(if (or (= true body_needed) (= true se_needed)) (array true nil nil) (if (or (= true body_needed) (= true se_needed)) (array true nil nil)
(array (array_union_without id body_needed se_needed) (array (intset_union_without id body_needed se_needed)
nil (array_union_without id extra1 extra2)) nil (intset_union_without id extra1 extra2))
))) )))
((prim_comb? x) (array nil nil nil)) ((prim_comb? x) (array nil nil nil))
((val? x) (array nil nil nil)) ((val? x) (array nil nil nil))
(true (error (str "what is this? in need for progress" x)))))) (true (error (str "what is this? in need for progress" x))))))
(needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0))) (needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0)))
(hash_symbol (lambda (progress_idxs s) (combine_hash (if (= true progress_idxs) 11 (foldl combine_hash 13 (map (lambda (x) (if (= true x) 13 (+ 1 x))) progress_idxs))) (hash_string (symbol->string s))))) (hash_symbol (lambda (progress_idx s) (combine_hash (cond ((= true progress_idx) 11)
((int? progress_idx) (combine_hash 13 progress_idx))
(true 113)) (hash_string (get-text s)))))
(hash_array (lambda (is_val attempted a) (foldl combine_hash (if is_val 17 (cond ((int? attempted) (combine_hash attempted 19)) (hash_array (lambda (is_val attempted a) (foldl combine_hash (if is_val 17 (cond ((int? attempted) (combine_hash attempted 19))
(attempted 61) (attempted 61)
@@ -295,21 +367,21 @@
((string? x) (hash_string x)) ((string? x) (hash_string x))
((int? x) (hash_num x)) ((int? x) (hash_num x))
(true (error (str "bad thing to hash_val " x)))))) (true (error (str "bad thing to hash_val " x))))))
; 113 127 131 137 139 149 151 157 163 167 173 ; 127 131 137 139 149 151 157 163 167 173
(marked_symbol (lambda (progress_idxs x) (array 'marked_symbol (hash_symbol progress_idxs x) progress_idxs x))) (marked_symbol (lambda (progress_idx x) (array 'marked_symbol (hash_symbol progress_idx x) progress_idx x)))
(marked_array (lambda (is_val attempted resume_hashes x) (dlet ( (marked_array (lambda (is_val attempted resume_hashes x) (dlet (
((sub_progress_idxs hashes extra) (foldl (dlambda ((a ahs aeei) (x xhs x_extra_env_ids)) ((sub_progress_idxs hashes extra) (foldl (dlambda ((a ahs aeei) (x xhs x_extra_env_ids))
(array (cond ((or (= true a) (= true x)) true) (array (cond ((or (= true a) (= true x)) true)
(true (array_union a x))) (true (intset_union a x)))
(array_union ahs xhs) (array_union ahs xhs)
(array_union aeei x_extra_env_ids)) (intset_union aeei x_extra_env_ids))
) (array (array) resume_hashes (array)) (map needed_for_progress x))) ) (array (array) resume_hashes (array)) (map needed_for_progress x)))
(progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) (= true attempted)) nil) (progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) (= true attempted)) nil)
((and (= nil sub_progress_idxs) (not is_val) (= false attempted)) true) ((and (= nil sub_progress_idxs) (not is_val) (= false attempted)) true)
((and (= nil sub_progress_idxs) (not is_val) (int? attempted)) (array attempted)) ((and (= nil sub_progress_idxs) (not is_val) (int? attempted)) (array attempted))
(true (if (int? attempted) (true (if (int? attempted)
(array_item_union sub_progress_idxs attempted) (intset_item_union sub_progress_idxs attempted)
sub_progress_idxs)))) sub_progress_idxs))))
) (array 'marked_array (hash_array is_val attempted x) is_val attempted (array progress_idxs hashes extra) x)))) ) (array 'marked_array (hash_array is_val attempted x) is_val attempted (array progress_idxs hashes extra) x))))
@@ -319,10 +391,10 @@
(full_arrs (concat arrs de_entry (array ue))) (full_arrs (concat arrs de_entry (array ue)))
((progress_idxs1 _hashes extra1) (mif ue (needed_for_progress ue) (array nil nil nil))) ((progress_idxs1 _hashes extra1) (mif ue (needed_for_progress ue) (array nil nil nil)))
((progress_idxs2 _hashes extra2) (mif de? (needed_for_progress de) (array nil nil nil))) ((progress_idxs2 _hashes extra2) (mif de? (needed_for_progress de) (array nil nil nil)))
(progress_idxs (array_union progress_idxs1 progress_idxs2)) (progress_idxs (intset_union progress_idxs1 progress_idxs2))
(extra (array_union extra1 extra2)) (extra (intset_union extra1 extra2))
(progress_idxs (if (not has_vals) (cons dbi progress_idxs) progress_idxs)) (progress_idxs (if (not has_vals) (intset_item_union progress_idxs dbi) progress_idxs))
(extra (if (!= nil progress_idxs) (cons dbi extra) extra)) (extra (if (!= nil progress_idxs) (intset_item_union extra dbi) extra))
) (array 'env (hash_env has_vals progress_idxs dbi full_arrs) has_vals (array progress_idxs nil extra) dbi full_arrs)))) ) (array 'env (hash_env has_vals progress_idxs dbi full_arrs) has_vals (array progress_idxs nil extra) dbi full_arrs))))
@@ -337,6 +409,9 @@
(true (error "bad with_wrap_level"))))) (true (error "bad with_wrap_level")))))
(later_head? (rec-lambda recurse (x) (or (and (marked_array? x) (or (= false (.marked_array_is_val x)) (foldl (lambda (a x) (or a (recurse x))) false (.marked_array_values x)))) (later_head? (rec-lambda recurse (x) (or (and (marked_array? x) (or (= false (.marked_array_is_val x)) (foldl (lambda (a x) (or a (recurse x))) false (.marked_array_values x))))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x))) (and (marked_symbol? x) (= false (.marked_symbol_is_val x)))
))) )))
@@ -462,8 +537,8 @@
(check_for_env_id_in_result (lambda (s_env_id x) (idx ((rec-lambda check_for_env_id_in_result (memo s_env_id x) (check_for_env_id_in_result (lambda (s_env_id x) (idx ((rec-lambda check_for_env_id_in_result (memo s_env_id x)
(dlet ( (dlet (
((need _hashes extra) (needed_for_progress x)) ((need _hashes extra) (needed_for_progress x))
(in_need (if (!= true need) (in_array s_env_id need) false)) (in_need (if (!= true need) (in_intset s_env_id need) false))
(in_extra (in_array s_env_id extra)) (in_extra (in_intset s_env_id extra))
;(or in_need in_extra) (array memo true) ;(or in_need in_extra) (array memo true)
;(!= true need) (array memo false) ;(!= true need) (array memo false)
) (cond ((or in_need in_extra) (array memo true)) ) (cond ((or in_need in_extra) (array memo true))
@@ -608,8 +683,8 @@
r))) r)))
(make_tmp_inner_env (lambda (params de? ue env_id) (make_tmp_inner_env (lambda (params de? ue env_id)
(dlet ((param_entries (map (lambda (p) (array p (marked_symbol (array env_id) p))) params)) (dlet ((param_entries (map (lambda (p) (array p (marked_symbol env_id p))) params))
(possible_de (mif (= nil de?) (array) (marked_symbol (array env_id) de?))) (possible_de (mif (= nil de?) (array) (marked_symbol env_id de?)))
) (marked_env false de? possible_de ue env_id param_entries)))) ) (marked_env false de? possible_de ue env_id param_entries))))
@@ -619,18 +694,11 @@
((env_counter memo) pectx) ((env_counter memo) pectx)
(hashes_now (foldl (lambda (a hash) (or a (= false (get-value-or-false memo hash)))) false for_progress_hashes)) (hashes_now (foldl (lambda (a hash) (or a (= false (get-value-or-false memo hash)))) false for_progress_hashes))
(len_for_progress (if (!= true for_progress) (len for_progress) 0)) (len_for_progress (if (!= true for_progress) (len for_progress) 0))
(progress_now (or (= for_progress true) ((rec-lambda rr (i len_env_stack) (if (= i len_for_progress) false (progress_now (or (= for_progress true) ((rec-lambda rr (i len_env_stack) (cond ((= i len_env_stack) false)
(dlet ( ((and (.marked_env_has_vals (idx env_stack i))
; possible if called from a value context in the compiler (in_intset (.marked_env_idx (idx env_stack i)) for_progress)) true)
; TODO: I think this should be removed and instead the value/code compilers should (true (rr (+ i 1) len_env_stack))))
; keep track of actual env stacks 0 (len env_stack))))
(this_now ((rec-lambda ir (j) (cond ((= j len_env_stack) false)
((and (= (idx for_progress i) (.marked_env_idx (idx env_stack j)))
(.marked_env_has_vals (idx env_stack j))) (idx for_progress i))
(true (ir (+ j 1))))
) 0))
) (if this_now this_now (rr (+ i 1) len_env_stack)))
)) 0 (len env_stack))))
) )
(if (or force hashes_now progress_now) (if (or force hashes_now progress_now)
(cond ((val? x) (array pectx nil x)) (cond ((val? x) (array pectx nil x))
@@ -747,9 +815,10 @@
) (array pectx func_err func_result false)))) ) (array pectx func_err func_result false))))
(_ (print_strip (indent_str indent) "evaled result of function call (in env " (.marked_env_idx env) ", with inner " env_id ") and err " func_err " is " func_result)) (_ (print_strip (indent_str indent) "evaled result of function call (in env " (.marked_env_idx env) ", with inner " env_id ") and err " func_err " is " func_result))
(must_stop_maybe_id (or rec_stop (if (not (combiner_return_ok func_result env_id)) (must_stop_maybe_id (and (= nil func_err)
(or rec_stop (if (not (combiner_return_ok func_result env_id))
(if (!= nil de?) (.marked_env_idx env) true) (if (!= nil de?) (.marked_env_idx env) true)
false))) false))))
) (if (!= nil func_err) (array pectx func_err nil) ) (if (!= nil func_err) (array pectx func_err nil)
(if must_stop_maybe_id (if must_stop_maybe_id
(array pectx nil (marked_array false must_stop_maybe_id (if rec_stop (array hash) nil) (cons (with_wrap_level comb remaining_wrap) evaled_params))) (array pectx nil (marked_array false must_stop_maybe_id (if rec_stop (array hash) nil) (cons (with_wrap_level comb remaining_wrap) evaled_params)))
@@ -3437,7 +3506,7 @@
(get_passthrough (.hash c) ctx) (get_passthrough (.hash c) ctx)
;) ;)
(dlet ( ((datasi funcs memo env pectx) ctx) (dlet ( ((datasi funcs memo env pectx) ctx)
((c_loc c_len datasi) (alloc_data (symbol->string (.marked_symbol_value c)) datasi)) ((c_loc c_len datasi) (alloc_data (get-text (.marked_symbol_value c)) datasi))
(result (bor (<< c_len 32) c_loc #b111)) (result (bor (<< c_len 32) c_loc #b111))
(memo (put memo (.hash c) result)) (memo (put memo (.hash c) result))
) (array result nil nil (array datasi funcs memo env pectx))))) ) (array result nil nil (array datasi funcs memo env pectx)))))
@@ -4483,7 +4552,8 @@
;(single-test) ;(single-test)
;(run-compiler "small_test.kp") ;(run-compiler "small_test.kp")
(run-compiler "to_compile.kp") (run-compiler "to_compile.kp")
(profile-dump-html) ;(true_print "GLOBAL_MAX was " GLOBAL_MAX)
;(profile-dump-html)
;(profile-dump-list) ;(profile-dump-list)
) )
) )

248
to_compile.kp
View File

@@ -145,96 +145,78 @@
reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) (array) x)) reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) (array) x))
zip (lambda (& xs) (lapply foldr (concat (array (lambda (a & ys) (cons ys a)) (array)) xs))) zip (lambda (& xs) (lapply foldr (concat (array (lambda (a & ys) (cons ys a)) (array)) xs)))
id (lambda (x) x) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Begin kludges to align with Scheme kludges
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
dlet (vau se (inners body) (vapply let (array (lapply concat inners) body) se)) dlet (vau se (inners body) (vapply let (array (lapply concat inners) body) se))
test7 ((rec-lambda recurse (n) (cond (= 0 n) 1
true (* n (recurse (- n 1))))) 5)
cond (vau se (& inners) (vapply cond (lapply concat inners) se)) cond (vau se (& inners) (vapply cond (lapply concat inners) se))
test18 ((rec-lambda recurse (n) (cond ((= 0 n) 1)
(true (* n (recurse (- n 1)))))) 5)
;test0 (map (lambda (x) (+ x 1)) (array 1 2))
;test1 (map_i (lambda (i x) (+ x i 1)) (array 1 2))
;test2 (filter_i (lambda (i x) (> i 0)) (array 1 2))
;test2 (filter (lambda ( x) (> x 1)) (array 1 2))
;test3 (not 1)
;test4 (flat_map (lambda (x) (array 1 x 2)) (array 1 2))
;test5 (flat_map_i (lambda (i x) (array i x 2)) (array 1 2))
;test6 (let ( (a b) (array 1 2) c (+ a b) ) c)
;test8 ((lambda (a b c) (+ a b c)) 1 13 14)
;test9 ((lambda (a (b c)) (+ a b c)) 1 (array 13 14))
;test10 (foldl + 0 (array 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 13371 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337))
;test11 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 13371 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test12 (foldl + 0 (array 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 13371 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337))
;test13 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 13371 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test10 (foldl + 0 (array 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337))
;test11 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test10 (foldl + 0 (array 1 2 3 4 1337 6 4 4 4 1337 1 2 3 4 1337 6 4 4 4 1337))
;test11 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test12 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test13 (foldl + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test14 (foldr + 0 (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test15 (reverse (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337))
;test16 (zip (array 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337 1 2 3 4 1337) (array 2 3 4 5 1338 2 3 4 5 1338 2 3 4 5 1338 2 3 4 5 1338))
;monad (array 'open 3 "test_self_out" (lambda (fd code)
; (array 'write fd "wabcdefghijklmnopqrstuvwx" (lambda (written code)
; (array 'exit (if (= 0 written) 12 14))))))
;old 4
;test (+ old 4)
;test 4
;monad (array 'write 1 "test_self_out2" (vau (written code) (map (lambda (x) (+ x 133)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (map_i (lambda (i x) (+ x i 133)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (filter_i (lambda (i x) (> i 0)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (filter (lambda (x) (> x 0)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (not (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (flat_map (lambda (x) (array 1 x 2)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (flat_map_i (lambda (i x) (array i x 2)) (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) (let ( (a b) (array written code) c (+ a b test8 test9)) c)))
;monad (array 'write 1 "test_self_out2" (vau (written code) ((lambda (a (b c)) (+ a b c)) 1 (array written code))))
;monad (array 'write 1 "test_self_out2" (vau (written code) test10))
;monad (array 'write 1 "test_self_out2" (vau (written code) (foldl + 0 (array written code 1337))))
;monad (array 'write 1 "test_self_out2" (vau (written code) test14))
;monad (array 'write 1 "test_self_out2" (vau (written code) (foldr + 0 (array written code 1337))))
;monad (array 'write 1 "test_self_out2" (vau (written code) test15))
;monad (array 'write 1 "test_self_out2" (vau (written code) (reverse (array written code 1337))))
;monad (array 'write 1 "test_self_out2" (vau (written code) test16))
monad (array 'write 1 "test_self_out2" (vau (written code) (zip (array 1 2 3) (array written code 1337))))
;test17 (dlet ( (a 1) (b 2) ((c d) (array 3 4)) ) (+ a b c d))
;monad (array 'write 1 "test_self_out2" (vau (written code) test17))
;monad (array 'write 1 "test_self_out2" (vau (written code) (+ test7 test18)))
;monad (array 'write 1 "test_self_out2" (vau (written code) 7))
print log print log
println log println log
dlambda lambda
mif (vau de (c & bs) (vapply if (cons (array let (array 'tmp c) (array and (array != 'tmp) 'tmp)) bs) de))
;mif (vau de (c & bs) (eval (concat (array if (array let (array 'tmp c) (array and (array != 'tmp) 'tmp))) bs) de))
) )
; monad
(dlet ( (dlet (
(in_array (dlet ((helper (rec-lambda recurse (x a i) (cond ((= i (len a)) false)
(empty_dict-list (array))
(put-list (lambda (m k v) (cons (array k v) m)))
(get-list (lambda (d k) ((rec-lambda recurse (k d len_d i) (cond ((= len_d i) false)
((= k (idx (idx d i) 0)) (idx d i))
(true (recurse k d len_d (+ 1 i)))))
k d (len d) 0)))
;(combine_hash (lambda (a b) (+ (* 37 a) b)))
(combine_hash (lambda (a b) (band #xFFFFFFFFFFFFFF (+ (* 37 a) b))))
(hash_bool (lambda (b) (if b 2 3)))
(hash_num (lambda (n) (combine_hash 5 n)))
;(hash_string (lambda (s) (foldl combine_hash 7 (map char->integer (string->list s)))))
(hash_string (lambda (s) (foldl combine_hash 7 s)))
;(hash_string (lambda (s) (foldl combine_hash 102233 (map char->integer (string->list s)))))
(empty_dict-tree nil)
(trans-key (lambda (k) (cond ((string? k) (hash_string k))
((symbol? k) (hash_string (get-text k)))
(true k))))
(put-helper (rec-lambda put-helper (m hk k v) (cond ((nil? m) (array hk k v nil nil))
((and (= hk (idx m 0))
(= k (idx m 1))) (array hk k v (idx m 3) (idx m 4)))
((< hk (idx m 0)) (array (idx m 0) (idx m 1) (idx m 2) (put-helper (idx m 3) hk k v) (idx m 4)))
(true (array (idx m 0) (idx m 1) (idx m 2) (idx m 3) (put-helper (idx m 4) hk k v))))))
(put-tree (lambda (m k v) (put-helper m (trans-key k) k v)))
(get-helper (rec-lambda get-helper (m hk k) (cond ((nil? m) false)
((and (= hk (idx m 0))
(= k (idx m 1))) (array k (idx m 2)))
((< hk (idx m 0)) (get-helper (idx m 3) hk k))
(true (get-helper (idx m 4) hk k)))))
(get-tree (lambda (m k) (get-helper m (trans-key k) k)))
;(empty_dict empty_dict-list)
;(put put-list)
;(get get-list)
(empty_dict empty_dict-tree)
(put put-tree)
(get get-tree)
(get-value (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
(error (str "could not find " k " in " d))))))
(get-value-or-false (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
false))))
(in_array (dlet ((helper (rec-lambda recurse (x a len_a i) (cond ((= i len_a) false)
((= x (idx a i)) true) ((= x (idx a i)) true)
(true (recurse x a (+ i 1))))))) (true (recurse x a len_a (+ i 1)))))))
(lambda (x a) (helper x a 0)))) (lambda (x a) (helper x a (len a) 0))))
(array_item_union (lambda (a bi) (if (in_array bi a) a (cons bi a))))
(array_union (lambda (a b) (foldl array_item_union a b)))
(array_union_without (lambda (wo a b)
(foldl (lambda (o xi) (if (or (= wo xi) (in_array xi o)) o (cons xi o)))
(array) (concat a b))))
(val? (lambda (x) (= 'val (idx x 0)))) (val? (lambda (x) (= 'val (idx x 0))))
(marked_array? (lambda (x) (= 'marked_array (idx x 0)))) (marked_array? (lambda (x) (= 'marked_array (idx x 0))))
@@ -273,11 +255,10 @@
(.marked_env_idx (lambda (x) (idx x 4))) (.marked_env_idx (lambda (x) (idx x 4)))
(.marked_env_upper (lambda (x) (idx (idx x 5) -1))) (.marked_env_upper (lambda (x) (idx (idx x 5) -1)))
(.env_marked (lambda (x) (idx x 5))) (.env_marked (lambda (x) (idx x 5)))
(marked_env_real? (lambda (x) (= nil (.marked_env_needed_for_progress x)))) (marked_env_real? (lambda (x) (= nil (idx (.marked_env_needed_for_progress x) 0))))
(.any_comb_wrap_level (lambda (x) (cond ((prim_comb? x) (.prim_comb_wrap_level x)) (.any_comb_wrap_level (lambda (x) (cond ((prim_comb? x) (.prim_comb_wrap_level x))
((comb? x) (.comb_wrap_level x)) ((comb? x) (.comb_wrap_level x))
(true (error "bad .any_comb_level"))))) (true (error "bad .any_comb_level")))))
; The actual needed_for_progress values are either ; The actual needed_for_progress values are either
; #t - any eval will do something ; #t - any eval will do something
; nil - is a value, no eval will do anything ; nil - is a value, no eval will do anything
@@ -286,32 +267,103 @@
; of an evaluation of, then it could progress futher. These are all caused by ; of an evaluation of, then it could progress futher. These are all caused by
; the infinite recursion stopper. ; the infinite recursion stopper.
(needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x)) (needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x))
((marked_symbol? x) (array (.marked_symbol_needed_for_progress x) nil)) ((marked_symbol? x) (array (.marked_symbol_needed_for_progress x) nil nil))
((marked_env? x) (array (.marked_env_needed_for_progress x) nil)) ((marked_env? x) (.marked_env_needed_for_progress x))
((comb? x) (dlet ((id (.comb_id x)) ((comb? x) (dlet ((id (.comb_id x))
(body_needed (idx (needed_for_progress (.comb_body x)) 0)) ((body_needed _hashes extra1) (needed_for_progress (.comb_body x)))
(se_needed (idx (needed_for_progress (.comb_env x)) 0))) ((se_needed _hashes extra2) (needed_for_progress (.comb_env x))))
(if (or (= true body_needed) (= true se_needed)) (array true nil) (if (or (= true body_needed) (= true se_needed)) (array true nil nil)
(array (foldl (lambda (a xi) (if (or (= id xi) (in_array xi a)) a (cons xi a))) (array (array_union_without id body_needed se_needed)
(array) (concat body_needed se_needed)) nil) nil (array_union_without id extra1 extra2))
))) )))
((prim_comb? x) (array nil nil)) ((prim_comb? x) (array nil nil nil))
((val? x) (array nil nil)) ((val? x) (array nil nil nil))
(true (error (str "what is this? in need for progress" x)))))) (true (error (str "what is this? in need for progress" x))))))
(needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0))) (needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0)))
(hash_symbol (lambda (progress_idxs s) (combine_hash (if (= true progress_idxs) 11 (foldl combine_hash 13 (map (lambda (x) (if (= true x) 13 (+ 1 x))) progress_idxs))) (hash_string (get-text s)))))
(hash_array (lambda (is_val attempted a) (foldl combine_hash (if is_val 17 (cond ((int? attempted) (combine_hash attempted 19))
(attempted 61)
(true 107))) (map .hash a))))
(hash_env (lambda (has_vals progress_idxs dbi arrs) (combine_hash (if has_vals 107 109)
(combine_hash (mif dbi (hash_num dbi) 59) (dlet (
;(_ (begin (true_print "pre slice " (slice arrs 0 -2)) 0))
;(_ (begin (true_print "about to do a fold " progress_idxs " and " (slice arrs 0 -2)) 0))
(inner_hash (foldl (dlambda (c (s v)) (combine_hash c (combine_hash (hash_symbol true s) (.hash v))))
(cond ((= nil progress_idxs) 23)
((= true progress_idxs) 29)
(true (foldl combine_hash 31 progress_idxs)))
(slice arrs 0 -2)))
(end (idx arrs -1))
(end_hash (mif end (.hash end) 41))
) (combine_hash inner_hash end_hash))))))
(hash_comb (lambda (wrap_level env_id de? se variadic params body)
(combine_hash 43
(combine_hash wrap_level
(combine_hash env_id
(combine_hash (mif de? (hash_symbol true de?) 47)
(combine_hash (.hash se)
(combine_hash (hash_bool variadic)
(combine_hash (foldl (lambda (c x) (combine_hash c (hash_symbol true x))) 53 params)
(.hash body))))))))))
(hash_prim_comb (lambda (handler_fun real_or_name wrap_level val_head_ok) (combine_hash (combine_hash 59 (hash_symbol true real_or_name))
(combine_hash (if val_head_ok 89 97) wrap_level))))
(hash_val (lambda (x) (cond ((bool? x) (hash_bool x))
((string? x) (hash_string x))
((int? x) (hash_num x))
(true (error (str "bad thing to hash_val " x))))))
; 113 127 131 137 139 149 151 157 163 167 173
(marked_symbol (lambda (progress_idxs x) (array 'marked_symbol (hash_symbol progress_idxs x) progress_idxs x)))
(marked_array (lambda (is_val attempted resume_hashes x) (dlet (
((sub_progress_idxs hashes extra) (foldl (dlambda ((a ahs aeei) (x xhs x_extra_env_ids))
(array (cond ((or (= true a) (= true x)) true)
(true (array_union a x)))
(array_union ahs xhs)
(array_union aeei x_extra_env_ids))
) (array (array) resume_hashes (array)) (map needed_for_progress x)))
(progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) (= true attempted)) nil)
((and (= nil sub_progress_idxs) (not is_val) (= false attempted)) true)
((and (= nil sub_progress_idxs) (not is_val) (int? attempted)) (array attempted))
(true (if (int? attempted)
(array_item_union sub_progress_idxs attempted)
sub_progress_idxs))))
) (array 'marked_array (hash_array is_val attempted x) is_val attempted (array progress_idxs hashes extra) x))))
(marked_env (lambda (has_vals de? de ue dbi arrs) (dlet (
(de_entry (mif de? (array (array de? de)) (array)))
(full_arrs (concat arrs de_entry (array ue)))
((progress_idxs1 _hashes extra1) (mif ue (needed_for_progress ue) (array nil nil nil)))
((progress_idxs2 _hashes extra2) (mif de? (needed_for_progress de) (array nil nil nil)))
(progress_idxs (array_union progress_idxs1 progress_idxs2))
(extra (array_union extra1 extra2))
(progress_idxs (if (not has_vals) (cons dbi progress_idxs) progress_idxs))
(extra (if (!= nil progress_idxs) (cons dbi extra) extra))
) (array 'env (hash_env has_vals progress_idxs dbi full_arrs) has_vals (array progress_idxs nil extra) dbi full_arrs))))
(marked_val (lambda (x) (array 'val (hash_val x) x)))
(marked_comb (lambda (wrap_level env_id de? se variadic params body) (array 'comb (hash_comb wrap_level env_id de? se variadic params body) wrap_level env_id de? se variadic params body)))
(marked_prim_comb (lambda (handler_fun real_or_name wrap_level val_head_ok) (array 'prim_comb (hash_prim_comb handler_fun real_or_name wrap_level val_head_ok) handler_fun real_or_name wrap_level val_head_ok)))
(with_wrap_level (lambda (x new_wrap) (cond ((prim_comb? x) (dlet (((handler_fun real_or_name wrap_level val_head_ok) (.prim_comb x)))
(marked_prim_comb handler_fun real_or_name new_wrap val_head_ok)))
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x)))
(marked_comb new_wrap env_id de? se variadic params body)))
(true (error "bad with_wrap_level")))))
(test17 (or false 1 "a" true))
(test18 (and 1 "a" nil true))
(monad (array 'write 1 "test_self_out2" (vau (written code) (array (or written code) test17 (or false nil 0) (and written code) test18 (and nil 0 false))))) (and_fold (foldl and true '(true true false true)))
;(monad (array 'write 1 "test_self_out2" (vau (written code) (dlet ((_ (print 1234))) (in_array 0 (array written code)))))) (monad (array 'write 1 "test_self_out2" (vau (written code) and_fold)))
) monad) ) monad)
) )
;(array 'write 1 "test_self_out2" (vau (written code) 7))
; end of all lets ; end of all lets
)))))) ))))))
; impl of let1 ; impl of let1