blob: 4d523ea384b81466b36dcd8b464bc7fdfb1ff41f (
plain)
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(define-module (Com Simatime core))
(define (flip f) (lambda (x y) (f y x)))
(define (curry f a) (lambda (b) (apply f (cons a (list b)))))
(define pos?
(curry < 0))
(define neg?
(curry > 0))
(define (foldr f end lst)
(if (null? lst)
end
(f (car lst) (foldr f end (cdr lst)))))
(define (foldl f acc lst)
(if (null? lst)
acc
(foldl f (f acc (car lst)) (cdr lst))))
(define fold foldl)
(define (unfold f init pred)
(if (pred init)
(cons init '())
(cons init (unfold f (f init) pred))))
(define (sum lst) (fold + 0 lst))
(define (produce lst) (fold * 0 1 lst))
(define count length)
;;
;; clojure-like stuff
;;
(define (pr . a)
(for-each display args))
(define (prn . a) (apply pr a) (newline))
(define first
"Return the first item in the collection."
car)
(define next
"Returns a list of the items after the first."
cadr)
(define (second x)
(first (next x)))
(define (ffirst x)
(first (first x)))
(define (nnext x)
(next (next)))
(define (last coll)
"Return the last time in coll, in linear time."
(if (next coll)
(last coll)
(first coll)))
(define (butlast ls)
"Return everthing execpt the last element in ls."
(let ((len (length ls)))
(list-head ls (- len 1))))
(define (false? x)
(eq? #f x))
(define (true? x)
(eq? #t x))
(define nil 'nil)
(define (nil? x)
(eq? nil x))
(define (some pred coll)
(or (pred (first coll))
(some pred (next coll))))
(define comp compose)
(define (not-any? pred coll)
(comp not some))
(define-syntax when-not
(syntax-case
(())))
#|
If I implement ML-like interface abstractions in scheme, what would it look like?
;; seq
(define-class <seq> () (_first))
;; Functor
(define-class <functor> ())
(define-method (fmap (f <procedure>) (coll <functor>)))
;; Applicative
;; a -> f a
(define-method (pure (a <any>)))
;; f (a -> b) -> f a -> f b
(define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
;; f a -> f b -> f b
(define-method (*> (a <applicative>) (b <applicative>)))
;; f a -> f b -> f a
(define-method (<* (a <applicative>) (b <applicative>)))
|#
|
