picolisp

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

flow.l (8118B)

      1 # 31jul13abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### quote ###
      5 (test (1 2 3) (quote 1 2 3))
      6 
      7 
      8 ### as ###
      9 (test NIL (as (= 3 4) A B C))
     10 (test '(A B C) (as (= 3 3) A B C))
     11 
     12 
     13 ### lit ###
     14 (test 123 (lit 123))
     15 (test NIL (lit NIL))
     16 (test T (lit T))
     17 (test (1) (lit '(1)))
     18 (test ''"abc" (lit "abc"))
     19 (test ''a (lit 'a))
     20 (test (1 2 3) (lit '(1 2 3)))
     21 (test ''(a b c) (lit '(a b c)))
     22 
     23 
     24 ### eval ###
     25 (test 6 (eval (list '+ 1 2 3)))
     26 (let (X 'Y  Y 7)
     27    (test 7 (eval X)) )
     28 (let N 1
     29    ((quote (N)
     30          ((quote (N)
     31                (test 3 N)
     32                (test 2 (eval 'N 1))
     33                (test 2 (eval 'N 1 '(X)))
     34                (test 3 (eval 'N 1 '(N)))
     35                (test 1 (eval 'N 2))
     36                (test 3 (eval 'N 2 '(N))) )
     37             3 ) )
     38       2 ) )
     39 
     40 
     41 ### run ###
     42 (test 6 (run (list (list '+ 1 2 3))))
     43 (test 2
     44    (let N 1
     45       ((quote (N) (run '((+ N N)) 1)) 2) ) )
     46 
     47 
     48 ### def ###
     49 (test '"a"
     50    (def '"a" '((X Y) (* X (+ X Y)))) )
     51 (test '((X Y) (* X (+ X Y)))
     52    "a" )
     53 
     54 
     55 ### de ###
     56 (test '"b"
     57    (de "b" (X Y) (* X (+ X Y))) )
     58 (test '((X Y) (* X (+ X Y)))
     59    "b" )
     60 
     61 
     62 ### dm ###
     63 (off "+Cls" "+A")
     64 (class "+Cls" "+A")
     65 
     66 (test '"foo>"
     67    (dm "foo>" (X Y)
     68       (* X (+ X Y)) ) )
     69 (test '"foo>"
     70    (dm ("foo>" . "+Cls") (X Y)
     71       (* X (+ X Y)) ) )
     72 (test '(("foo>" (X Y) (* X (+ X Y))) "+A")
     73    "+Cls" )
     74 
     75 
     76 ### box ###
     77 (let X (box '(A B C))
     78    (test X (box? X))
     79    (test '(A B C) (val X)) )
     80 
     81 
     82 ### new type isa method meth send try ###
     83 (let X (new '("+Cls"))
     84    (test X (box? X))
     85    (test 21 ("foo>" X 3 4))
     86    (test '("+Cls") (type X))
     87    (test X (isa '"+Cls" X))
     88    (test NIL (isa '(A B C) X))
     89    (test '((X Y) (* X (+ X Y)))
     90       (method '"foo>" X) )
     91    (test meth "foo>")
     92    (test 21 (send '"foo>" X 3 4))
     93    (test NIL (try '"bar>" X))
     94    (test 21 (try '"foo>" X 3 4)) )
     95 
     96 
     97 ### super ###
     98 (off "+Sub")
     99 (class "+Sub" "+Cls")
    100 
    101 (dm ("foo>" . "+Sub") (X Y)
    102    (super X Y) )
    103 (let X (new '("+Sub"))
    104    (test 21 ("foo>" X 3 4)) )
    105 
    106 
    107 ### super ###
    108 (off "+Pref")
    109 (class "+Pref")
    110 
    111 (dm ("foo>" . "+Pref") (X Y)
    112    (extra X Y) )
    113 (let X (new '("+Pref" "+Sub"))
    114    (test 21 ("foo>" X 3 4)) )
    115 
    116 
    117 ### with ###
    118 (let X (box)
    119    (put X 'a 1)
    120    (put X 'b 2)
    121    (test (1 2)
    122       (with X (list (: a) (: b))) ) )
    123 
    124 
    125 ### bind ###
    126 (let X 123
    127    (test "Hello"
    128       (bind 'X
    129          (setq X "Hello")
    130          X ) )
    131    (test (3 4 12)
    132       (bind '((X . 3) (Y . 4))
    133          (list X Y (* X Y)) ) ) )
    134 
    135 
    136 ### job ###
    137 (off "tst")
    138 
    139 (de "tst" ()
    140    (job '((A . 0) (B . 0))
    141       (cons (inc 'A) (inc 'B 2)) ) )
    142 
    143 (test (1 . 2) ("tst"))
    144 (test (2 . 4) ("tst"))
    145 (test (3 . 6) ("tst"))
    146 
    147 
    148 ### let let? use ###
    149 (let N 1
    150    (test NIL (let? N NIL N))
    151    (test 7 (let? N 7 N))
    152    (use N
    153       (setq N 2)
    154       (let N 3
    155          (test 3 N) )
    156       (test 2 N) )
    157    (test 1 N) )
    158 (let N 1
    159    (use (N)
    160       (setq N 2)
    161       (let (N 3)
    162          (test 3 N) )
    163       (test 2 N) )
    164    (test 1 N) )
    165 
    166 
    167 ### and ###
    168 (test 7 (and T 123 7))
    169 (test NIL (and NIL 123))
    170 
    171 
    172 ### or ###
    173 (test NIL (or NIL))
    174 (test 7 (or NIL 7 123))
    175 
    176 
    177 ### nand ###
    178 (test NIL (nand T 123 7))
    179 (test T (nand NIL 123))
    180 
    181 
    182 ### nor ###
    183 (test T (nor NIL))
    184 (test NIL (nor NIL 7 123))
    185 
    186 
    187 ### xor ###
    188 (test T (xor T NIL))
    189 (test T (xor NIL T))
    190 (test NIL (xor NIL NIL))
    191 (test NIL (xor T T))
    192 
    193 
    194 ### bool ###
    195 (test T (bool 'a))
    196 (test T (bool 123))
    197 (test NIL (bool NIL))
    198 
    199 
    200 ### not ###
    201 (test T (not NIL))
    202 (test NIL (not T))
    203 (test NIL (not 'a))
    204 
    205 
    206 ### nil ###
    207 (test NIL (nil (+ 1 2 3)))
    208 
    209 
    210 ### t ###
    211 (test T (t (+ 1 2 3)))
    212 
    213 
    214 ### prog ###
    215 (let N 7
    216    (test 3
    217       (prog (dec 'N) (dec 'N) (dec 'N) (dec 'N) N) ) )
    218 
    219 
    220 ### prog1 prog2 ###
    221 (test 1 (prog1 1 2 3))
    222 (test 2 (prog2 1 2 3))
    223 
    224 
    225 ### if ###
    226 (test 1 (if (= 3 3) 1 2))
    227 (test 2 (if (= 3 4) 1 2))
    228 
    229 
    230 ### if2 ###
    231 (test 'both
    232    (if2 T T 'both 'first 'second 'none) )
    233 (test 'first
    234    (if2 T NIL 'both 'first 'second 'none) )
    235 (test 'second
    236    (if2 NIL T 'both 'first 'second 'none) )
    237 (test 'none
    238    (if2 NIL NIL 'both 'first 'second 'none) )
    239 (test 4 (if2 3 4 @))
    240 (test 7 (and 7 (if2 @ @ @)))
    241 (test 7 (and 7 (if2 @ NIL 1 @)))
    242 (test 7 (and 7 (if2 NIL @ 1 2 @)))
    243 
    244 
    245 ### ifn ###
    246 (test 2 (ifn (= 3 3) 1 2))
    247 (test 1 (ifn (= 3 4) 1 2))
    248 
    249 
    250 ### when ###
    251 (test 7 (when (= 3 3) 7))
    252 (test NIL (when (= 3 4) 7))
    253 
    254 
    255 ### unless ###
    256 (test NIL (unless (= 3 3) 7))
    257 (test 7 (unless (= 3 4) 7))
    258 
    259 
    260 ### cond ###
    261 (test 1 (cond ((= 3 3) 1) (T 2)))
    262 (test 2 (cond ((= 3 4) 1) (T 2)))
    263 
    264 
    265 ### nond ###
    266 (test 2 (nond ((= 3 3) 1) (NIL 2)))
    267 (test 1 (nond ((= 3 4) 1) (NIL 2)))
    268 (test (1 . a)
    269    (nond ((num? 'a) (cons 1 'a)) (NIL (cons 2 @))) )
    270 (test (2 . 7)
    271    (nond ((num? 7) (cons 1 7)) (NIL (cons 2 @))) )
    272 
    273 
    274 ### case ###
    275 (test 1 (case 'a (a 1) ((b c) 2) (T 3)))
    276 (test 2 (case 'b (a 1) ((b c) 2) (T 3)))
    277 (test 2 (case '"b" (a 1) ((b c) 2) (T 3)))
    278 (test 2 (case 'c (a 1) ((b c) 2) (T 3)))
    279 (test 2 (case "c" (a 1) ((b c) 2) (T 3)))
    280 (test 3 (case 'd (a 1) ((b c) 2) (T 3)))
    281 
    282 (test 3 (casq 'a ("a" 1) (("b" "c") 2) (T 3)))
    283 (test 3 (casq 'b ("a" 1) (("b" "c") 2) (T 3)))
    284 (test 2 (casq '"b" ("a" 1) (("b" "c") 2) (T 3)))
    285 (test 2 (casq '"c" ("a" 1) (("b" "c") 2) (T 3)))
    286 (test 3 (casq 'b (a 1) ("b" 2) ((a b c) 3) (c 4)))
    287 
    288 
    289 ### state ###
    290 (off "tst")
    291 
    292 (de "tst" ()
    293    (job '((Cnt . 4))
    294       (state '(start)
    295          (start 'run
    296             (link 'start) )
    297          (run (and (gt0 (dec 'Cnt)) 'run)
    298             (link 'run) )
    299          (run 'stop
    300             (link 'run) )
    301          (stop 'start
    302             (setq Cnt 4)
    303             (link 'stop) ) ) ) )
    304 
    305 (test '(start run run run run stop  start run run run run stop)
    306    (make (do 12 ("tst"))) )
    307 (test '(start run run)
    308    (make (do 3 ("tst"))) )
    309 
    310 
    311 ### while ###
    312 (test (1 2 3 4 5 6 7)
    313    (make
    314       (let N 0
    315          (while (>= 7 (inc 'N))
    316             (link N) ) ) ) )
    317 
    318 
    319 ### until ###
    320 (test (1 2 3 4 5 6 7)
    321    (make
    322       (let N 0
    323          (until (> (inc 'N) 7)
    324             (link N) ) ) ) )
    325 
    326 
    327 ### loop ###
    328 (test (1 2 3 4 5 6 7)
    329    (make
    330       (let N 1
    331          (loop
    332             (link N)
    333             (T (> (inc 'N) 7)) ) ) ) )
    334 (test (1 2 3 4 5 6 7)
    335    (make
    336       (let N 1
    337          (loop
    338             (link N)
    339             (NIL (>= 7 (inc 'N))) ) ) ) )
    340 
    341 (test
    342    '(a . 3)
    343    (loop (T NIL (cons @ 1)) (NIL 'a (cons @ 2)) (NIL NIL (cons @ 3))) )
    344 
    345 
    346 ### do ###
    347 (test (1 2 3 4 5 6 7)
    348    (make
    349       (let N 0
    350          (do 7
    351             (link (inc 'N)) ) ) ) )
    352 (test (1 2 3 4 5 6 7)
    353    (make
    354       (let N 1
    355          (do T
    356             (link N)
    357             (T (> (inc 'N) 7)) ) ) ) )
    358 
    359 
    360 ### at ###
    361 (test (1 2 3 - 4 5 6 - 7 8 9 -)
    362    (make
    363       (let N 0
    364          (do 9
    365             (link (inc 'N))
    366             (at (0 . 3) (link '-)) ) ) ) )
    367 
    368 
    369 ### for ###
    370 (test (1 2 3 4 5 6 7)
    371    (make
    372       (for N (1 2 3 4 5 6 7)
    373          (link N) ) ) )
    374 (test (1 2 3 4 5 6 7)
    375    (make
    376       (for (N . X) '(a b c d e f g)
    377          (link N) ) ) )
    378 (test (1 2 3 4 5 6 7)
    379    (make
    380       (for N 7
    381          (link N) ) ) )
    382 (test (1 2 3 4 5 6 7)
    383    (make
    384       (for (N 1 (>= 7 N) (inc N))
    385          (link N) ) ) )
    386 (test (1 2 3 4 5 6 7)
    387    (make
    388       (for ((N . X) 7 (gt0 X) (dec X))
    389          (link N) ) ) )
    390 (test (1 2 3 4 5 6 7)
    391    (make
    392       (for (N 1 T)
    393          (link N)
    394          (T (> (inc 'N) 7)) ) ) )
    395 
    396 
    397 ### catch throw ###
    398 (test NIL (catch NIL (throw)))
    399 (test 'b (catch 'a (throw 'a 'b)))
    400 (test 123 (catch T (throw 'a 123)))
    401 (test "Undefined"
    402    (catch '("Undefined") (mist)) )
    403 (test "No such file"
    404    (catch '("No such file")
    405       (in "doesntExist" (foo)) ) )
    406 (test 6
    407    (casq
    408       (catch '("No such file" "Undefined" "expected")
    409          (+ 1 2 3) )
    410       ("No such file" (shouldNotComeHere))
    411       ("Undefined" (shouldNotComeHere))
    412       ("expected" (shouldNotComeHere))
    413       (T @) ) )
    414 
    415 
    416 ### finally ###
    417 (test 'B
    418    (let X 'A
    419       (catch NIL
    420          (finally (setq X 'B)
    421             (setq X 'C)
    422             (throw)
    423             (setq X 'D) ) )
    424       X ) )
    425 
    426 
    427 ### co yield ###
    428 (when co
    429    (test (1 2 3 (1 2 3))
    430       (make
    431          (do 4
    432             (link
    433                (co "co123"
    434                   (make
    435                      (yield (link 1))
    436                      (yield (link 2))
    437                      (yield (link 3)) ) ) ) ) ) ) )
    438 
    439 
    440 ### call ###
    441 (test T (call 'test "-d" (path "@test")))
    442 (test NIL (call 'test "-f" (path "@test")))
    443 
    444 
    445 ### kill ###
    446 (test T (kill *Pid 0))
    447 
    448 # vi:et:ts=3:sw=3