picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

sym.l (7672B)

      1 # 05jul13abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### name ###
      5 (test "abc" (name 'abc))
      6 (test "A123" (name '{A123}))
      7 (let X (box)
      8    (test NIL (name X))
      9    (name X "xxx")
     10    (test "xxx" (name X)) )
     11 
     12 
     13 ### sp? ###
     14 (test T (sp? " ^I^J"))
     15 (test NIL (sp? " abc"))
     16 (test NIL (sp? 123))
     17 
     18 
     19 ### pat? ###
     20 (test `(char '@) (char (pat? '@)))
     21 (test NIL (pat? "ABC"))
     22 (test NIL (pat? 123))
     23 
     24 
     25 ### fun? ###
     26 (test 1000000000 (fun? 1000000000))
     27 (test NIL (fun? 12345678901234567890))
     28 (test '(A B) (fun? '((A B) (* A B))))
     29 (test NIL (fun? '((A B) (* A B) . C)))
     30 (test NIL (fun? (1 2 3 4)))
     31 (test NIL (fun? '((A 2 B) (* A B))))
     32 (test T (fun? '(NIL (* 3 4))))
     33 
     34 
     35 ### all ###
     36 (test '(test)
     37    (filter '((S) (= S "test")) (all)) )
     38 
     39 
     40 ### symbols ###
     41 (when symbols
     42    (test T (bool (pair pico)))
     43    (test 'pico (symbols 'myLib 'pico)) )
     44 
     45 (when symbols
     46    (one Foo)
     47    (test 'myLib (symbols 'pico)) )
     48 
     49 (when symbols
     50    (test 1 myLib~Foo) )
     51 
     52 ### intern ###
     53 (test car (val (intern (pack "c" "a" "r"))))
     54 
     55 
     56 ### extern ###
     57 (test NIL (extern (box)))
     58 (test *DB (extern "1"))
     59 
     60 
     61 ### ==== ###
     62 (setq *Sym "abc")
     63 (test T (== *Sym "abc"))
     64 (====)
     65 (test NIL (== *Sym "abc"))
     66 
     67 
     68 ### box? ###
     69 (let X (box)
     70    (test X (box? X)) )
     71 (test NIL (box? 123))
     72 (test NIL (box? 'a))
     73 (test NIL (box? NIL))
     74 
     75 
     76 ### str? ###
     77 (test NIL (str? 123))
     78 (test NIL (str? '{A123}))
     79 (test NIL (str? 'abc))
     80 (test "abc" (str? "abc"))
     81 
     82 
     83 ### ext? ###
     84 (test *DB (ext? *DB))
     85 (test NIL (ext? 'abc))
     86 (test NIL (ext? "abc"))
     87 (test NIL (ext? 123))
     88 
     89 
     90 ### touch ###
     91 (test *DB (touch *DB))
     92 (rollback)
     93 
     94 
     95 ### zap ###
     96 (test "abc" (str? (zap 'abc)))
     97 
     98 
     99 ### chop ###
    100 (test '("c" "a" "r") (chop 'car))
    101 (test '("H" "e" "l" "l" "o") (chop "Hello"))
    102 (test '("1" "2" "3") (chop 123))
    103 (test (1 2 3) (chop (1 2 3)))
    104 (test NIL (chop NIL))
    105 
    106 
    107 ### pack ###
    108 (test "car is 1 symbol name"
    109    (pack 'car " is " 1 '(" symbol " name)) )
    110 
    111 
    112 ### glue ###
    113 (test 1 (glue NIL 1))
    114 (test "a" (glue NIL '(a)))
    115 (test "ab" (glue NIL '(a b)))
    116 (test "a,b" (glue "," '(a b)))
    117 (test "a8b" (glue 8 '(a b)))
    118 (test "a123b123c" (glue (1 2 3) '(a b c)))
    119 
    120 
    121 ### text ###
    122 (test "abc XYZ def 123" (text "abc @1 def @2" 'XYZ 123))
    123 (test "aXYZz" (text "a@3z" 1 2 '(X Y Z)))
    124 (test "a@bc.de" (text "a@@bc.@1" "de"))
    125 (test "10.11.12" (text "@A.@B.@C" 1 2 3 4 5 6 7 8 9 10 11 12))
    126 
    127 
    128 ### pre? ###
    129 (test "abcdef" (pre? "" "abcdef"))
    130 (test NIL (pre? "abc" ""))
    131 (test "abcdef" (pre? "abc" "abcdef"))
    132 (test NIL (pre? "def" "abcdef"))
    133 (test "abcdef" (pre? "" "abcdef"))
    134 (test "7fach" (pre? (+ 3 4) "7fach"))
    135 
    136 
    137 ### sub? ###
    138 (test "abcdef" (sub? "" "abcdef"))
    139 (test NIL (sub? "abc" ""))
    140 (test "abcdef" (sub? "cde" "abcdef"))
    141 (test "abcdef" (sub? "def" "abcdef"))
    142 (test NIL (sub? "abb" "abcdef"))
    143 (test "abcdef" (sub? "" "abcdef"))
    144 
    145 
    146 ### val ###
    147 (let L '(a b c)
    148    (test '(a b c) (val 'L))
    149    (test 'b (val (cdr L))) )
    150 
    151 
    152 ### set ###
    153 (use L
    154    (test '(a b c) (set 'L '(a b c)))
    155    (test 999 (set (cdr L) '999))
    156    (test '(a 999 c) L) )
    157 
    158 
    159 ### setq ###
    160 (use (A B)
    161    (test (123 123)
    162       (setq  A 123  B (list A A)) )
    163    (test 123 A)
    164    (test (123 123) B) )
    165 
    166 
    167 ### xchg ###
    168 (let (A 1  B 2  C '(a b c))
    169    (test 2 (xchg 'A C  'B (cdr C)))
    170    (test 'a A)
    171    (test 'b B)
    172    (test (1 2 c) C) )
    173 
    174 
    175 ### on off onOff zero one ###
    176 (use (A B)
    177    (test T (on A B))
    178    (test T A)
    179    (test T B)
    180    (test NIL (off A))
    181    (test NIL A)
    182    (test NIL (onOff B))
    183    (test NIL B)
    184    (test T (onOff A B))
    185    (test T A)
    186    (test T B)
    187    (test 0 (zero A B))
    188    (test 0 A)
    189    (test 0 B)
    190    (test 1 (one A B))
    191    (test 1 A)
    192    (test 1 B) )
    193 
    194 
    195 ### default ###
    196 (let (A NIL  B NIL)
    197    (test 2 (default A 1  B 2))
    198    (test A 1)
    199    (test B 2)
    200    (test 2 (default A 7  B 8))
    201    (test A 1)
    202    (test B 2) )
    203 
    204 
    205 ### push push1 pop cut ###
    206 (let L NIL
    207    (test 1 (push 'L 3 2 1))
    208    (test L (1 2 3))
    209    (test 0 (push1 'L 0))
    210    (test 1 (push1 'L 1))
    211    (test L (0 1 2 3))
    212    (test 0 (pop 'L))
    213    (test (1 2) (cut 2 'L))
    214    (test (3) L) )
    215 
    216 
    217 ### del ###
    218 (let (L '((a b c) (d e f))  S (new))
    219    (put S 'lst L)
    220    (test '((a b c)) (del '(d e f) 'L))
    221    (test '(a b c) (del 'x L))
    222    (test '(a c) (del 'b L))
    223    (with S
    224       (test '((a b c)) (del '(d e f) (:: lst)))
    225       (test NIL (del '(a b c) (:: lst)))
    226       (test NIL (: lst)) ) )
    227 
    228 
    229 ### queue ###
    230 (let A NIL
    231    (test 1 (queue 'A 1))
    232    (test 2 (queue 'A 2))
    233    (test 3 (queue 'A 3))
    234    (test (1 2 3) A) )
    235 
    236 
    237 ### fifo ###
    238 (let X NIL
    239    (test 1 (fifo 'X 1))
    240    (test 3 (fifo 'X 2 3))
    241    (test 1 (fifo 'X))
    242    (test 2 (fifo 'X))
    243    (test 3 (fifo 'X)) )
    244 
    245 
    246 ### idx lup ###
    247 (let X NIL
    248    (test NIL (idx 'X 'd T))
    249    (test NIL (idx 'X (2 . f) T))
    250    (test NIL (idx 'X (3 . g) T))
    251    (test NIL (idx 'X '(a b c) T))
    252    (test NIL (idx 'X 17 T))
    253    (test NIL (idx 'X 'A T))
    254    (test '(d . @) (idx 'X 'd T))
    255    (test NIL (idx 'X T T))
    256    (test '(A) (idx 'X 'A))
    257    (test '(17 A d (2 . f) (3 . g) (a b c) T)
    258       (idx 'X) )
    259    (test (2 . f) (lup X 2))
    260    (test '((2 . f) (3 . g)) (lup X 1 4))
    261    (test '(17 . @) (idx 'X 17 NIL))
    262    (test '(A d (2 . f) (3 . g) (a b c) T)
    263       (idx 'X) )
    264    (off X)
    265    (for N '((4 . D) 3 (2 . B) Y (3 . C) Z (6 . F) 7 (7 . G) X (1 . A) T (5 . E) 5)
    266       (idx 'X N T) )
    267    (test '(3 5 7 X Y Z (1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G) T)
    268       (idx 'X) )
    269    (test '((3 . C) (4 . D) (5 . E))
    270       (lup X 3 5) )
    271    (test '((1 . A) (2 . B) (3 . C) (4 . D) (5 . E) (6 . F) (7 . G))
    272          (lup X 0 9) ) )
    273 
    274 
    275 ### put get prop ; =: : :: putl getl ###
    276 (let (A (box)  B (box A)  C (box (cons A B)))
    277    (put B 'a A)
    278    (put C 'b B)
    279    (put A 'x 1)
    280    (put B 'a 'y 2)
    281    (put C 0 -1 'a 'z 3)
    282    (test '(NIL . p) (prop 'A 'p))
    283    (test 1 (get A 'x))
    284    (test 1 (; A x))
    285    (test 2 (with A (: y)))
    286    (test 2 (get A 'y))
    287    (test 2 (; A y))
    288    (test 2 (with B (: 0 y)))
    289    (test 2 (get B 0 'y))
    290    (test 2 (; B 0 y))
    291    (test 3 (with C (: b a z)))
    292    (test 3 (with C (: 0 1 z)))
    293    (test 3 (with C (: 0 -1 a z)))
    294    (test 3 (get C 0 1 'z))
    295    (test 3 (get C 0 -1 'a 'z))
    296    (test 3 (; C 0 -1 a z))
    297    (test 1 (push (prop 'A 'p) 1))
    298    (test 1 (with 'A (pop (:: p))))
    299    (test NIL (get 'A 'p))
    300    (test (3 . z) (prop C 0 -1 'a 'z))
    301    (test 9 (with C (=: 0 -1 a z (* 3 3))))
    302    (test (9 . z) (with C (:: 0 -1 a z)))
    303    (test (putl C 0 -1 'a '((1 . x) (2 . y))) (flip (getl C 'b 0))) )
    304 
    305 (test NIL (get (1 2 3) 0))
    306 (test 1 (get (1 2 3) 1))
    307 (test 3 (get (1 2 3) 3))
    308 (test NIL (get (1 2 3) 4))
    309 (test (3) (get (1 2 3) -2))
    310 (test 1 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'a 'b))
    311 (test 4 (get '((a (b . 1) (c . 2)) (d (e . 3) (f . 4))) 'd 'f))
    312 
    313 
    314 ### wipe ###
    315 (let X (box (1 2 3 4))
    316    (put X 'a 1)
    317    (put X 'b 2)
    318    (test (1 2 3 4) (val X))
    319    (test '((2 . b) (1 . a)) (getl X))
    320    (wipe X)
    321    (test NIL (val X))
    322    (test NIL (getl X)) )
    323 
    324 (setq "W" (1 2 3 4))
    325 (put '"W" 'a 1)
    326 (put '"W" 'b 2)
    327 (test (1 2 3 4) "W")
    328 (test '((2 . b) (1 . a)) (getl '"W"))
    329 (wipe '"W")
    330 (test NIL "W")
    331 (test NIL (getl '"W"))
    332 
    333 (set *DB (1 2 3 4))
    334 (put *DB 'a 1)
    335 (put *DB 'b 2)
    336 (test (1 2 3 4) (val *DB))
    337 (test '((2 . b) (1 . a)) (getl *DB))
    338 (wipe *DB)
    339 (test (1 2 3 4) (val *DB))
    340 (test '((2 . b) (1 . a)) (getl *DB))
    341 (rollback)
    342 (test NIL "W")
    343 (test NIL (getl '"W"))
    344 
    345 
    346 ### meta ###
    347 (let A '("B")
    348    (put '"B" 'a 123)
    349    (test 123 (meta 'A 'a)) )
    350 
    351 
    352 ### low? ###
    353 (test "a" (low? "a"))
    354 (test NIL (low? "A"))
    355 (test NIL (low? 123))
    356 (test NIL (low? "."))
    357 
    358 
    359 ### upp? ###
    360 (test "A" (upp? "A"))
    361 (test NIL (upp? "a"))
    362 (test NIL (upp? 123))
    363 (test NIL (upp? "."))
    364 
    365 
    366 ### lowc ###
    367 (test "abc" (lowc "ABC"))
    368 (test "äöü" (lowc "ÄÖÜ"))
    369 (test "äöü" (lowc "äöü"))
    370 (test 123 (lowc 123))
    371 
    372 
    373 ### uppc ###
    374 (test "ABC" (uppc "abc"))
    375 (test "ÄÖÜ" (uppc "äöü"))
    376 (test "ÄÖÜ" (uppc "ÄÖÜ"))
    377 (test 123 (lowc 123))
    378 
    379 
    380 ### fold ###
    381 (test "1a2b3" (fold " 1A 2-b/3"))
    382 (test "1a2" (fold " 1A 2-B/3" 3))
    383 
    384 # vi:et:ts=3:sw=3