kernel_abe/library.knl at master · dalnefre/kernel_abe · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
;;;
;;; Kernel standard library
;;;

($define! car
	($lambda ((x . #ignore)) x))
($define! cdr
	($lambda ((#ignore . x)) x))
;...
($define! caar
	($lambda (((x . #ignore) . #ignore)) x))
($define! cdar
	($lambda (((#ignore . x) . #ignore)) x))
($define! cadr
	($lambda ((#ignore x . #ignore)) x))
($define! cddr
	($lambda ((#ignore . (#ignore . x))) x))
;...
($define! caaar
	($lambda ((((x . #ignore) . #ignore) . #ignore)) x))
($define! cdaar
	($lambda ((((#ignore . x) . #ignore) . #ignore)) x))
($define! cadar
	($lambda (((#ignore . (x . #ignore)) . #ignore)) x))
($define! cddar
	($lambda (((#ignore . (#ignore . x)) . #ignore)) x))
($define! caadr
	($lambda ((#ignore . ((x . #ignore) . #ignore))) x))
($define! cdadr
	($lambda ((#ignore . ((#ignore . x) . #ignore))) x))
($define! caddr
	($lambda ((#ignore . (#ignore . (x . #ignore)))) x))
($define! cdddr
	($lambda ((#ignore . (#ignore . (#ignore . x)))) x))
;...
($define! caaaar
	($lambda (((((x . #ignore) . #ignore) . #ignore) . #ignore)) x))
($define! cdaaar
	($lambda (((((#ignore . x) . #ignore) . #ignore) . #ignore)) x))
($define! cadaar
	($lambda ((((#ignore . (x . #ignore)) . #ignore) . #ignore)) x))
($define! cddaar
	($lambda ((((#ignore . (#ignore . x)) . #ignore) . #ignore)) x))
($define! caadar
	($lambda (((#ignore . ((x . #ignore) . #ignore)) . #ignore)) x))
($define! cdadar
	($lambda (((#ignore . ((#ignore . x) . #ignore)) . #ignore)) x))
($define! caddar
	($lambda (((#ignore . (#ignore . (x . #ignore))) . #ignore)) x))
($define! cdddar
	($lambda (((#ignore . (#ignore . (#ignore . x))) . #ignore)) x))
;...
($define! caaadr
	($lambda ((#ignore . (((x . #ignore) . #ignore) . #ignore))) x))
($define! cdaadr
	($lambda ((#ignore . (((#ignore . x) . #ignore) . #ignore))) x))
($define! cadadr
	($lambda ((#ignore . ((#ignore . (x . #ignore)) . #ignore))) x))
($define! cddadr
	($lambda ((#ignore . ((#ignore . (#ignore . x)) . #ignore))) x))
($define! caaddr
	($lambda ((#ignore . (#ignore . ((x . #ignore) . #ignore)))) x))
($define! cdaddr
	($lambda ((#ignore . (#ignore . ((#ignore . x) . #ignore)))) x))
($define! cadddr
	($lambda ((#ignore . (#ignore . (#ignore . (x . #ignore))))) x))
($define! cddddr
	($lambda ((#ignore . (#ignore . (#ignore . (#ignore . x))))) x))
;...
($define! equal?
	($lambda (x y)
		($if (pair? x)
			($if (equal? (car x) (car y))
				(equal? (cdr x) (cdr y))
				#f)
			(eq? x y))))
($define! apply
	($lambda (appv arg . opt)
		(eval (cons (unwrap appv) arg)
			($if (null? opt)
				(make-environment)
				(car opt)))))
($define! list*
	($lambda (head . tail)
		($if (null? tail)
			head
			(cons head (apply list* tail)))))
($define! $let
	($vau (bindings . body) env
		(eval (cons (list* $lambda (map car bindings) body)
			(map cadr bindings))
		env)))

;;;
;;; Concurrency
;;;

($define! $parallel list)  ; only valid if 'list' evals in parallel

;;;
;;; Bonus definitions
;;;

($define! Y  ; applicative Y-combinator (recursive fixed-point)
	($lambda (f)
		(($lambda (g)
			(g g))
			($lambda (h)
				($lambda (x)
					((f (h h)) x))))))