If lambda Gives let, What About lambda-macro?

;---------------------------------------------------------------
; INTRODUCTION
;
; In Lisp generally, including Newlisp, let is defined through
; lambda. According to Newlisp manual
;
;   (let ((sym1 exp-init1) [ (sym2 exp-init2) ... ] ) body)
;
; is equivalent to
;
;          ((lambda (sym1 [sym2 ... ])
;                   exp-body)
;                   exp-init1 [ exp-init2 ...])
;
; What happens if we use lambda-macro instead lambda on the same
; way?

;---------------------------------------------------------------
; I'll define
;
;              (met ((sym1 exp-init1)
;                    ...
;                    (symn exp-initn))
;                    body)
;
; as a macro call that translates to the expression
;
;             ((lambda-macro(sym1 ... symn)
;                           body)
;              exp-init1
;              ...
;              exp.initn)
;
; end evaluates it.

(set 'met (lambda-macro()
             (letn((initializations (first (args)))
                   (new-macro (append (lambda-macro)
                                     (list (map 'first
                                                 initializations))
                                     (rest (args))))
                   (equivalent-expression
                             (cons new-macro
                                   (map (lambda(x)
                                          (first (rest x)))
                                        initializations))))
                   (eval equivalent-expression))))
             
; What such a met control structure does? Almost the same thing as
; let, just initialization will be done in "macro style", ie. if
; I write
;
;         (met ((sym1 (+ 2 3))
;               (sym2 (+ 3 4)))
;              ...)
;       
; the value of sym1 will not be RESULT of evaluation of (+ 2 3),
; but expressions (+ 2 3) itself, just like I wrote
;
;        (let ((sym1 '(+ 2 3))
;              (sym2 '(+ 3 4)))
;             ...)
;
;Test:

(met ((sym1 (1 2 3))
      (sym2 (4 5 6)))
     (println (append sym1 sym2)) ; output: (1 2 3 4 5 6)
     (println (list sym1 sym2)))  ; output: ((1 2 3) (4 5 6))

; Yap, it works. But, what happens if I make tricky attack on
; my new account with something like?

(met ((sym1))
     (println "sym1=" sym1))
     
; It works as well, output is sym1=nil, just like it would be with
; let. It is the consequence of the (first (rest x)) returning nil,
; if x has only one element, unlike (nth 1 x) that produces error.
; (Newlisp has the "local" expression that can be used for similar
; purposes. Check it - it is good thing.)

; Another tricky attack with "empty" met, as a edge case? Does it work?

(met ()
     (println "Hello world"))

; It does - it doesn't generate an error, and that's all we need.


;---------------------------------------------------------------
; If "let" has a relative "letn", what about equivalent relative
; "metn" of "met"?
;
; (metn ((sym1 exp-init1)
;        (sym2 exp-init2)
;        ....
;        (symn exp-initn))
;        body)
;
; should be equivalent to
;
; (met ((sym1 exp-init1))
;      (met ((sym2 exp-init2))
;            ...
;            body)...))

; However, there is no use of that, because in both metn and met,
; exp-init1, ... are NOT evaluated until body starts to be evaluated,
; hence met and metn should have exactly the same effect - except
; that met should be faster. Why - see my post "New copies discovered".

;---------------------------------------------------------------
; CONCLUSION:
;
; Is such a "met" useful? Theoretically, it is as useful as lambda-macro.
; It spares one apostroph and makes programs more readable. However,
; let-expressions are already complicated enough so extra apostroph
; is not nearly such a nuisance as it can be in some macro calls that
; look like control structures. Nevertheless - why not?

New Copies Discovered.

; Let us define f and L on the following way:

(set 'f (lambda(x)(eval x)))
(set 'L '(0))

; what is the result of the evaluation of (f 'L)?

(println (f 'L)) ; output: (0)

; It appears that that particular function call evaluates to the
; value of L. However, just like in my last post - it is not actual
; value of the L, but its copy. We can test it on the following way:

(print "Attempt to push 1. ")
(push 1 L)
(println "L=" L) ; output: L=(1 0), attempt succeeded

; However,

(print "Attempt to push 2. ")
(push 2 (f 'L))
(println "L=" L) ; output: L=(1 0), attempt failed

; The value of (f 'L) is EQUAL to the value of L, but not the SAME.
; In some purely functional language, it wouldn't be the issue,
; however, Newlisp is not purely functional language - and in my
; opinion, it is good that it is not. Primitive function push is
; mutator - its result is not important, its side effect on one
; particular instance of the value is.

; Why f didn't returned exactly the value of L, but its copy?
; Who made this copy? Since f is (lambda(x)(eval x)), there are
; two possibilities. The first is that eval is responsible for a
; copy, and the second is that function does not return the result
; of the evaluation of the last experssion, but the COPY of that result.

; We can test whether it is eval who did the copy easily. Let
; us evaluate:

(print "Attempt to push 3. ")
(push 3 (eval 'L))
(println "L=" L) ; output: L=(3 1 0), attempt succeeded

; So, the function is responsible. It returns the copy of the result
; of the evaluation of the last expression in its body.

; I tested several other syntactical constructs of Newlisp and
; observed that many of do the same. The most notable, macros
; do.

(print "Attempt to push 4. ")
(set 'f (lambda-macro(x)(eval x)))
(push 4 (f L))
(println "L=" L) ; output: L=(3 1 0), attempt failed

; And also:

(print "Attempt to push 5. ")
(push 5 (let()L))
(println "L=" L) ; output: L=(3 1 0), attempt failed

(print "Attempt to push 6. ")
(push 6 (begin L))
(println "L=" L) ; output: L=(3 1 0), attempt failed

; Programmer cannot write the function (or even macro) that behaves
; exactly as primitive function eval on his own. It is impossible
; even by using actual eval in the function definition - because
; whatever one does, function will never return actual value of
; some variable, say L - but always some copy of that value - and
; as we've seen (eval L) returns actual value of L.

; The solution is to return the symbol L, not its value. Such a
; symbol can be evaluated in the environment of the caller, and
; result will be exactly the value of L.

(print "Attempt to push 7. ")
(set 'f '(lambda(x)x))

(push 7 (eval (f 'L)))
(println "L=" L)  ; output: L=(7 3 1 0), attempt succeeded
(exit)

; Semantically, difference is not big. Syntactically, however,
; extra eval in the caller environment is annoyance, more from
; eaesthetical than practical point of vew. But, aesthetic is the
; pride of Lisp, and it could be worth to research the possibility
; of the syntactical constructs equivalent to lambda, lambda macro,
; and possibly begin and let expressions - differing only by  
; returning actual values of the last subexpression.

Does the Function Really Evaluate to Itself?


; It is usually said that Newlisp functions evaluate to themselves.
; Is it really the truth? Let us test this claim.

(println "===================")
(set 'f (lambda(x)x))

(println f)
(println (eval f))

; Both of these are (lambda(x)x). OK, let us ask interpreter if
; they are equal directly:

(println "===================")
(println (= f (eval f))) ; true

; Hm ... one can be still suspicious. Let us try this one:

(println "===================")
(set 'f (lambda(x)x))
(push '(println "Hello!") f 1)

(println f)        ;(lambda (x) (println "Hello!") x)
(println (eval f)) ;(lambda (x) (println "Hello!") x)

; So far so good. And what if we push something in (eval f)?

(println "===================")
(set 'f (lambda(x)x))
(push '(println "Hello!") (eval f) 1)

(println f)          ;(lambda(x)x)
(println (eval f))   ;(lambda(x)x)

; Huh? The outputs are still equal, but how it is that our pushing
; of a friendly expression is not accepted neither in f nor in
; (eval f)? What is the explanation?

; Strictly speaking, functions do not evaluate EXACTLY to themselves,
; instead, they evaluate to the freshly generated copies of themselves.
; In last example, (eval f) was such a new copy, and (println "Hello")
; es pushed in the copy of the function f, not in the function itself.

; When (eval f) is called second time, in (println (eval f))
; another, completely new copy of f is returned - and it does not
; know that we already tried to teach previous copy new tricks.

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)

Newlisp on Windows and Linux on Virtualbox on Vista 64 on PC.


; I installed Sun's Virtualbox 1.6 "platform", actually, PC emulator
; on top of Windows XP Vista 64 and "virtual" Windows XP 32 and
; Kubuntu Linux 32 operating systems on each of the emulated PC's.
; Whole thing works surprisingly good. I executed one of the previous
; tests related to differences between macros and functions, and
; here are the running times for "native" and "virtual" execution.
; In these examples, Newlisp on Windows on Virtualbox are roughly 5-10%
; slower than native Windows, and on Kubuntu Windows it is 10-30% slower.

; Native Vista 64: (-> (time (addf ... 1000000) 13640)
; Virtualbox Windows XP 32: (-> (time (addf ... 1000000) 14625) (+7%)
; Virtualbox Kubuntu 32: (-> (time (addf ... 1000000) 16754) (+22%)

; Native Vista 64: (-> (time (addm ... 15031)
; Virtualbox Windows XP 32: (-> (time (addm ... 16198) (+8%)
; Virtualbox Kubuntu 32: (-> (time (addm ... 16901) (+13%)

; Native Vista 64: (-> (time (fibof 32)) 8718)
; Virtualbox Windows XP 32: (-> (time (fibof 32)) 9343) (+7%)
; Virtualbox Kubuntu 32: (-> (time (fibof 32)) 10324) (+18%)

; Native Vista 64: (-> (time (fibom2 32)) 9734)
; Virtualbox Windows XP 32: (-> (time (fibom2 32)) 10093) (+4%)
; Virtualbox Kubuntu 32: (-> (time (fibom2 32)) 11200) (+15%)

; Native Vista 64: (-> (time (eval (fibom3 32))) 72468)
; Virtualbox Windows XP 32: (-> (time (eval (fibom3 32))) 77150) (+6%)
; Virtualbox Kubuntu 32: (-> (time (eval (fibom3 32))) 91882) (+27%)


Lisp.properties for Scite.

moved to http://kazimirmajorinc.com

Promote Your Functions!

;---------------------------------------------------------------
; As usually, few definitions I frequently use.

(set 'macro (lambda-macro()(append (lambda-macro) (args))))
(set 'function (macro() (append (lambda) (args))))

(set '-line (dup "-" 64))
(set '--- (function()(println -line)))

(set '§§ (macro(§-argument)
               (list '-> §-argument (eval §-argument))))
(set '§ (macro() (doargs(§§-argument)
                 (println (eval (list '§§ §§-argument))))))

;---------------------------------------------------------------
; I'll try to define some tools for defining of the very simple
; class of the higher order functions, based on the "ordinary"
; functions. For example, for a given function add, I want to
; define addf, which does not sum the numbers, but functions.
;
; But, what does it mean? What is the sum of the functions,
; say, sin and cos? The simplest and in mathematics most
; frequently used definition is that the result is the function
; sin + cos such that
;
;         (sin + cos)(x) = sin x + cos x
;
; In Newlisp terms, it is
;
;         ((addf 'sin 'cos) x) = (add (sin x) (cos x))

; Furthermore, after I learn how to define addf manually, I want
; to develop tool, i.e function that does the same, so I can simply
; write

;         (set 'addf (increase-order 'add))

; I have to write such programs very gradually, starting with
; simple examples, and slowly generalizing. Otherwise, I find
; myself guessing about errors in the code I only partially understand.


; So, let's start with expression (add (sin 3)(cos 3)):


(§ (add (sin 3) (cos 3)))


; RESULT: (-> (add (sin 3) (cos 3)) -0.8488724885)

; Now, an easy part. How function that takes 3 as an argument and
; returns -0.84888... looks like? Obviously,
;
;               (lambda(x)(add (sin x) (cos x))).
;
; Or, using previously defined "function:"


(§ ((function(x)(add (sin x) (cos x))) 3))


; RESULT: (-> ((lambda (x) (add (sin x) (cos x))) 3) -0.8488724885)
; As expected, it works.

;---------------------------------------------------------------
; Now, look at the list (add (sin x) (cos x) ....). It appears
; that part can be generated by appending of the list (add) and list
; ((sin x) (cos x) ...). This second can be the result of some
; function that accepts two arguments: list of the function names,
; (or more generally, s-expressions that evaluate to functions) and
; of an argument on which functions will be applied.
; Let's call that function pamq, because it is somehow
; dual to the function map. So, I want

;         (pamq (list 'sin 'cos) 'x) => ((sin x) (cos x))

; it is not complete dual. Because in Newlisp, (map 'sin (list 'x 'y))
; does not evaluate to ((sin x) (sin y)); instead, map tries to apply
; sin on x and y, and if these have values, say 1 and 2 respectively,
; it evaluates to

;                 (0.8414709848 0.9092974268),

(---)
(set 'pamq (function(L a)
             (map (function(li)(list li a)) L)))
             
; Does it work?

(§ (pamq (list 'sin 'cos) 'x))

; It does: (-> (pamq (list 'sin 'cos) 'x) ((sin x) (cos x)))
; However, if I'm already here, I'll also write real pam, to be dual to
; map; and mapq to be dual to pamq, I'll put these functions in
; my library, just in the case I'll need them
; in future.

(---)
(set 'pam (function(L a)
            (map (function(fi)(eval (list fi a))) L)))
            

(set 'mapq (function(f L)
               (map (function(li)(list f li)) L)))
               
(§ (pam (list 'sin 'cos) 3)) ;(-> ... (0.1411200081 -0.9899924966))
(§ (mapq 'sin (list 'x 'y))) ;(-> ... ((sin x) (sin y)))


; They work. Back to the task of writing function addf such that
; (addf f1 ... fn) evaluates to (lambda(x)(add (f1 x)(f2 x)...(fn x))).

(set 'addf (function()
               (append '(lambda(x))
                       (list (append '(add) (pamq (args) 'x))))))

; Does it work?

(---)
(§ (addf 'sin 'cos)) ;(-> ... (lambda (x) (add (sin x) (cos x))))
(§ ((addf 'sin 'cos) 3)) ; (-> ... -0.8488724885)

; It does. The definition of 'addf is rather complicated. It is
; complicated because I must leave the expression (args) unquoted.

; Now, I'll make one generalization further. Sumation of the functions
; have sense for functions that accept more than one argument.
; For example, * and / accept two arguments and they can be added too.

; So, I want function that takes functions f1, f2 ... etc as argument
; and evaluates to

;     (lambda()(add (apply f1 (args)) .... (apply fn (args))))

; suddenly, my pretty function pamq is rather useless, and the best thing
; I can do is to write similar, but special function for this purpose:

(set 'pamq-special (function (L)
                      (map (function(li)(list 'apply li '(args))) L)))

(---)
(§ (pamq-special (list 'sin 'cos)))

; It works: (-> ... ((apply sin (args)) (apply cos (args))))

(set 'addf (function()
               (append '(lambda())
                       (list (append '(add) (pamq-special (args)))))))

(§ (addf 'sin 'cos)) ;(-> ... (lambda () (add (apply sin (args))
                      ;                        (apply cos (args)))))
(§ ((addf 'sin 'cos) 3)) ; (-> ... -0.8488724885)

; It's even better; pamq-special and addf use fewer symbols.
; Another test: the function +*/ is defined as sum of  two
; functions of two arguments, * and /. The result should be  
; (+*/ 4 2) = (+ (* 4 2) (/4 2)) = 10.

(---)
(set '+*/ (addf '* '/))
(§ (+*/ 4 2))

; OK, it works. Now, I'm ready for the last and most productive
; generalization - instead of using addf defined "by hand", I'll
; define function "increase-order" that accepts "ordinary" function as
; argument and returns it higher-order version.
;
; For example, "increase-order" should be able to take add as argument,
; and return value of already defined addf,
;
;    (function()
;       (append '(lambda())
;               (list (append '(add) (pamq-special (args)))))))


(set 'increase-order
     (function()
         (eval (list 'function '()
                  (list 'append ''(lambda())
                        (list 'list (list 'append (list 'quote (args))
                                                 '(pamq-special (args)))))))))


; Again, it is rather complicated. Not long, but complicated.
; There are lot of "lists" and "eval."; Why they are necessary?
; Because I had to ensure that the first occurence of (args) is free,
; i.e. it is not quoted, and Newlisp has no "quasiquote" yet.

; But it is relatively pretty function; it does not use any local
; variable. One can complain that it requires my user-made
; functions "function" and "pamq-special", but they can be eliminated.


(---)
(§ (increase-order 'add))

; (-> ... (lambda ()
;            (append '(lambda ())
;                     (list (append (quote (add))
;                                   (pamq-special (args)))))) )

; Hm ... it could work

(set 'addf (increase-order 'add))
(set '+f (increase-order '+))

(set 'sin+cos (addf 'sin 'cos))
(set '+*/ (+f '* '/))

(§ (sin+cos 3)) ; (-> (sin+cos 3) -0.8488724885)
(§ (+*/ 4 2)) ; (-> (+*/ 4 2) 10)

; Yap, it does work. But, what is the advantage of defining such
; functions? Shortening of the programs, clarity of the conceptions
; and possibly, easier detection of errors.


;---------------------------------------------------------------
; Example: increase-order is used for definition of reversef function
; that doesn't reverse the lists, but generates the function that
; reverses the lists, beside doing something else.

(---)
(set 'reversef (increase-order 'reverse))
(set 'reversed-map (reversef 'map)) ;

(§ reversed-map)
(§ (reversed-map 'sqrt (list 1 4 9 16)))

; (-> reversed-map (lambda () (reverse (apply map (args)))))
; (-> (reversed-map 'sqrt (list 1 4 9 16)) (4 3 2 1))

; Of course, the same result can be achieved without reversef,
; just it will require seven instead of two tokens and 16 instead of 5
; if we count apostroph and parentheses as well.