From 437c2c716696ea449964e0c1fb6894694be2b366 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Sun, 7 Nov 2021 00:44:18 -0400 Subject: [PATCH] Some bugfixes, a small recursive test (that currently loops forever), and the sierpinski triangle from a while back I forgot to commit --- partial_eval.kp | 11 ++++------- partial_eval_test_rec.kp | 40 ++++++++++++++++++++++++++++++++++++++++ sierpinski.kp | 38 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 82 insertions(+), 7 deletions(-) create mode 100644 partial_eval_test_rec.kp create mode 100644 sierpinski.kp diff --git a/partial_eval.kp b/partial_eval.kp index e3301cf..269d422 100644 --- a/partial_eval.kp +++ b/partial_eval.kp @@ -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 -) diff --git a/partial_eval_test_rec.kp b/partial_eval_test_rec.kp new file mode 100644 index 0000000..601b356 --- /dev/null +++ b/partial_eval_test_rec.kp @@ -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)) diff --git a/sierpinski.kp b/sierpinski.kp new file mode 100644 index 0000000..e3a9f36 --- /dev/null +++ b/sierpinski.kp @@ -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) +))