Supernatural Symbols.

=====================

; Newlisp interpreter analyzes the expression and inserts symbols
; used in the expression into symbol-table *before* evaluation
; of the expression.
;
; Because of that, one can write the function that assigns the
; value to the symbols of the block before the symbols are
; actually defined, or even mentioned in the block.
;
; Don't look first at the function - it is technical. Take a look
; at main program block first and analyze the function only if
; that block is interesting to you.


(set 'self-conscious-symbols
  (lambda()
     (if (not symbols1)
         (set 'symbols1 (symbols)))
     (let ((symbols2
             (difference (symbols)
                 symbols1
                 '(i symbols1 symbols2 self-conscious-symbols))))
                     
       (dolist(i symbols2)
            (set i (append "I am " (string i) ". I feel "
                       (string (apply amb
                                     (difference symbols2
                                           (list i))))
                       " is close."))))))


(self-conscious-symbols)
(seed (date-value))

(begin (self-conscious-symbols)
       (println Sri-Aurobindo)
       
       '(set 'i (list Maharishi
                      Sri-Chinmoy
                      Sai-Baba
                      Dalai-Lama)))

; OUTPUT
;
; I am Sri-Aurobindo. I feel Sri-Chinmoy is close.



Genloops.

; In third post in this "generated" serial, I'll define "generated"
; versions of loops. By generated, I mean that you use them as
; normal loops, and they substitute normal symbols with generated
; symbols.
;
; The loops for, doargs, dolist, dostring, dotimes and dotree have
; same syntax:
;
;              (<loopname> (<symbol> ...) body)
;
;
; I'll try to define genfor, gendoargs, gendolist, gendostring and
; gendotimes so they are used on the following way:
;
;
;              (gen<loopname> (<symbol> ...) <body>)
;                 ^
;                 |
;                only "gen" is inserted, analogously to gensym.
;
;
; Such "generated loops" should be evaluated like
;
;
;              (genlocal(<symbol>)
;                      (<loopname>(<symbol> ...) <body>))
;
;
; Definitions of gensym and genlocal pasted from previous post:


        (set 'gensym-counter 0)

        (set 'gensym
             (lambda(i)
               (inc gensym-counter)
               (sym (append "("
                            (string i)
                            " - "
                            (string gensym-counter)
                            ". generated symbol)"))))

        (set 'genlocal
          (lambda-macro(head)
            (let ((body (args)))
                 (letex ((H1 (map (lambda(x)
                                     (list x
                                        (list 'gensym
                                              (list 'quote x))))
                                    head))
                          (H2 (cons 'local (cons head body)))
                          (H3 (cons 'begin
                                    (map (lambda(x)
                                           (list 'delete
                                                 (list 'quote
                                                        x)))
                                         head))))
                         (letex H1          
                             (first (list H2
                                          H3)))))))


; Definition of "generated loops" genfor, gendoarg, gendolist,
; gendostring, gendotimes so they behave like described above.
; Again, code is complicated but technical, but idea is important.

(dolist (loopname '(for doargs dolist dostring dotimes))
  (set (sym (append "gen" (string loopname))) ; for -> genfor etc
       
       (letex ((loopname loopname))
         (lambda-macro(head)
           (let ((body (args)))
             (letex((H1 (list (first head)))
                    (H2 (append (list 'loopname head) body)))
                   (genlocal H1
                             H2)))))))
                             
                                  
; Next, I'll memorize (symbols), to show that that all generated
; symobls will be actually, cleaned.

(set 'symbols-before-genloops (symbols))

; Tests that new genfors really work:
                                     
(genfor (i 10 20 5)
        (println 'i " = " i))
        
(println)

(gendolist (j '(a b c))
           (println 'j " = " j))
           
(println)

(gendotimes(k 4)(println 'k " = " k))

(println)

; OUTPUT

; (i - 1. generated symbol) = 10
; (i - 1. generated symbol) = 15
; (i - 1. generated symbol) = 20

; (j - 2. generated symbol) = a
; (j - 2. generated symbol) = b
; (j - 2. generated symbol) = c

; (k - 3. generated symbol) = 0
; (k - 3. generated symbol) = 1
; (k - 3. generated symbol) = 2
; (k - 3. generated symbol) = 3


; Test that gensyms are deleted:

(println (difference (symbols) symbols-before-genloops))

; OUTPUT
;
; (a b c j k)
;
; OK.

(exit)

Genlocal.

; In previous blogpost I defined gensym and genlet. If you didn't
; read it, read that post first.
;
; I'll repeat the definition of the gensym again, to remind my
; readers, and also, to allow evaluation of this post as a code.
; Also, I slightly improve name of my generated variables.



(set 'gensym-counter 0)

(set 'gensym
     (lambda(i)
       (inc gensym-counter)
       (sym (append "("
                    (string i)
                    " - "
                    (string gensym-counter)
                    ". generated symbol)"))))
                    
; genlet defined in the last post had same purpose as let, except
; it actually defined not variables, but generated versions of
; variables.

; Newlisp is, unlike other Lisp dialects, characterized with
; large number of constructs that implicitly define local variables.
; Beside let, there is a mighty letex, and also whole plethora
; of loops. All of these can have their own generated versions.
;
; But, there is one primitive in Newlisp that serves only to ensure
; that variables used inside that expression will be local. That is
; - expression local.

(set 'i 40)

(local(i)
  (println i)) ; Output => nil

; Just like local serves as general expression that can be wrapped
; around any other expression or list of expression to ensure
; they use local variables, we can define genlocal, which ensures
; that listed variables will be both generated and local.

; For example, genlocal call

;   (genlocal(a b c)
;      (set 'a 1)
;      (set 'b 2)
;      (set 'c 3))
;
     
;  should be transformed into
  
(letex((a (gensym 'a))
       (b (gensym 'b))
       (c (gensym 'c)))
       
   (first (list (local(a b c)
                      (set 'a 1)
                      (set 'b 2)
                      (set 'c 3))
      
                (begin (delete 'a)
                       (delete 'b)
                       (delete 'c)))))
                       

; It is very similar to definition of genlet from previous post,
; so I can almost cut and paste our previous macro:


(set 'genlocal
  (lambda-macro(head)
    (let ((body (args)))
         (letex  
                 ; look body first, head later.
         
                 ; head

                        ((H1 (map (lambda(x)
                                     (list x
                                           (list 'gensym
                                                 (list 'quote x))))
                                   head))
                                   
                          (H2 (cons 'local (cons head body)))
                          
                          
                          (H3 (cons 'begin (map (lambda(x)
                                                  (list 'delete
                                                        (list 'quote
                                                               x)))
                                                 head))))
                 ; body:
                 
                 (letex H1          
                     (first (list H2
                     
                                  H3)))))))
                                  

; I'll try that:

  (genlocal(a b c)
     (set 'a 1)
     (set 'b 2)
     (set 'c 3)
     (println 'a " = " a  "\n" 'b " = " b "\n" 'c " = " c))

; OUTPUT
;
; (a - 4. generated symbol) = 1
; (b - 5. generated symbol) = 2
; (c - 6. generated symbol) = 3
;

(exit)

Gensym and Genlet.

; Gensym is one of the important tools in the Lisp languages. It is
; function that returns variable. The point is - each time it is called
; it returns different variable. Gensym is typically used if one
; wants to avoid accidental name clashes while defining macros, but
; it is not its sole use.


; Newlisp has not gensym yet, but it is easy to make one. One example
; can be seen in Jeff Ober's article In defense of Newlisp, and it
; is also included in his Util library. His implementation supports
; contexts, and since I do not need contexts in this article, I'll
; define another gensym, slightly simpler, but not without some charm.


(set 'gensym-counter 0)

(set 'gensym
     (lambda(i)
       (inc gensym-counter)
       (sym (append (string i)
                    " ("
                    (string gensym-counter)
                    ". generated symbol)"))))
       

; Let us see how variables generated by our gensym look like:


(for(j 1 5)
  (println (gensym 'i)))


; Output:
;
;                     i (1. generated symbol)
;                     i (2. generated symbol)
;                     i (3. generated symbol)
;                     i (4. generated symbol)
;                     i (5. generated symbol)
;
;
; The blanks and parentheses - all that is the part of the generated
; symbol. I defined such symbol name intentionally, because it is
; impossible to accidentally use such name in programs; it must be
; generated during runtime. Also, these names are pretty descriptive,
; so they can be useful in debugging.
;
;
; I'll say that, for example, i (1. generated symbol) - is generated
; symbol that used symbol i as its base. It might have sense.
;
;
; Once generated, symbols are elements of the symbols-table until
; explicitly deleted. It is an implementation detail. Although not
; important for normal symbols, there might be millions of generated
; symbols, and it might be good to delete generated symbols immidietely
; when theye are not needed any more.


                    (for (j 1 3)
                         (set 'v (gensym 'j))
                         (println v)
                         (delete v))
  

; Topic I'd try to adress here is how to define "generated" versions
; of let and local, so programmer can write:
;
;    (genlet ((i 1)
;             (j 2))
;            (println 'i "= " i ", " 'j "= " j))
        
; While in fact, not ordinary symbols i and j are used inside
; of the genlet expression, but their gensymed versions. It is
; relatively easy to accomplish it by using powerful letex
; expression:


        (letex ((i (gensym 'i))
                (j (gensym 'j)))
                (let ((i 1)
                      (j 2))
                     (println 'i "= " i ", " 'j "= " j)))


; letex will literally replace i and j with "generated versions"
; in the inner let expression and then evaluate such, mutated inner
; expression.
;
; Output is:
;
; i (9. generated symbol)= 1, j (10. generated symbol)= 2
;
; As it can be seen, really, not i and j, but their "gensymed"
; versions are actually used. Each time this block is evaluated,
; different version is used.
;
;
; However, it becomes more complicated if I want to delete
; generated symbols. And I must do that, because if gensym is
; in some large loop, it could easily generate millions of symbols,
; and finally exhaust memory.


(letex ((i (gensym 'i))
        (j (gensym 'j)))
       (first (list (let ((i 1)
                          (j 2))
                         (begin
                            (println 'i "= " i ", " 'j "= " j)))
                   
                    (begin (delete 'i)
                           (delete 'j)))))


; With this construction I ensure that inner let expression is
; evaluated, after that gensymed variables are deleted, and finally,
; the result of the inner let expression is returned as result.
;
;
; This is how macro that "expands" into expression above looks
; like. I'll use wherex, which is inverse letex I defined few
; posts earlier, so I'll load my library from Internet. The
; definition of genlet is technical and not very interesting,
; so you can skip it.

(load "http://www.instprog.com/Instprog.default-library.lsp")

(set 'genlet
  (lambda-macro(head)
    (let ((body (args)))
         (wherex
         
                 (letex H1          
                     (first (list (let H2   
                                       H3)
                                  H4)))
                            
         ; where
                 
                 ((H1 (map (lambda(x)
                             (list (nth 0 x)
                                   (list 'gensym
                                         (list 'quote (nth 0 x)))))
                           head))
                           
                  (H2 head)
                  
                  (H3 (cons 'begin body))
                  
                  (H4 (cons 'begin (map (lambda(x)
                                          (list 'delete
                                                (list 'quote
                                                       (nth 0 x))))
                                         head))))))))

; Does it work?


         (genlet ((i 1)
                  (j 2))
                 (println 'i "= " i ", " 'j "= " j))

; Output:
;
;      (13. generated symbol)= 1, j (14. generated symbol)= 2
;
; It works.
;
; And what happens if I do something like


              (genlet ((i 1))
                      (genlet ((i 2))
                          (println 'i "= " i))
                      (println 'i "= " i))
       
; Output:
;
; i (15. generated symbol) (16. generated symbol)= 2
; i (15. generated symbol)= 1    
;
;
; What is
;
;    i (15. generated symbol) (16. generated symbol)?
;
; It is generated symbol, that uses for its basis generated symbol
; i (15. generated symbol), that uses i for its basis symbol i.
;
; Another test:


               (println= (genlet ((i 7))
                            (genlet ((j 8))
                               (* i j))))
               
; Output:

;      (genlet ((i 7)) (genlet ((j 8)) (* i j)))=56;
;
; Again, everything works.
;
; If you do have problems with understanding this code, don't
; let this discourage you. It is really complicated, and it is
; enough to remember that some genlet is defined here - and come
; back if you find you might need it.

; Next time - genlocal!



                          (exit)

Text Titles.

; If program outputs lot of plain text, then it is useful to break
; the text in smaller parts clearly divided with underlined or
; boxed titles, like
;
;                       Main title
;                       ==========
; or
;
;                    +----------------+
;                    | Another title. |
;                    +----------------+
;
; Yesterday, I was bored by manual writing of such titles and
; decided to write some support for it. It turned there are many
; special cases, and code is longer than I expected.

(set 'number-of-columns 64)
(set 'max-title-width 24)

(set 'nth-cyclic
     (lambda(i l)(nth (mod i (length l)) l)))
     
(set 'find-last
     (lambda(d l)
       (let ((result (find (reverse d) (reverse l))))
            (if result (- (length l) result (length d))))))

(set 'break-title
  (lambda(title-string)
    (let ((title-string (trim title-string))
          (lts (length title-string)))
      (if (<= lts max-title-width)
          (list (trim title-string))
          (let ((s (or (find-last " " (slice title-string 0 max-title-width))
                       max-title-width)))
              (cons (trim (slice title-string 0 s))
                     (break-title (slice title-string
                                         s
                                         (- lts s)))))))))
                                         
(set 'clean-string
     (lambda(x)
        (dolist(i (list (list "  " " ")
                         (list (char 13) "")
                         (list (char 10) "")))
           (while (find (i 0) x)
               (replace (i 0) x (i 1))))
        x))

(set 'underline
 (lambda(title-text underline-string)
  (let ((cc 0))
    (dolist(i (break-title (clean-string title-text)))
      (let ((indent (dup " " (round (div (sub number-of-columns
                                              (length i)
                                              +0.1)
                                          2)))))
          (print indent i "\n" indent)
          (dotimes(j (length i))
             (inc cc)
             (print (nth-cyclic cc underline-string)))
          (println)))
     (println))))
              

      
(set 'box
     (lambda(title-text box-string)
       (println)
       (letn ((cc 0)
              (L (map trim (break-title (clean-string title-text))))
              (maxlength (apply max (map length L)))
              (indent (dup " " (/ (- number-of-columns maxlength 4)
                                   2))))
           (print indent)
           (for(i 1 (+ maxlength 4))
              (print (nth-cyclic cc box-string))
              (inc cc))
           (println)
                 
           (dolist(i L)
               (print indent (nth-cyclic cc box-string))
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) +0.1) 2)))))
               (inc cc)
               (print i)
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) -0.1) 2)))))
               (println (nth-cyclic cc box-string))
               (inc cc))
               
           (print indent)
           (for(i 1 (+ maxlength 4))
              (print (nth-cyclic cc box-string))
              (inc cc))
           (println)
             
           (println))))
           
         
(set 'box-standard
     (lambda(title-text box-string)
       (println)
       (letn ((cc 0)
              (L (break-title (clean-string title-text)))
              (maxlength (apply max (map length L)))
              (indent (dup " " (/ (- number-of-columns maxlength 4)
                                   2))))
           (print indent)
           (println "+" (dup "-" (+ maxlength 2)) "+")
                 
           (dolist(i L)
               (print indent "|")
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) +0.1) 2)))))
               (print i)
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) -0.1) 2)))))
               (println "|"))
               
           (print indent)
           (println "+" (dup "-" (+ maxlength 2)) "+")
             
           (println))))
           
(underline "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts." "-*")
      
(box-standard "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts.")
      
(box "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts." "/\\")


;                      newLISP focuses on the
;                      *-*-*-*-*-*-*-*-*-*-*-
;                        core components of
;                        *-*-*-*-*-*-*-*-*-
;                      Lisp: lists,  symbols,
;                      *-*-*-*-*-*-*-*-*-*-*-
;                     and lambda expressions.
;                     *-*-*-*-*-*-*-*-*-*-*-*
;                      To these, newLISP adds
;                      -*-*-*-*-*-*-*-*-*-*-*
;                         arrays, implicit
;                         -*-*-*-*-*-*-*-*
;                      indexing on lists and
;                      -*-*-*-*-*-*-*-*-*-*-
;                       arrays, and dynamic
;                       *-*-*-*-*-*-*-*-*-*
;                       and lexical scoping.
;                       -*-*-*-*-*-*-*-*-*-*
;                        Lexical scoping is
;                        -*-*-*-*-*-*-*-*-*
;                        implemented using
;                        -*-*-*-*-*-*-*-*-
;                       separate namespaces
;                       *-*-*-*-*-*-*-*-*-*
;                         called contexts.
;                         -*-*-*-*-*-*-*-*
;
;
;                   +-------------------------+
;                   | newLISP focuses on the  |
;                   |   core components of    |
;                   | Lisp: lists,  symbols,  |
;                   | and lambda expressions. |
;                   | To these, newLISP adds  |
;                   |    arrays, implicit     |
;                   |  indexing on lists and  |
;                   |   arrays, and dynamic   |
;                   |  and lexical scoping.   |
;                   |   Lexical scoping is    |
;                   |    implemented using    |
;                   |   separate namespaces   |
;                   |    called contexts.     |
;                   +-------------------------+
;
;
;                   /\/\/\/\/\/\/\/\/\/\/\/\/\/
;                   \ newLISP focuses on the  /
;                   \   core components of    /
;                   \ Lisp: lists,  symbols,  /
;                   \ and lambda expressions. /
;                   \ To these, newLISP adds  /
;                   \    arrays, implicit     /
;                   \  indexing on lists and  /
;                   \   arrays, and dynamic   /
;                   \  and lexical scoping.   /
;                   \   Lexical scoping is    /
;                   \    implemented using    /
;                   \   separate namespaces   /
;                   \    called contexts.     /
;                   \/\/\/\/\/\/\/\/\/\/\/\/\/\
;


Example of actual use.