blob: 4f2fa8008c762f84417c4369fdfdd4230c01bcce (
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
|
(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 != (x y) (not (= x y)))
(define < (x y) (and (<= x y) (!= x y)))
(define > (x y) (< y x))
(define >= (x y) (<= y 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 "<" (concat s ">")))
(define take-while-str (f s)
(cond
(= s "")
(do
; (print "take-while-str" (bracket s) "->" (bracket s))
s)
(f (substr 0 1 s))
(let ((res (concat (substr 0 1 s) (take-while-str f (substr 1 -1 s)))))
(do
; (print "take-while-str" (bracket s) " ->" (bracket res))
res))
""))
(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 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)))))
|
