From 20d554dfe6aa75e72edfecb3f8bd0299af5b6e86 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Sun, 8 May 2022 19:38:44 -0400 Subject: [PATCH] Fixed dropping 0-length arrays, RB-Tree seems to work well now! --- partial_eval.scm | 13 +++--- rb_tree_test/matching.kp | 92 ++++++++++++++++++++-------------------- 2 files changed, 54 insertions(+), 51 deletions(-) diff --git a/partial_eval.scm b/partial_eval.scm index 982e5b1..d5391fb 100644 --- a/partial_eval.scm +++ b/partial_eval.scm @@ -2373,11 +2373,14 @@ (then (local.set '$i (i32.wrap_i64 (i64.shr_u (local.get '$it) (i64.const 32)))) (local.set '$tmp_ptr (local.get '$ptr)) - (_loop '$l - (call '$drop (i64.load (local.get '$tmp_ptr))) - (local.set '$tmp_ptr (i32.add (local.get '$tmp_ptr) (i32.const 8))) - (local.set '$i (i32.sub (local.get '$i) (i32.const 1))) - (br_if '$l (i32.ne (i32.const 0) (local.get '$i))) + (block '$done + (_loop '$l + (br_if '$done (i32.eqz (local.get '$i))) + (call '$drop (i64.load (local.get '$tmp_ptr))) + (local.set '$tmp_ptr (i32.add (local.get '$tmp_ptr) (i32.const 8))) + (local.set '$i (i32.sub (local.get '$i) (i32.const 1))) + (br '$l) + ) ) ) (else diff --git a/rb_tree_test/matching.kp b/rb_tree_test/matching.kp index 8c6b89e..0f456a7 100644 --- a/rb_tree_test/matching.kp +++ b/rb_tree_test/matching.kp @@ -290,53 +290,53 @@ (let ( first set-empty - ;_ (log first " set-contains? " 1 " ? " (set-contains? first 1) " size " (size first)) - ;second (set-insert first 1) - ;_ (log second " set-contains? " 1 " ? " (set-contains? second 1) " size " (size second)) - ;third (set-insert second 2) - ;_ (log third " set-contains? " 1 " ? " (set-contains? third 1) " size " (size third)) - ;_ (log third " set-contains? " 2 " ? " (set-contains? third 2) " size " (size third)) - ;fourth (set-insert third 3) - ;_ (log fourth " set-contains? " 1 " ? " (set-contains? fourth 1) " size " (size fourth)) - ;_ (log fourth " set-contains? " 2 " ? " (set-contains? fourth 2) " size " (size fourth)) - ;_ (log fourth " set-contains? " 3 " ? " (set-contains? fourth 3) " size " (size fourth)) - ;_ (log fourth " set-contains? " 4 " ? " (set-contains? fourth 4) " size " (size fourth)) - ;_ (log fourth " foldl with + " (set-foldl + 0 fourth)) - ;fifth (set-remove fourth 1) - ;_ (log fifth " set-contains? " 1 " ? " (set-contains? fifth 1) " size " (size fifth)) - ;_ (log fifth " set-contains? " 2 " ? " (set-contains? fifth 2) " size " (size fifth)) - ;_ (log fifth " set-contains? " 3 " ? " (set-contains? fifth 3) " size " (size fifth)) - ;_ (log fifth " set-contains? " 4 " ? " (set-contains? fifth 4) " size " (size fifth)) - ;sixth (set-remove fifth 3) - ;_ (log sixth " set-contains? " 1 " ? " (set-contains? sixth 1) " size " (size sixth)) - ;_ (log sixth " set-contains? " 2 " ? " (set-contains? sixth 2) " size " (size sixth)) - ;_ (log sixth " set-contains? " 3 " ? " (set-contains? sixth 3) " size " (size sixth)) - ;_ (log sixth " set-contains? " 4 " ? " (set-contains? sixth 4) " size " (size sixth)) - ;seventh (set-remove sixth 2) - ;_ (log seventh " set-contains? " 1 " ? " (set-contains? seventh 1) " size " (size seventh)) - ;_ (log seventh " set-contains? " 2 " ? " (set-contains? seventh 2) " size " (size seventh)) - ;_ (log seventh " set-contains? " 3 " ? " (set-contains? seventh 3) " size " (size seventh)) - ;_ (log seventh " set-contains? " 4 " ? " (set-contains? seventh 4) " size " (size seventh)) + _ (log first " set-contains? " 1 " ? " (set-contains? first 1) " size " (size first)) + second (set-insert first 1) + _ (log second " set-contains? " 1 " ? " (set-contains? second 1) " size " (size second)) + third (set-insert second 2) + _ (log third " set-contains? " 1 " ? " (set-contains? third 1) " size " (size third)) + _ (log third " set-contains? " 2 " ? " (set-contains? third 2) " size " (size third)) + fourth (set-insert third 3) + _ (log fourth " set-contains? " 1 " ? " (set-contains? fourth 1) " size " (size fourth)) + _ (log fourth " set-contains? " 2 " ? " (set-contains? fourth 2) " size " (size fourth)) + _ (log fourth " set-contains? " 3 " ? " (set-contains? fourth 3) " size " (size fourth)) + _ (log fourth " set-contains? " 4 " ? " (set-contains? fourth 4) " size " (size fourth)) + _ (log fourth " foldl with + " (set-foldl + 0 fourth)) + fifth (set-remove fourth 1) + _ (log fifth " set-contains? " 1 " ? " (set-contains? fifth 1) " size " (size fifth)) + _ (log fifth " set-contains? " 2 " ? " (set-contains? fifth 2) " size " (size fifth)) + _ (log fifth " set-contains? " 3 " ? " (set-contains? fifth 3) " size " (size fifth)) + _ (log fifth " set-contains? " 4 " ? " (set-contains? fifth 4) " size " (size fifth)) + sixth (set-remove fifth 3) + _ (log sixth " set-contains? " 1 " ? " (set-contains? sixth 1) " size " (size sixth)) + _ (log sixth " set-contains? " 2 " ? " (set-contains? sixth 2) " size " (size sixth)) + _ (log sixth " set-contains? " 3 " ? " (set-contains? sixth 3) " size " (size sixth)) + _ (log sixth " set-contains? " 4 " ? " (set-contains? sixth 4) " size " (size sixth)) + seventh (set-remove sixth 2) + _ (log seventh " set-contains? " 1 " ? " (set-contains? seventh 1) " size " (size seventh)) + _ (log seventh " set-contains? " 2 " ? " (set-contains? seventh 2) " size " (size seventh)) + _ (log seventh " set-contains? " 3 " ? " (set-contains? seventh 3) " size " (size seventh)) + _ (log seventh " set-contains? " 4 " ? " (set-contains? seventh 4) " size " (size seventh)) - ;first map-empty - ;_ (log first " map-contains-key? " 1 " ? " (map-contains-key? first 1) " size " (size first)) - ;second (map-insert first 1 "hello") - ;_ (log second " map-contains-key? " 1 " ? " (map-contains-key? second 1) " size " (size second)) - ;_ (log second " map-get " 1 " ? " (map-get second 1) " size " (size second)) - ;third (map-insert second 1 "goodbye") - ;_ (log third " map-contains-key? " 1 " ? " (map-contains-key? third 1) " size " (size third)) - ;_ (log third " map-get " 1 " ? " (map-get third 1) " size " (size third)) - ;fourth (map-insert third 2 "hmmm") - ;_ (log fourth " map-contains-key? " 2 " ? " (map-contains-key? fourth 2) " size " (size fourth)) - ;_ (log fourth " map-get " 2 " ? " (map-get fourth 2) " size " (size fourth)) - ;_ (log fourth " map-contains-key? " 1 " ? " (map-contains-key? fourth 1) " size " (size fourth)) - ;_ (log fourth " map-get " 1 " ? " (map-get fourth 1) " size " (size fourth)) - ;_ (log fourth " map-contains-key? " 3 " ? " (map-contains-key? fourth 3) " size " (size fourth)) - ;_ (log fourth " map-get-or-default " 3 " 'hi ? " (map-get-or-default fourth 3 'hi) " size " (size fourth)) - ;_ (log fourth " map-get-with-default " 3 " (lambda () 'bye) ? " (map-get-with-default fourth 3 (lambda () 'bye)) " size " (size fourth)) - ;fifth (map-remove fourth 2) - ;_ (log fifth " map-contains-key? " 2 " ? " (map-contains-key? fifth 2) " size " (size fifth)) - ) (array 'exit (map-contains-key? first (read-string data)))) + first map-empty + _ (log first " map-contains-key? " 1 " ? " (map-contains-key? first 1) " size " (size first)) + second (map-insert first 1 "hello") + _ (log second " map-contains-key? " 1 " ? " (map-contains-key? second 1) " size " (size second)) + _ (log second " map-get " 1 " ? " (map-get second 1) " size " (size second)) + third (map-insert second 1 "goodbye") + _ (log third " map-contains-key? " 1 " ? " (map-contains-key? third 1) " size " (size third)) + _ (log third " map-get " 1 " ? " (map-get third 1) " size " (size third)) + fourth (map-insert third 2 "hmmm") + _ (log fourth " map-contains-key? " 2 " ? " (map-contains-key? fourth 2) " size " (size fourth)) + _ (log fourth " map-get " 2 " ? " (map-get fourth 2) " size " (size fourth)) + _ (log fourth " map-contains-key? " 1 " ? " (map-contains-key? fourth 1) " size " (size fourth)) + _ (log fourth " map-get " 1 " ? " (map-get fourth 1) " size " (size fourth)) + _ (log fourth " map-contains-key? " 3 " ? " (map-contains-key? fourth 3) " size " (size fourth)) + _ (log fourth " map-get-or-default " 3 " 'hi ? " (map-get-or-default fourth 3 'hi) " size " (size fourth)) + _ (log fourth " map-get-with-default " 3 " (lambda () 'bye) ? " (map-get-with-default fourth 3 (lambda () 'bye)) " size " (size fourth)) + fifth (map-remove fourth 2) + _ (log fifth " map-contains-key? " 2 " ? " (map-contains-key? fifth 2) " size " (size fifth)) + ) (array 'exit (map-get fifth (read-string data)))) ;(array 'exit (match (read-string data)