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

Impl function let-rec with Y*

Browse Source
This commit is contained in:
Nathan Braswell
2020-10-18 19:11:23 -04:00
parent d689a59097
commit f9529b02aa
1 changed files with 29 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
new_kraken.kp
View File

@@ -13,7 +13,7 @@
(let1 concat_helper (lambda (recurse a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (recurse recurse a1 a2 a3 (+ i 1))) (let1 concat_helper (lambda (recurse a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (recurse recurse a1 a2 a3 (+ i 1)))
(< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (recurse recurse a1 a2 a3 (+ i 1))) (< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (recurse recurse a1 a2 a3 (+ i 1)))
true a3)) true a3))
(let1 concat (lambda (a1 a2) (concat_helper concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0)) (let1 concat (lambda (& as) (concat_helper concat_helper as (array-with-len (lapply + (map len as))) 0))
(let1 current-env (vau de () de) (let1 current-env (vau de () de)
(let1 lapply (lambda (f p) (eval (concat (array (unwrap f)) p) (current-env))) (let1 lapply (lambda (f p) (eval (concat (array (unwrap f)) p) (current-env)))
@@ -29,6 +29,7 @@
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de))))) true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de)))))
(let ( (let (
print_through (lambda (x) (do (println x) x))
rec-lambda (vau se (p b) (eval (array Y (array lambda (quote (recurse)) (array lambda p b))) se)) rec-lambda (vau se (p b) (eval (array Y (array lambda (quote (recurse)) (array lambda p b))) se))
if (vau de (con than & else) (cond (eval con de) (eval than de) if (vau de (con than & else) (cond (eval con de) (eval than de)
@@ -43,6 +44,23 @@
(recurse f l n (+ i 1)))))) (recurse f l n (+ i 1))))))
(helper f l (array-with-len (len l)) 0))) (helper f l (array-with-len (len l)) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda (f l n i)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1))))))
(helper f l (array-with-len (len l)) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
; Huge thanks to Oleg Kiselyov for his fantastic website ; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html ; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l) Y* (lambda (& l)
@@ -50,6 +68,15 @@
(lambda (p) (lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l)))) (map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body))))
flat_map (lambda (f l) flat_map (lambda (f l)
(let (helper (rec-lambda (f l n i) (let (helper (rec-lambda (f l n i)
(if (= i (len l)) (if (= i (len l))
@@ -76,7 +103,6 @@
true true
(concat (array (vapply recurse (array (idx x 0)) de)) (vapply recurse (array (slice x 1 -1)) de)))) (concat (array (vapply recurse (array (idx x 0)) de)) (vapply recurse (array (slice x 1 -1)) de))))
true x)))) true x))))
print_through (lambda (x) (do (println x) x))
provide (vau de (& items) (array let provide (vau de (& items) (array let
(flat_map (lambda (item) (array item (array quote (eval item de)))) items))) (flat_map (lambda (item) (array item (array quote (eval item de)))) items)))
scope_let_sans_import (provide scope_let_sans_import (provide
@@ -84,6 +110,7 @@
lambda lambda
rec-lambda rec-lambda
let let
let-rec
do do
if if
concat concat