Finally fixed let_test4. Let_test5 will require more thinking to see if it's even possible, and what macro like means etc

partial_eval.kp

@@ -53,13 +53,14 @@
 
     later? (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_env? x)    (not (marked_env_real? x)))
+                                      ; This is now taken care of via the de Bruijn >= 0 check in call, otherwise these are values, kinda, as long as they don't go negative (or are real)
-                                       (and (comb? x)          (let ([wrap_level de? se variadic params body] (.comb x)
+                                      ;(and (marked_env? x)    (not (marked_env_real? x)))
-                                                                     ; this is the complex bit - we should do something like check if
+                                      ;(and (comb? x)          (let ([wrap_level de? se variadic params body] (.comb x)
-                                                                     ; se is fake check to see if there are symbols or eval that could use it
+                                      ;                              ; this is the complex bit - we should do something like check if
-                                                                     ; or a sub-comb's se, or if de is non-nil and used in some sub-call.
+                                      ;                              ; se is fake check to see if there are symbols or eval that could use it
-                                                                     comb_is_later (recurse se)
+                                      ;                              ; or a sub-comb's se, or if de is non-nil and used in some sub-call.
-                                                                    ) comb_is_later))
+                                      ;                              comb_is_later (recurse se)
+                                      ;                             ) comb_is_later))
                                    ))
     false? (lambda (x) (cond (and (marked_array? x)  (= false (.marked_array_is_val x)))    (error (str "got a later marked_array passed to false? " x))
                              (and (marked_symbol? x) (= false (.marked_symbol_is_val x)))   (error (str "got a later marked_symbol passed to false? " x))
@@ -89,8 +90,8 @@
               (marked_symbol? x) (if (.marked_symbol_is_val x) ['quote (.marked_symbol_value x)]
                                                                (.marked_symbol_value x))
               (comb? x)          (let ([wrap_level de? se variadic params body] (.comb x))
-                                      (str "<comb " wrap_level " " de? " <se> " params " " (recurse body) ">"))
+                                      ;(str "<comb " wrap_level " " de? " <se> " params " " (recurse body) ">"))
-                                      ;(str "<comb " wrap_level " " de? " <se " (recurse se) "> " params " " (recurse body) ">"))
+                                      (str "<comb " wrap_level " " de? " <se " (recurse se) "> " params " " (recurse body) ">"))
               (prim_comb? x)     (idx x 2)
               (marked_env? x)    (let (e (.env_marked x)
                                        index (.marked_env_idx x)
@@ -186,13 +187,14 @@
 
     is_all_values (lambda (evaled_params) (foldl (lambda (a x) (and a (not (later? x)))) true evaled_params))
 
+    ; * TODO: allowing envs to be shead if they're not used.
     shift_envs (rec-lambda recurse (cutoff d x) (cond
         (val? x)            [true x]
         (marked_env? x)     (let ([_env is_real dbi meat] x
                                   [nmeat_ok nmeat] (foldl (lambda ([ok r] [k v]) (let ([tok tv] (recurse cutoff d v)) [(and ok tok) (concat r [[k tv]])])) [true []] (slice meat 0 -2))
                                   [nupper_ok nupper] (if (idx meat -1) (recurse cutoff d (idx meat -1)) [true nil])
                                   ndbi (if (>= cutoff dbi) (+ dbi d) dbi)
-                              ) [(and nmeat_ok nupper_ok (>= ndbi 0)) ['env is_real ndbi (concat nmeat [nupper])]])
+                              ) [(and nmeat_ok nupper_ok (or is_real (>= ndbi 0))) ['env is_real ndbi (concat nmeat [nupper])]])
         (comb? x)           (let ([wrap_level de? se variadic params body] (.comb x)
                                     [se_ok nse] (recurse cutoff d se)
                                     [body_ok nbody] (recurse (+ cutoff 1) d body)
@@ -210,7 +212,6 @@
     ; ['ref de_bruijn_index_of_env index_into_env] or somesuch. Could really simplify
     ; compiling, and I think make partial-eval more efficient. More accurate closes_over analysis too, I think
     make_tmp_inner_env (lambda (params de? de)
-            ; TODO: our de Bruijn index is 0, increment de's index
             ['env false 0 (concat (map (lambda (p) [p ['marked_symbol false p]]) params) (if (= nil de?) [] [ [de? ['marked_symbol false de?]] ]) [(increment_envs de)])])
 
 
@@ -220,7 +221,15 @@
                 ; 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)     x
+                (marked_env? x)     (let (dbi (.marked_env_idx x))
+                                          (if dbi (let (curr_env (idx env_stack dbi)
+                                                        odbi (.marked_env_idx curr_env)
+                                                        _ (if (!= dbi odbi) (error (str (str_strip "same env with different dbis " x) (str_strip " and " curr_env))))
+                                                        )
+                                                        ;(idx (shift_envs ? (- dbi odbi) curr_env) 1))
+                                                        curr_env)
+                                                  x))
+
                 (comb? x)           (let ([wrap_level de? se variadic params body] (.comb x))
                                         (if (or (and (not (marked_env_real? env)) (not (marked_env_real? se)))   ; both aren't real, re-evaluation of creation site
                                                 (and      (marked_env_real? env)  (not (marked_env_real? se))))  ; new env real, but se isn't - creation!
@@ -263,11 +272,10 @@
                                                                                  final_params (if variadic (concat (slice appropriatly_evaled_params 0 (- (len params) 1))
                                                                                                                    [['marked_array true (slice appropriatly_evaled_params (- (len params) 1) -1)]])
                                                                                                            appropriatly_evaled_params)
-                                                                                 de_entry (if (!= nil de?) [ [de? (if (marked_env_real? env) env
+                                                                                 [de_real de_entry] (if (!= nil de?) [ (marked_env_real? env) [ [de? env ] ] ]
-                                                                                                                                             ['marked_symbol false de?])] ]
+                                                                                                                     [ true []])
-                                                                                                           [])
                                                                                  ;_ (println (indent_str indent) "final_params params " final_params)
-                                                                                 inner_env ['env (marked_env_real? se) 0 (concat (zip params (map (lambda (x) (increment_envs x)) final_params)) de_entry [(increment_envs se)])]
+                                                                                 inner_env ['env (and de_real (marked_env_real? se)) 0 (concat (zip params (map (lambda (x) (increment_envs x)) final_params)) de_entry [(increment_envs se)])]
                                                                                  _ (print_strip (indent_str indent) " with inner_env is " inner_env)
                                                                                  _ (print_strip (indent_str indent) "going to eval " body)
 
@@ -293,7 +301,7 @@
     needs_params_val_lambda (vau de (f_sym) (let (
         actual_function (eval f_sym de)
         handler (rec-lambda recurse (de env_stack params indent) (let (
-                _ (println "partial_evaling params in need_params_val_lambda for " f_sym " is " params)
+                ;_ (println "partial_evaling params in need_params_val_lambda for " f_sym " is " params)
                 evaled_params (map (lambda (p) (partial_eval_helper p de env_stack (+ 1 indent))) params)
             )
             (if (is_all_values evaled_params) (mark (lapply actual_function (map strip evaled_params)))
@@ -339,7 +347,6 @@
             _ (print_strip (indent_str indent) "in vau, evaluating body with 'later params - " body)
             pe_body (partial_eval_helper body inner_env (cons inner_env env_stack) (+ 1 indent))
             _ (print_strip (indent_str indent) "in vau, result of evaluating body was " pe_body)
-            _ (print_strip pe_body)
         ) ['comb 0 de? de variadic vau_params pe_body]
         )) vau]]
 
@@ -361,7 +368,7 @@
             eval_env (if (= 2 (len params)) (partial_eval_helper (idx params 1) de env_stack (+ 1 indent))
                                             de)
             eval_env_v (if (= 2 (len params)) [eval_env] [])
-         ) (if (not (marked_env? eval_env)) ['marked_array false (cons self params)]
+         ) (if (not (marked_env? eval_env)) (do (print_strip (indent_str indent) "eval got not a marked env " eval_env) ['marked_array false (cons self params)])
                                             (let (
             _ (print_strip (indent_str indent) " partial_evaling_body the first time " (idx params 0))
             body1 (partial_eval_helper (idx params 0) de env_stack (+ 1 indent))
@@ -371,7 +378,7 @@
             fail_handler (lambda (failed) ['marked_array false (concat [self failed] eval_env_v)])
             [ok unval_body] (try_unval body1 fail_handler)
             self_fallback (fail_handler body1)
-            _ (print_strip "partial_evaling body for the second time in eval " unval_body)
+            _ (print_strip (indent_str indent) "partial_evaling body for the second time in eval " unval_body)
             body2 (if (= self_fallback unval_body) self_fallback (partial_eval_helper unval_body eval_env env_stack (+ 1 indent)))
             _ (print_strip (indent_str indent) "and body2 is " body2)
             ) body2))
@@ -412,6 +419,7 @@
         (needs_params_val_lambda bool?)
         (needs_params_val_lambda str-to-symbol)
         (needs_params_val_lambda get-text)
+
         ['array? ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
             (cond 
                   (later? evaled_param)         ['marked_array false [['prim_comb recurse array?] evaled_param]]
@@ -419,8 +427,12 @@
                   true                          ['val false]
             )
         )) array?]]
+        ; This one's sad, might need to come back to it.
+        ; We need to be able to differentiate between half-and-half arrays
+        ; for when we ensure_params_values or whatever, because that's super wrong
         ['array ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
-                                                ['marked_array true evaled_params]
+                                                (if (is_all_values evaled_params) ['marked_array true evaled_params]
+                                                                                  ['marked_array false (cons ['prim_comb recurse array] evaled_params)])
         )) array]]
         ['len ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
             (cond (later? evaled_param)         ['marked_array false [['prim_comb recurse len] evaled_param]]
@@ -446,6 +458,7 @@
                   true                                                                                              ['marked_array false (cons ['prim_comb recurse concat] evaled_params)]
             )
         ))) concat]]
+
         (needs_params_val_lambda +)
         (needs_params_val_lambda -)
         (needs_params_val_lambda *)

partial_eval_test.kp

@@ -61,26 +61,6 @@
     let3_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (+ x a 1)))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
     let4_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
 
-    ; Ok, the post-refactor sticking point is
-    ;
-    ; after first eval of param  ( marked_array true ( ( marked_array true ( ( prim_comb combiner(wrap_level: 1) builtin_combiner_vau(wrap_level: 0) ) ( marked_array true ( ( marked_symbol true y ) ) ) ( marked_array true ( ( marked_symbol true + ) ( marked_symbol true y ) ( marked_symbol true x ) ( marked_symbol true a ) ) ) ) ) ( marked_array false ( ( prim_comb combiner(wrap_level: 1) builtin_combiner_+(wrap_level: 1) ) ( marked_symbol false x ) ( val 12 ) ( val 1 ) ) ) ) )
-    ;
-    ; tries to finish the eval by unvaling & then partial evaling:
-    ; [ [ vau [ 'y ] [ '+ 'y 'x 'a ] ] ( + x 12 1 ) ]
-    ;
-    ; This fails as it can't unval (+ x 12 1). Note the vau's not wrapped, so it won't actually partial eval after that, but it still dies first...
-    ; This is where that is_val as an int might make sense...
-    ;   theoretically when the vau uses y and then strips it can sub in the stuff exactly, as subbing in itself counts as an evaluation.
-    ;   In general, stripping counts as a +1 to the is_val counter and we need to add evals or (array ...)/quote to get it to 0. In this case, it would work perfectly.
-    ;   The REALLY tricky part is that by allow it to go negative we have to remember what environment it needs to be evaluated in and make sure it's either the same environment
-    ;   or a sub environment that doesn't shadow anything...
-    ;
-    ; ALTERNATIVE: allow partial evals on things that contain negatives, but don't actually do the call, but allow the partial eval to go into the other
-    ;               parts, namely into the body of the vau above
-    ;
-    ; Also, it seems to be bailing even harder than it otherwise should be, as that above partial eval of let1, as limited as it is, doesn't show up in the final output
-    ;   This is due to the later? and closes_over_var_from_this_env_marked check in function call
-    ;
     ;!!!!!!!!!!!!!!!!!!!!!!!!!!
     ; Which means we need TODO
     ;!!!!!!!!!!!!!!!!!!!!!!!!!!