PicoLisp on PicoLisp on LLVM-IR
# 04jun23 Software Lab. Alexander Burger

### name ###
(test "abc" (name 'abc))
(test "A123" (name '{A123}))
(let X (box)
   (test NIL (name X)) )


### sp? ###
(test T (sp? " \t\n"))
(test NIL (sp? " abc"))
(test NIL (sp? 123))


### pat? ###
(test `(char '@) (char (pat? '@)))
(test NIL (pat? "ABC"))
(test NIL (pat? 123))


### fun? ###
(test 1000000000 (fun? 1000000000))
(test NIL (fun? 12345678901234567890))
(test '(A B) (fun? '((A B) (* A B))))
(test NIL (fun? '((A B) (* A B) . C)))
(test NIL (fun? (1 2 3 4)))
(test NIL (fun? '((A 2 B) (* A B))))
(test T (fun? '(NIL (* 3 4))))


### getd ###
(test car (getd 'car))
(test '((File . @) (load File))
   (getd 'script) )
(test NIL (getd 1))


### all ###
(test '(test)
   (filter '((S) (= S "test")) (all)) )


### symbols nsp ###
(when symbols
   (test T (bool (pair pico)))
   (test '(pico) (symbols 'myLib 'pico)) )

(when symbols
   (one Foo)
   (test 'pico (nsp 'symbols))
   (test 'myLib (nsp 'Foo))
   (test '(myLib pico) (symbols 'pico)) )

(when symbols
   (test 1 myLib~Foo)
   (test NIL (nsp 'myLib~Foo)) )

### intern ###
(test car (val (intern (pack "c" "a" "r"))))
(test car (val (intern '("c" "a" "r"))))


### ==== ###
(setq *Sym "abc")
(test T (== *Sym "abc"))
(====)
(test NIL (== *Sym "abc"))


### box? ###
(let X (box)
   (test X (box? X)) )
(test NIL (box? 123))
(test NIL (box? 'a))
(test NIL (box? NIL))


### str? ###
(test NIL (str? 123))
(test NIL (str? '{A123}))
(test NIL (str? 'abc))
(test "abc" (str? "abc"))


### zap ###
(test "abc" (str? (zap 'abc)))


### chop ###
(test '("c" "a" "r") (chop 'car))
(test '("H" "e" "l" "l" "o") (chop "Hello"))
(test '("1" "2" "3") (chop 123))
(test (1 2 3) (chop (1 2 3)))
(test NIL (chop NIL))


### pack ###
(test "car is 1 symbol name"
   (pack 'car " is " 1 '(" symbol " name)) )


### glue ###
(test 1 (glue NIL 1))
(test "a" (glue NIL '(a)))
(test "ab" (glue NIL '(a b)))
(test "a,b" (glue "," '(a b)))
(test "a8b" (glue 8 '(a b)))
(test "a123b123c" (glue (1 2 3) '(a b c)))


### text ###
(test "abc XYZ def 123" (text "abc @1 def @2" 'XYZ 123))
(test "aXYZz" (text "a@3z" 1 2 '(X Y Z)))
(test "a@bc.de" (text "a@@bc.@1" "de"))
(test "10.11.12" (text "@A.@B.@C" 1 2 3 4 5 6 7 8 9 10 11 12))
(test "1 2 3 4 5 6 7 8 9 10 11 12"
   (text "@1 @2 @3 @4 @5 @6 @7 @8 @9 @A @B @C" 1 2 3 4 5 6 7 8 9 10 11 12) )


### pre? ###
(test "abcdefg" (pre? "" "abcdefg"))
(test NIL (pre? "abc" ""))
(test "abcdefg" (pre? "abc" "abcdefg"))
(test NIL (pre? "def" "abcdefg"))
(test "abcdefg" (pre? "" "abcdefg"))
(test "7fach" (pre? (+ 3 4) "7fach"))


### sub? ###
(test "abcdefg" (sub? "" "abcdefg"))
(test NIL (sub? "abc" ""))
(test "abcdefg" (sub? "cde" "abcdefg"))
(test "abcdefg" (sub? "def" "abcdefg"))
(test NIL (sub? "abb" "abcdefg"))
(test "abcdefg" (sub? "" "abcdefg"))


### val ###
(let L '(a b c)
   (test '(a b c) (val 'L))
   (test 'b (val (cdr L))) )


### set ###
(use L
   (test '(a b c) (set 'L '(a b c)))
   (test 999 (set (cdr L) 999))
   (test '(a 999 c) L) )


### setq ###
(use (A B)
   (test (123 123)
      (setq  A 123  B (list A A)) )
   (test 123 A)
   (test (123 123) B) )


### swap ###
(let (A 1  L (1 2 3))
   (test 1 (swap 'A 7))
   (test 7 (swap 'A 'xyz))
   (test 3 (swap (cddr L) A))
   (test (1 2 xyz) L) )


### xchg ###
(let (A 1  B 2  C '(a b c))
   (test 2 (xchg 'A C  'B (cdr C)))
   (test 'a A)
   (test 'b B)
   (test (1 2 c) C) )


### on off onOff zero one ###
(use (A B)
   (test T (on A B))
   (test T A)
   (test T B)
   (test NIL (off A))
   (test NIL A)
   (test NIL (onOff B))
   (test NIL B)
   (test T (onOff A B))
   (test T A)
   (test T B)
   (test 0 (zero A B))
   (test 0 A)
   (test 0 B)
   (test 1 (one A B))
   (test 1 A)
   (test 1 B) )


### default ###
(let (A NIL  B NIL)
   (test 2 (default A 1  B 2))
   (test A 1)
   (test B 2)
   (test 2 (default A 7  B 8))
   (test A 1)
   (test B 2) )


### push push1 pop ++ shift cut ###
(let L NIL
   (test 0 (push 'L 4 3 2 1 0))
   (test L (0 1 2 3 4))
   (test (1 2 3 4) (shift 'L))
   (test 0 (push1 'L 0))
   (test 1 (push1 'L 1))
   (test L (0 1 2 3 4))
   (test 0 (pop 'L))
   (test 1 (++ L))
   (test (2 3) (cut 2 'L))
   (test (4) L) )

### push1q ###
(let L NIL
   (test (2) (push1q 'L 'a (1) 'b (2)))
   (test (1) (push1q 'L 'b (1)))
   (test '((1) (2) b (1) a) L) )

### del ###
(let (L '((a b c) (d e f))  S (new))
   (put S 'lst L)
   (test '((a b c)) (del '(d e f) 'L))
   (test '(a b c) (del 'x L))
   (test '(a c) (del 'b L))
   (with S
      (test '((a b c)) (del '(d e f) (:: lst)))
      (test NIL (del '(a b c) (:: lst)))
      (test NIL (: lst)) ) )
(let L (1 1 2 3 1 2 3)
   (test (2 3 2 3) (del 1 'L T)) )


### queue ###
(let A NIL
   (test 1 (queue 'A 1))
   (test 2 (queue 'A 2))
   (test 3 (queue 'A 3))
   (test (1 2 3) A) )


### fifo ###
(let X NIL
   (test 1 (fifo 'X 1))
   (test 3 (fifo 'X 2 3))
   (test 1 (fifo 'X))
   (test 2 (fifo 'X))
   (test 3 (fifo 'X)) )


### rid ###
(let E (1 . 2)
   (test 2 (rid 'E 1)) )
(let E (1 2 3 2 4 . 2)
   (test (1 3 4) (rid 'E 2))
   (test (3 4) (rid 'E 1))
   (test (3) (rid 'E 4))
   (test (3) (rid 'E 7))
   (test NIL (rid 'E 3)) )
(let E NIL
   (fifo 'E 1 2 3 2 4 2)
   (test (2 1 2 3 2 4 . @Z) E)
   (test (4 1 3 . @Z) (rid 'E 2)) )


### idx lup ###
(let X NIL
   (test NIL (idx 'X 'd T))
   (test NIL (idx 'X (2 . f) T))
   (test NIL (idx 'X (3 . g) T))
   (test NIL (idx 'X '(a b c) T))
   (test NIL (idx 'X 17 T))
   (test NIL (idx 'X 'A T))
   (test '(d . @) (idx 'X 'd T))
   (test NIL (idx 'X T T))
   (test '(A) (idx 'X 'A))
   (test '(17 A d (2 . f) (3 . g) (a b c) T)
      (idx 'X) )
   (test (2 . f) (lup X 2))
   (test '((2 . f) (3 . g)) (lup X 1 4))
   (test '(17 . @) (idx 'X 17 NIL))
   (test '(A d (2 . f) (3 . g) (a b c) T)
      (idx 'X) )
   (off X)
   (for N '((4 . D) 3 (2 . B) Y (3 . C) Z (6 . F) 7 (7 . G) X (1 . A) T (5 . E) 5)
      (idx 'X N T) )
   (test '(3 5 7 X Y Z (1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G) T)
      (idx 'X) )
   (test '((3 . C) (4 . D) (5 . E))
      (lup X 3 5) )
   (test '((1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G))
         (lup X 0 9) ) )


### enum enum? ###
(let E NIL
   (for (I . S) '(a b c d e f g h i j k l m n o)
      (set (enum 'E I) S) )
   (test '(a (b (d (h) l) f (j) n) c (e (i) m) g (k) o)
      E )
   (test '(a b c d e f g h i j k l m n o)
      (make (for I 15 (link (val (enum 'E I))))) )
   (test NIL
      (enum 'E 0) )
   (test '((8 . h) (4 . d) (12 . l) (2 . b) (10 . j) (6 . f) (14 . n) (1 . a) (9 . i) (5 . e) (13 . m) (3 . c) (11 . k) (7 . g) (15 . o))
      (enum 'E) )
   (test '(g . @) (enum? E 7))
   (test NIL (enum? E 16)) )

(let G NIL
   (for I 4
      (for J 4
         (set (enum 'G I J) (* I J)) ) )
   (test (1 . @) (enum? G 1 1))
   (test (6 . @) (enum? G 2 3))
   (test (12 . @) (enum? G 3 4))
   (test NIL (enum? G 5))
   (test NIL (enum? G 1 5)) )

### put get prop ; =: : :: putl getl ###
(let (A (box)  B (box A)  C (box (cons A B)))
   (put B 'a A)
   (put C 'b B)
   (put A 'x 1)
   (put B 'a 'y 2)
   (put C 0 -1 'a 'z 3)
   (test '(NIL . p) (prop 'A 'p))
   (test 1 (get A 'x))
   (test 1 (; A x))
   (test 2 (with A (: y)))
   (test 2 (get A 'y))
   (test 2 (; A y))
   (test 2 (with B (: 0 y)))
   (test 2 (get B 0 'y))
   (test 2 (; B 0 y))
   (test 3 (with C (: b a z)))
   (test 3 (with C (: 0 1 z)))
   (test 3 (with C (: 0 -1 a z)))
   (test 3 (get C 0 1 'z))
   (test 3 (get C 0 -1 'a 'z))
   (test 3 (; C 0 -1 a z))
   (test 1 (push (prop 'A 'p) 1))
   (test 1 (with 'A (pop (:: p))))
   (test NIL (get 'A 'p))
   (test (3 . z) (prop C 0 -1 'a 'z))
   (test 9 (with C (=: 0 -1 a z (* 3 3))))
   (test (9 . z) (with C (:: 0 -1 a z)))
   (test (putl C 0 -1 'a '((1 . x) (2 . y))) (flip (getl C 'b 0))) )

(test NIL (get (1 2 3) 0))
(test 1 (get (1 2 3) 1))
(test 3 (get (1 2 3) 3))
(test NIL (get (1 2 3) 4))
(test (3) (get (1 2 3) -2))
(test 1 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'a 'b))
(test 4 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'd 'f))


### wipe ###
(let X (box (1 2 3 4))
   (put X 'a 1)
   (put X 'b 2)
   (test (1 2 3 4) (val X))
   (test '((2 . b) (1 . a)) (getl X))
   (wipe X)
   (test NIL (val X))
   (test NIL (getl X)) )

(setq "W" (1 2 3 4))
(put '"W" 'a 1)
(put '"W" 'b 2)
(test (1 2 3 4) "W")
(test '((2 . b) (1 . a)) (getl '"W"))
(wipe '"W")
(test NIL "W")
(test NIL (getl '"W"))


### meta ###
(let A '("B")
   (put '"B" 'a 123)
   (test 123 (meta 'A 'a)) )


### low? ###
(test "a" (low? "a"))
(test NIL (low? "A"))
(test NIL (low? 123))
(test NIL (low? "."))


### upp? ###
(test "A" (upp? "A"))
(test NIL (upp? "a"))
(test NIL (upp? 123))
(test NIL (upp? "."))


### lowc ###
(test "abc" (lowc "ABC"))
(test "äöü" (lowc "ÄÖÜ"))
(test "äöü" (lowc "äöü"))
(test 123 (lowc 123))


### uppc ###
(test "ABC" (uppc "abc"))
(test "ÄÖÜ" (uppc "äöü"))
(test "ÄÖÜ" (uppc "ÄÖÜ"))
(test 123 (lowc 123))


### fold ###
(test "1a2b3" (fold " 1A 2-b/3"))
(test "1a2" (fold " 1A 2-B/3" 3))