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

Some bugfixes, a small recursive test (that currently loops forever), and the sierpinski triangle from a while back I forgot to commit

Browse Source
This commit is contained in:
Nathan Braswell
2021-11-07 00:44:18 -04:00
parent c0a07b54ce
commit 437c2c7166
3 changed files with 82 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
partial_eval.kp
View File

@@ -220,10 +220,6 @@
partial_eval_helper (rec-lambda recurse (x env env_stack indent)
(cond (val? x) x
; TODO: update from current environment stack based on de Bruijn index
; Note that we need to normalize indicies, I think - incrementing or decrmenting values in the env from env_stack
; to match what we have here, which can be calculated by the difference between the level the env thinks it is verses what it is
; note we do have to make sure that index is copied over as well.
(marked_env? x) (let (dbi (.marked_env_idx x))
(if dbi (let (new_env (idx env_stack dbi)
ndbi (.marked_env_idx new_env)
@@ -299,7 +295,8 @@
literal_params))]
func_result)
) result)))
(later? comb) ['marked_array false (cons comb literal_params)])))
(later? comb) ['marked_array false (cons comb literal_params)]
true (error (str "impossible comb value " x)))))
true (error (str "impossible partial_eval value " x))
)
)
@@ -457,12 +454,12 @@
)
)) slice]]
['concat ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(cond (foldl (lambda (a x) (and a (and (marked_array? x) (.marked_array_is_val x))) true evaled_params) ['marked_array true (lapply concat (map (lambda (x)
(cond (foldl (lambda (a x) (and a (and (marked_array? x) (.marked_array_is_val x)))) true evaled_params) ['marked_array true (lapply concat (map (lambda (x)
(.marked_array_values x))
evaled_params))]
true ['marked_array false (cons ['prim_comb recurse concat] evaled_params)]
)
))) concat]]
)) concat]]
(needs_params_val_lambda +)
(needs_params_val_lambda -)

40
partial_eval_test_rec.kp Normal file
View File

@@ -0,0 +1,40 @@
(with_import "./partial_eval.kp"
(let (
test-case (lambda (source) (let (
_ (println "Source: " source)
code (read-string source)
_ (println "Code: " code)
partially_evaled (partial_eval code)
_ (println "Partially evaled: " partially_evaled)
_ (print_strip partially_evaled)
stripped (strip partially_evaled)
_ (println "Stripped: " stripped)
fully_evaled (eval stripped root_env)
_ (println "Fully evaled: " fully_evaled)
fully_evaled_called (if (combiner? fully_evaled) (fully_evaled 1337))
_ (if (combiner? fully_evaled) (println "..and called " fully_evaled_called))
outer_eval (eval code root_env)
_ (println " outer-eval " outer_eval)
outer_called (if (combiner? outer_eval) (outer_eval 1337))
_ (if (combiner? outer_eval) (println "..and outer called " outer_called))
_ (cond (or (combiner? fully_evaled) (combiner? outer_eval))
(if (!= fully_evaled_called outer_called) (error (str "called versions unequal for " code " are " fully_evaled_called " vs " outer_called)))
(!= fully_evaled outer_eval) (error (str "partial-eval versions unequal for " code " are " fully_evaled " vs " outer_eval))
true nil)
_ (println)
) fully_evaled))
;_ (test-case "(+ 1 2)")
_ (test-case "((wrap (vau (x n) (x x n))) (wrap (vau (self n) (cond (= n 0) 10 true (self self (- n 1))))) 2)")
;_ (test-case "((wrap (vau (let1)
; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
; (let1 current-env (vau de () de)
; (let1 cons (lambda (h t) (concat (array h) t))
; (let1 lapply (lambda (f p) (eval (cons (unwrap f) p) (current-env)))
; (lambda (x) x)
; )))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
) nil))

38
sierpinski.kp Normal file
View File

@@ -0,0 +1,38 @@
(with_import "./collections.kp"
(let (
to_bpm (lambda (x) (let (
rows (len x)
cols (len (idx x 0))
file "P1"
file (str file "\n" cols " " rows)
file (foldl (lambda (a row)
(str a "\n" (foldl (lambda (a x)
(str a " " x)
) "" row))
) file x)
) file))
stack concat
side (lambda (a b) (foldl (lambda (a b c) (concat a [(concat b c) ]))
[] a b))
padding (rec-lambda recurse (r c)
(cond (and (= 1 r) (= 1 c)) [ [ 0 ] ]
(= 1 c) (let (x (recurse (/ r 2) c)) (stack x x))
true (let (x (recurse r (/ c 2))) (side x x))))
shape [ [ 1 1 ]
[ 1 1 ] ]
sierpinski (rec-lambda recurse (depth)
(if (= depth 1) shape
(let (s (recurse (/ depth 2))
p (padding depth (/ depth 2))
) (stack (side (side p s) p)
(side s s))))
)
img (to_bpm (sierpinski 64))
) (write_file "./sierpinski.pbm" img)
))