Assignment Macro Beast Unleashed.

;===============================================================
;
; C has a lot of handy assignment operators like += and *=.
; Someone might want them in Newlisp - in fact, I've seen some
; already asked for them on Newlisp forum. This article
; is about such operators. Just like usually, you can simply cut
; and past and run the whole code, with comments.

; We have a luck. Equivalent macros can be easily defined in Newlisp.

(set 'setq+ (lambda-macro()
              (set (first (args))
                   (apply + (map eval (args))))))

; TEST:

(setq x 4)
(setq+ x (* 5 5))
(println "Value of x should be 29 and it is actually " x ".")

;===============================================================
;
; Of course, setq+ is only one of many potentially useful similar
; assignement. That justifies the writing of the higher order
; function that accept name of the function (say +) and returns
; appropriate "assignement macro (like set+).

; I'll use "expand" function I learnt these days. With expand,
; I can easily use definition of setq+ in more general form.
; "Expand" can significantly simplify writing of macros.

(set 'hsetq
     (lambda-macro()
           (let ((operator (first (args))))
                (expand '(lambda-macro()
                            (set (first (args))
                                 (apply operator
                                        (map eval (args)))))
                        'operator))))

; TEST:

(set 'setq* (hsetq '*))
(setq* x (+ 1 1))
(println "Value of x should be 58 and it is actually " x ".")

;===============================================================

; If we agree that names setq+, setq* ... etc are acceptable
; for all of our assignment macros, we can improve hsetq so it
; does not only define new assignment macro, but also gives the
; appropriate name to the assignement macro.

(set 'hsetq
     (lambda()
        (letn ((old-operator (first (args)))
               (new-operator (sym (append "setq"
                                               (string old-operator))))
               (new-operator-definition
                   (expand '(lambda-macro()
                               (set (first (args))
                                    (apply old-operator
                                            (map eval (args)))))
                                'old-operator)))
              (set new-operator new-operator-definition))))

; TEST:

(set 'x 20)
(hsetq '/)
(setq/ x 5)

(println "Value of x should be 4 and it is actually " x ".")

;===============================================================
;
; In Newlisp tradition, it seems that set is more popular than
; setq. So, let us improve our hsetq to define both versions,
; for example, setq+ and set+

(set 'hset
     (lambda()
        (letn ((old-operator (first (args)))
               (new-operator (sym (append "setq"
                                                (string old-operator))))
               (new-operator2 (sym (append "set"
                                                (string old-operator))))
               (new-operator-definition
                   (expand '(lambda-macro()
                               (set (first (args))
                                    (apply old-operator
                                           (map eval (args)))))
                                'old-operator))
               (new-operator-definition2
                   (expand '(lambda-macro()
                                (set (eval (first (args)))
                                     (apply old-operator
                                           (map eval
                                               (cons (eval (first (args)))
                                                     (rest (args)))))))
                            'old-operator)))
              (set new-operator new-operator-definition)
              (set new-operator2 new-operator-definition2))))

(set 'x 10)
(hset '-)
(setq- x 5)
(println "Value of x should be 5 and it is actually " x ".")
(set- (sym "x") 3)
(println "Value of x should be 2 and it is actually " x ".")

;===============================================================
;
; And now, we'll define whole buch of new assignment macros.  
;

(println "\nWatch out!")
(sleep 1000)
(println "\nThe beast will be unleashed in few moments!\n")
(sleep 3000)

(set 'counter 0)
(dolist (x (symbols))
        (when (or (lambda? (eval x))
                  (primitive? (eval x))
                  (macro? (eval x)))
              (hset x)
              (print "set" x " setq" x " "))
              (setq+ counter 2)) ;-)

(println "\n\n" counter " new assignment macros defined.")
(println "Compares well with C, I guess.")


; TEST

(println)
(set 'L '(1 2 3))

(setappend (sym "L") '(7 8))

(println "Value of L should be (1 2 3 7 8) and it is " L ".")

(setqlist? L)

(println "Value of L should be true and it is " L ".")
(exit)