picolisp

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

setf.l (819B)

      1 # 31jan08abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # 'setf' is the most perverse concept ever introduced into Lisp
      5 (de setf "Args"
      6    (let "P" (car "Args")
      7       (set
      8          (if (atom "P")
      9             "P"
     10             (let (: ::  get prop  car prog  cadr cdr  caddr cadr  cadddr caddr)
     11                (eval "P") ) )
     12          (eval (cadr "Args")) ) ) )
     13 
     14 ### Test ###
     15 (test 7
     16    (use A
     17       (setf A 7)
     18       A ) )
     19 
     20 (test (7 2 3)
     21    (let L (1 2 3)
     22       (setf (car L) 7)
     23       L ) )
     24 
     25 (test (1 7 3)
     26    (let L (1 2 3)
     27       (setf (cadr L) 7)
     28       L ) )
     29 
     30 (test 7
     31    (put 'A 'a 1)
     32    (setf (get 'A 'a) 7)
     33    (get 'A 'a) )
     34 
     35 (test 7
     36    (put 'A 'a 1)
     37    (with 'A
     38       (setf (: a) 7)
     39       (: a) ) )
     40 
     41 # But also:
     42 (undef 'foo)
     43 (de foo (X)
     44    (cadr X) )
     45 
     46 (test (1 7 3)
     47    (let L (1 2 3) (setf (foo L) 7) L) )
     48 
     49 # vi:et:ts=3:sw=3