summaryrefslogtreecommitdiff
path: root/tests/stdlib.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'tests/stdlib.lisp')
-rw-r--r--tests/stdlib.lisp59
1 files changed, 55 insertions, 4 deletions
diff --git a/tests/stdlib.lisp b/tests/stdlib.lisp
index e23364c..4f2fa80 100644
--- a/tests/stdlib.lisp
+++ b/tests/stdlib.lisp
@@ -6,6 +6,11 @@
(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))
@@ -14,22 +19,68 @@
(do (f start) (for (+ start 1) end f))
'()))
-(define take-while (f l)
+(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 f (cdr l)))
+ (cons (car l) (take-while-list f (cdr l)))
'()))
-(define drop-while (f 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 f (cdr 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))