blob: e6c7eee0f982fa8a36b92a25e0bfa1c6bbc37c6d (
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
127
128
129
130
131
132
133
134
135
136
137
138
|
(define cadr (x) (car (cdr x)))
(define caddr (x) (car (cdr (cdr x))))
(define cadddr (x) (car (cdr (cdr (cdr x)))))
(define not (x) (if x 0 1))
(define or (x y) (if x 1 (if y 1 0)))
(define and (x y) (if x (if y 1 0) 0))
(define const (x) (lambda (_) x))
(define != (x y) (not (= x y)))
(define < (x y) (and (<= x y) (!= x y)))
(define > (x y) (< y x))
(define >= (x y) (<= y x))
(define . (f g) (lambda (x) (f (g x))))
(define YY (recur) (lambda (f) (lambda (a) (f ((recur recur) f) a))))
(define Y (YY YY))
(define for (start end f)
(if (<= start end)
(do (f start) (for (+ start 1) end f))
'()))
(define generic-list-string-2 (name flist fstring)
(lambda (f obj)
(cond
(type-list? obj)
(flist f obj)
(type-string? obj)
(fstring f obj)
(error (concat name " called on non-(list or string)")))))
(define take-while-list (f l)
(cond
(null? l)
l
(f (car l))
(cons (car l) (take-while-list f (cdr l)))
'()))
(define bracket (s) (concat "<" s ">"))
(define take-while-str (f s)
(cond
(= s "")
s
(f (substr 0 1 s))
(concat (substr 0 1 s) (take-while-str f (substr 1 -1 s)))
""))
(define take-while (generic-list-string-2 "take-while" take-while-list take-while-str))
(define drop-while-list (f l)
(cond
(null? l)
l
(f (car l))
(drop-while-list f (cdr l))
l))
(define drop-while-str (f s)
(cond
(= s "")
s
(f (substr 0 1 s))
(drop-while-str f (substr 1 -1 s))
s))
(define drop-while (generic-list-string-2 "drop-while" drop-while-list drop-while-str))
(define all-list (f l)
(if (null? l) 1
(and (f (car l)) (all-list f (cdr l)))))
(define all-str (f s)
(if (= s "") 1
(and (f (substr 0 1 s)) (all-str f (substr 1 -1 s)))))
(define all (generic-list-string-2 "all" all-list all-str))
(define reverse (l)
(let ((helper (lambdarec rec (l2 rest)
(if (null? l2) rest
(rec (cdr l2) (cons (car l2) rest))))))
(helper l '())))
(define map (f l)
(if (null? l) l
(cons (f (car l)) (map f (cdr l)))))
(define stdin (sys-stdin))
(define stdout (sys-stdout))
(define stderr (sys-stderr))
(define with-open-file (path mode f)
(let ((fid (sys-open-file mode path))
(value (f fid)))
(do (sys-close-file fid) value)))
(define read-until (fid predicate)
((lambdarec rec (s)
(let ((ch (sys-get-char fid)))
(if (predicate ch) s (rec (concat s ch)))))
""))
(define read-until-eof (fid)
(read-until fid null?))
(define read-file (path)
(with-open-file path 0 read-until-eof))
(define read-line (fid)
(read-until fid (lambda (ch) (or (= ch "\n") (null? ch)))))
(define number->string (num)
(let ((helper (lambdarec rec (n yet)
(if (= n 0) yet
(rec (/ n 10) (concat (chr (+ (mod n 10) 48)) yet))))))
(cond
(= num 0)
"0"
(< num 0)
(concat "-" (number->string (- 0 num)))
(helper num ""))))
(define concat-list (l)
(if (null? l) ""
(concat (car l) (concat-list (cdr l)))))
(define intercalate (sep l)
(cond
(null? l)
""
(null? (cdr l))
(car l)
(concat (car l) sep (intercalate sep (cdr l)))))
|
