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/lispparser.lisp | 36 +++++++++++++++++++------------
 tests/stdlib.lisp     | 59 +++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 77 insertions(+), 18 deletions(-)

diff --git a/tests/lispparser.lisp b/tests/lispparser.lisp
index 4579b93..1d8c79c 100644
--- a/tests/lispparser.lisp
+++ b/tests/lispparser.lisp
@@ -9,7 +9,7 @@
     (str-elem ch " \n\t\r"))
 
 (define isdigit? (ch)
-    (let ((n (ord ch))) (and (<= 48 n) (<= 57 n))))
+    (let ((n (ord ch))) (and (<= 48 n) (<= n 57))))
 
 (define lowercase? (ch)
     (let ((n (ord ch))) (and (<= 97 n) (<= n 122))))
@@ -18,7 +18,7 @@
     (let ((n (ord ch))) (and (<= 65 n) (<= n 90))))
 
 (define iswordchar? (ch)
-    (or (str-elem ch "-_?")
+    (or (str-elem ch "-_?+/*")
         (or (lowercase? ch) (uppercase? ch))))
 
 (define isrestwordchar? (ch)
@@ -47,15 +47,23 @@
                 (list "(" rest)
             (= ch ")")
                 (list ")" rest)
-            (iswordchar? ch)
-                (let ((restword (take-while isrestwordchar? rest)))
-                    (list (concat ch restword) (substr (length restword) -1 rest)))
-            (isdigit? ch)
-                (let ((word (concat ch (take-while isdigit? rest))))
-                    (list (parse-int word) (substr (length word) -1 str)))
-            (do
-                (print (concat "Invalid token: " ch))
-                (exit)))))
-
-; (define parse-sexpr (tokens)
-;     ...)
+            (or (iswordchar? ch) (isdigit? ch))
+                (let ((restword (take-while isrestwordchar? rest))
+                      (rest2 (substr (length restword) -1 rest)))
+                    (if (and (all isdigit? restword)
+                             (or (isdigit? ch) (and (= ch "-") (> (length restword) 0))))
+                        (list (parse-int (concat ch restword)) rest2)
+                        (list (concat ch restword) rest2)))
+            (error (concat "Invalid token: " ch)))))
+
+(define go (lambdarec rec (str)
+    (let ((pair (next-token str)))
+        (if (null? pair)
+            '()
+            (let ((token (car pair))
+                  (rest (cadr pair)))
+                (do
+                    (print token)
+                    (rec rest)))))))
+
+(go (read-file "tests/closuretest.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