From 38d9da4cac2b207ca6c655dad353768eb73771ef Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 22 Nov 2019 19:54:24 +0100
Subject: lispparser: working tokeniser

---
 tests/stdlib.lisp | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 55 insertions(+), 4 deletions(-)

(limited to 'tests/stdlib.lisp')

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))
-- 
cgit v1.2.3-54-g00ecf