-
Notifications
You must be signed in to change notification settings - Fork 1
/
library.scm
88 lines (58 loc) · 1.54 KB
/
library.scm
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
;;;; Definitions
;;; MIT Scheme
(define lib:cons (%make-tag-aware cons))
(define lib:cons* (%make-tag-aware cons*))
(define lib:list (%make-tag-aware list))
(define lib:apply
(%make-tag-aware
(lambda (f . args)
;; The cons* allows the usage (apply f arg1 arg2 ... rest-of-args).
(execute-application f (apply cons* args)))))
;; It's not tag-aware, so it strips tags, which is what we want.
(define lib:procedure? any-procedure?)
;;; Dwimiykwim
(define lib:tag (%make-tag-aware tag))
(define lib:tags (%make-tag-aware tags))
(define lib:untag (%make-tag-aware untag))
(define lib:clear-tags identity)
;;;; Bindings
(define library-exps '(
;;; MIT Scheme
(define cons lib:cons)
(define cons* lib:cons*)
(define list lib:list)
(define apply lib:apply)
(define procedure? lib:procedure?)
;;; Utils
(define (identity x) x)
(define (any? x) #t)
(define (compose f g)
(lambda args
(f (apply g args))))
(define (partial-apply f . args)
(lambda more-args
(apply f (append args more-args))))
;;; Dwimiykwim
(define tag lib:tag)
(define tags lib:tags)
(define untag lib:untag)
(define clear-tags lib:clear-tags)
(define (~~? name)
(lambda (x)
(member name (tags x))))
(define (?? proc . args)
(infer proc args))
(define (??:apply proc . args)
(lambda more-args
(infer proc (append args more-args))))
(define (~~ names x)
(tag (if (list? names)
names
(list names))
x))
(define (~~:delq names x)
(untag (if (list? names)
names
(list names))
x))
))