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

Implement drop_redundent_veval and make veval properly re-partially-eval and update the env it's called with. Y combiner test added and works now, map still seems not to, about to look at it

Browse Source
This commit is contained in:
Nathan Braswell
2022-02-07 00:31:51 -05:00
parent 31a8002a11
commit 931dd9a8f5
2 changed files with 96 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
to_compile.kp
View File

@@ -13,43 +13,42 @@
(lambda (x4) (f (vau de1 (& y) (vapply (x4 x4) y de1))))))
(let1 let (vY (lambda (recurse) (vau de2 (vs b) (cond (= (len vs) 0) (eval b de2)
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de2)))))
(let (
;a 1
;lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
;if (vau de (con than & else) (cond (eval con de) (eval than de)
; (> (len else) 0) (eval (idx else 0) de)
; true false))
(let (
;a 1
;lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
;if (vau de (con than & else) (cond (eval con de) (eval than de)
; (> (len else) 0) (eval (idx else 0) de)
; true false))
; The sticking point for map seemed to be a mis-step with being over conservitive finding de, so renaming de's to be unique lets it procede
; Although, without that, it now runs 60x longer and then still has the same compiles to call problem.
; - Is it due to failure to compile cuasing re-attempts in an exponential way?
; - Nope, contains-symbols has come home to roost
map (lambda (f5 l5)
; now maybe errors on can't find helper?
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
;(<= i (- (len l) 4)) (recurse f l (concat n (array
; (f (idx l (+ i 0)))
; (f (idx l (+ i 1)))
; (f (idx l (+ i 2)))
; (f (idx l (+ i 3)))
; )) (+ i 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
test (map (lambda (x) (+ x 1)) (array 1 2))
;test ((rec-lambda recurse (n) (cond (= 0 n) 1
; true (* n (recurse (- n 1))))) 5)
;monad (array 'open 3 "test_self_out" (lambda (fd code)
; (array 'write fd "wabcdefghijklmnopqrstuvwx" (lambda (written code)
; (array 'exit (if (= 0 written) 12 14))))))
monad (array 'write 1 "test_self_out2" (vau (written code) test))
)
monad
)
map (lambda (f5 l5)
; now maybe errors on can't find helper?
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
;(<= i (- (len l) 4)) (recurse f l (concat n (array
; (f (idx l (+ i 0)))
; (f (idx l (+ i 1)))
; (f (idx l (+ i 2)))
; (f (idx l (+ i 3)))
; )) (+ i 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
test (map (lambda (x) (+ x 1)) (array 1 2))
;test ((rec-lambda recurse (n) (cond (= 0 n) 1
; true (* n (recurse (- n 1))))) 5)
;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) test))
)
monad
)
;(array 'write 1 "test_self_out2" (vau (written code) 7))
; end of all lets
)))))))
)
))))))))
; impl of let1
; this would be the macro style version (((
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))