lambdaway :: lambdacode2

2 | list | login |load

| |

_h1 lambdacode {sup ( [[1|?view=lambdacode]] | 2 | [[3|?view=lambdacode3]] | [[4|?view=lambdacode4]] | [[5|?view=lambdacode5]]) }

{{block}
_h2 introduction

;; {center Document under construction}

_p The {b lambdatalk} language, introduced in the page [[coding]], comes with a rather complete set of special forms (key words) and primitives but has a severe weakness: {b the lack of closures}.

_p In this page we introduce {b LC}, a programming language implementing closures, working in the {b lambdatank/lambdatalk} environment, via a new function, {b AST}, added to evaluate any valid {b LC} expression, for instance {b (+ 1 (* 2 3) 4)}. The {b LC} evaluator follows the python evaluator written by Peter Norvig, [[lispy|http://norvig.com/lispy.html]]

_ul 1) the code is {b tokenized} into a flat array, 
_ul 2) then transformed into an {b abstract syntactical tree}, 
_ul 3) and finally {b parsed}.

_p {b LC} comes with {b 6} special forms, [{b lambda, def, if, let, set!, @}], and an extendable set of primitives.

_p Valid {b LC} expression are evaluated with the following exceptions:
_ul words prefixed by a quote are not evaluated, {b 'hello} displays {b hello} and a simple quote {b '} inserts a blank line,
_ul the {b (@ ...)} LC special form protect any sequences of words and expressions from evaluation. Scheme uses {b quote} instead of {b @},
_ul the {b (join ...)} LC primitive joins and displays quoted words and evaluated expressions. Scheme uses {b begin} instead of {b join},
_ul the {b '{q ...}} lambdatalk primitive displays any code unevaluated and as it is, with spaces and line returns.
 
_p The page editor can be opened to read and edit/test LC code.

_p Some useful informations:

_ul Informations about {b lambdatalk} can be seen in the page [[coding]]
_ul See also [[Practical Functional Programming|https://www.cs.bgu.ac.il/~ppl172/Class_Material]] 
_ul Compare with [[risp-in-rust-lisp|https://stopachka.essay.dev/post/5/risp-in-rust-lisp]]

_p Alain Marty {i 2021/07/10-13}
}

{{block}

_h2 functions

_p Everything begins with a text replacement process

{pre
please replace a & b
            in ... b a ...
            by hello & world
}

_p In {b LC} such a text replacement process is expressed as an {b IIFE}, an {b I}mmediately {b I}nvoked {b F}unction {b E}xpression

{pre
{AST
{q ((lambda (a b) 
         (join '... b a '...)) 
         'hello 'world)}
(join '=> ((lambda (a b) (join '... b a '...)) 'hello 'world))
}}

_p In order to make things easier an {b IIFE} can be written in 3 steps: 
_ul 1) define a {b function} using the {b lambda} first special form
_ul 2) give it a {b name} using the {b def} second special form
_ul 3) and apply this function to values, {b (name values)}.

_p For instance

{pre
{AST
{q (def swap 
 (lambda (a b) 
         (join '... b a '...))) }
(join '=> (def swap 
 (lambda (a b) 
         (join '... b a '...))))
'
{q (swap 'hello 'world)}
(join '=> (swap 'hello 'world))
'
{q (swap 'james 'bond)}
(join '=> (swap 'james 'bond))
}}

_p As a second example, the following {b IIFE}

{pre
{AST
{q ((lambda (x y) (sqrt (+ (* x x) (* y y))))
          3 4)}
(join '=> ((lambda (x y) (sqrt (+ (* x x) (* y y)))) 3 4) )
}}

_p is preferabily replaced by

{pre
{AST 
{q (def hypo
 (lambda (x y)
  (sqrt (+ (* x x) (* y y)))))}
(join '=>
(def hypo
 (lambda (x y)
  (sqrt (+ (* x x) (* y y))))))
'
{q (hypo 3 4)}
(join '=>
(hypo 3 4))
'
{q (hypo 1 1)}
(join '=>
(hypo 1 1))
'
}}

_p Finally here is an example mixing code and text. Writing

{pre
'{AST
' 
'hello
'
(@ This is a smart add function)
'
{q 
(def smart_add
 (lambda (a b)
  (join a '+ b 'is 'equal 'to 
   (+ a b) 
)))}
(join '=> 
(def smart_add
 (lambda (a b)
  (join a '+ b 'is 'equal 'to 
   (+ a b) 
))))
'
(@ used this way)
'
{q (smart_add 3 4)}
(join '=> (smart_add 3 4))
}
}

_p displays

{pre
{AST
'hello
'
(@ This is a smart add function)
'
{q (def smart_add
 (lambda (a b)
  (join a '+ b 'is 'equal 'to 
   (+ a b) 
)))}
(join '=> (def smart_add
     (lambda (a b)
    (join a '+ b 'is 'equal 'to (+ a b)
))))
'
(@ used this way)
'
{q (smart_add 3 4)}
(join '=> (smart_add 3 4))
}}

_p Due to the {i console oriented} way it is implemented, {b LC} is not the best choice to deal with wide portions of text. In this document we will use {b LC} in conjunction with {b lambdatalk} to deal with structured and enriched texts and {b LC} to play with algorithms.

_h3 the let special form

_p The {b ((lambda (var ...) body) val ...)} IIFE can be replaced by a {i syntactic sugar}, the {b (let ( (var val) ... ) body)} special form, enlighting the binding between {b vars} and {b vals}. For instance such an IIFE

{pre {AST
{q ((lambda (a b) (join a '* b '= (* a b))) 
          3 4)}
(join '=> ((lambda (a b) (join a '* b '= (* a b))) 3 4))
}}

_p is replaced by the following let special form

{pre {AST
{q (let ( (a 3) 
       (b 4) 
     ) (join a '* b '= (* a b))) } 
(join '=> 
(let ( (a 3) 
       (b 4) 
     ) (join a '* b '= (* a b))) ) 
}}
 
_p And lets can be nested

{pre
{AST
{q (let ( (a 1) 
       (b 2)
     ) (let ( (c (+ a b))
              (d (- a b))
            ) (+ a b c d)))} 
(join '=> (let ( (a 1) 
       (b 2)
     ) (let ( (c (+ a b))
              (d (- a b))
            ) (+ a b c d))))
}}

}

{{block}

_h2 closures

_p {b Lambdatalk} has no closures, {b LC} has closures.

{pre
{AST
{q (def foo
 (lambda (a)
  (lambda (b)
   (lambda (c)
    (+ a b c)))))}
(join '=> (def foo
 (lambda (a)
  (lambda (b)
   (lambda (c)
    (+ a b c))))))
'
(join {q (((foo 1) 2) 3)} '=> (((foo 1) 2) 3))
}}

_p To be compared with lambdatalk:

{pre
'{def foo
 {lambda {:a}
  {{lambda {:a :b}
   {{lambda {:a :b :c}
    {+ :a :b :c}
    } :a :b}
   } :a}}}
-> {def foo
 {lambda {:a}
  {{lambda {:a :b}
   {{lambda {:a :b :c}
    {+ :a :b :c}
    } :a :b}
   } :a}}}

'{{{foo 1} 2} 3}
-> {{{foo 1} 2} 3}
}

_p where the lack of closure is balanced by a set of IIFEs. Okay this is not very pretty but the good way with lambdatalk is to simply write

{pre
'{def bar 
 {lambda {:a :b :c}
  {+ :a :b :c}}}
-> {def bar 
 {lambda {:a :b :c}
  {+ :a :b :c}}}

called this way

'{bar 1 2 3}
-> {bar 1 2 3}
'{{{bar 1} 2} 3}
-> {{{bar 1} 2} 3}
}

_p because lambdatlalk functions are {i de facto} partially applicable. It turns out that in this case we don't need closure.

_p But, well, okay, despite all, closures are very useful as we will see later.

_h3 some applications

_h4 1) the area of a triangle is computed using this formula

{center {pre area = √{span {@ style="border-top:1px solid"}s*(s-a)*(s-b)*(s-c)} with s = (a+b+c)/2 }}

_p The triangle area function can be written using an IIFE

{pre {AST
{q (def area1
 (lambda (a b c)
  ((lambda (s)   // a, b, c are in the outer scope
   (sqrt (* s (- s a) (- s b) (- s c)))
   ) (/ (+ a b c) 2)
)))}
(join '=> (def area1
 (lambda (a b c)
  ((lambda (s)
   (sqrt (* s (- s a) (- s b) (- s c)))
   ) (/ (+ a b c) 2)
))))
'
{q (area1 3 4 5)}
(join '=> (area1 3 4 5))
}}

_p or using the let special form

{pre {AST
{q (def area2
 (lambda (a b c)
  (let ( (s (/ (+ a b c) 2)) 
       ) (sqrt (* s (- s a) (- s b) (- s c)))
)))}
(join '=> (def area2
 (lambda (a b c)
  (let ( (s (/ (+ a b c) 2)) 
       ) (sqrt (* s (- s a) (- s b) (- s c)))
))))
'
{q (area2 3 4 5)}
(join '=> (area2 3 4 5))
}}

_h4 2) the quadratic equation  ax{sup 2}+bx+c=0

{pre
{AST
{q (def quad
 (lambda (a b c)
  (let ( (d (- (* b b) (* 4 a c)))
       ) (if (> d 0)
         (join (/ (- b (- (sqrt d))) (* 2 a))
               (/ (- b (+ (sqrt d))) (* 2 a)))
         (@ no real root) )))))} 
(join '=>
(def quad
 (lambda (a b c)
  (let ( (d (- (* b b) (* 4 a c)))
       ) (if (> d 0)
         (join (/ (- b (- (sqrt d))) (* 2 a))
               (/ (- b (+ (sqrt d))) (* 2 a)))
         (@ no real root)
)))))
'
(join {q (quad 1 1 -1)} '=> (quad 1 1 -1))
(join {q (quad 1 0 -2)} '=> (quad 1 0 -2))
(join {q (quad 1 1 1)} '=> (quad 1 1 1))
}}

_h4 3) a counter

_p Cf [[scheme|https://www.usna.edu/Users/cs/roche/courses/f18si413/notes/03/]]. Using {b let} and {b set!} we can build a counter function.

{pre
{AST 
{q (def i++
 (let ( (n 0)
      ) (lambda () (join (set! n (+ n 1)) n))))}
(join '=> (def i++
 (let ( (n 0) )
 (lambda ()
  (join (set! n (+ n 1)) n)))))
'
(join {q (i++)} '=> (i++))
(join {q (i++)} '=> (i++))
(join {q (i++)} '=> (i++))
}}

_h4 4) continuation

_p See the lambdatalk version of [[continuation]].

{pre
{AST
{q (def cfact
 (lambda (n k)
  (if (= n 0)
   (k 1)
   (cfact (- n 1) (lambda (x) (k (* n x)))) ))) }
(join '=> (def cfact
 (lambda (n k)
  (if (= n 0)
   (k 1)
   (cfact (- n 1) (lambda (x) (k (* n x)))) ))) )
'
{q (def K (lambda (x)
       (join 'Note 'that x 'is 'a 'big 'number.)))}
(join '=> (def K (lambda (x) (join 'Note 'that x 'is 'a 'big 'number.))) )

{q (cfact 10 K)}
(join '=> (cfact 10 K))

'
(@ {h4 as seen in wikipedia})

(@ 1. direct style)

{q (def pyth (lambda (x y)
 (sqrt (+ (* x x) (* y y)))))}
(join '=> (def pyth (lambda (x y)
 (sqrt (+ (* x x) (* y y))))))
'
(@ 2. continuation passing style)

{q (def pyth&
 (lambda (x y k)
  (*& x x (lambda (x2)
          (*& y y (lambda (y2)
                   (+& x2 y2 (lambda (x2py2)
                              (sqrt& x2py2 k)))))))))}
(join '=> (def pyth&
 (lambda (x y k)
  (*& x x (lambda (x2)
          (*& y y (lambda (y2)
                   (+& x2 y2 (lambda (x2py2)
                              (sqrt& x2py2 k))))))))))
'
{q (def *& (lambda (x y k) (k (* x y))))}
(join '=> (def *& (lambda (x y k) (k (* x y)))))
{q (def +& (lambda (x y k) (k (+ x y))))}
(join '=> (def +& (lambda (x y k) (k (+ x y)))))
{q (def sqrt& (lambda (x k) (k (sqrt x))))}
(join '=> (def sqrt& (lambda (x k) (k (sqrt x)))))
'
{q (def k (lambda (x) (join 'and 'finally 'we 'get x)))}
(join '=> (def k (lambda (x) (join 'and 'finally 'we 'get x))))
'
{q (pyth& 3 4 k)}
(join '=> (pyth& 3 4 k))
}}

_p More to come ...
}

{{block}

_h2 maths

_p Currently the set of primitives dealing with maths is the following

{prewrap
+, *, -, /, %, <, >, <=, >=, =, not, or, and, 
abs, acos, asin, atan, atan2, ceil, cos, exp, floor, 
log, max, min, pow, random, round, sin, sqrt, tan, 
PI, E, long_add, long_mult
}

_p Nothing new compared with lambdatalk.

{prewrap
{AST

{q (sqrt (+ (* 3 3) (* 4 4)))}
(join '=> (sqrt (+ (* 3 3) (* 4 4))))
'
{q (/ (+ 1 (sqrt 5)) 2))}
(join '=> (/ (+ 1 (sqrt 5)) 2))
'
{q (* 123456789123456789123456789123456789
   123456789123456789123456789123456789)}
(join '=> (* 123456789123456789123456789123456789 123456789123456789123456789123456789))
'
{q (long_mult 123456789123456789123456789123456789
           123456789123456789123456789123456789)}
(join '=> (long_mult 123456789123456789123456789123456789 123456789123456789123456789123456789))
'
(@ and so on)
}}

_p There is a slight difference with {b booleans}, {b true} and {b false} become {b 'true} and {b 'false}.
{pre
{AST
{q (if 'true 'hello 'world)}
(join '=> (if 'true 'hello 'world))
'
{q (def signOf?
 (lambda (n)
 (if (> n 0) (join n 'is 'positive)
 (if (< n 0) (join n 'is 'negative)
 (join n 'is 'nul)))))}
(join '=> (def signOf?
 (lambda (n)
 (if (> n 0) (join n 'is 'positive)
 (if (< n 0) (join n 'is 'negative)
 (join n 'is 'nul))))))
'
{q (signOf? -10)}
(join '=> (signOf? -10))
}}

_p More to see in page [[coding]].
}

{{block}

_h2 recursion

_p {b LC} has no control structures, {b recursion} is used instead.

_h4 1) the factorial
{prewrap
{AST
{q (def fac
 (lambda (n)
 (if (< n 1)
 1
 (* n (fac (- n 1))))))}
(join '=> (def fac
 (lambda (n)
 (if (< n 1)
 1
 (* n (fac (- n 1)))))))
'
{q (fac 10)}
(join '=> (fac 10))
'
{q (def FAC 
 (lambda (n) 
 (if (< n 1)
 1 
 (long_mult n (FAC (- n 1))))))}
(join '=> (def FAC 
 (lambda (n) 
 (if (< n 1)
 1 
 (long_mult n (FAC (- n 1)))))))
'
{q (FAC 200)}
(join '=> (FAC 200))
'
(@ {b euler})
'
{q (def tfac
 (lambda (a b)
 (if ( (def tfac
 (lambda (a b)
 (if ( (def euler
 (lambda (a b)
 (if ( (euler 1 17))

}}

_h4 2) the Y-combinator

_p The factorial function can be written without a name using a Y-combinator in a IIFE

{pre
{AST
{q ((lambda (f n) (f f n)) 
 (lambda (f n)
 (if (< n 1)
 1
 (* n (f f (- n 1))))) 10)}

(join '=> ((lambda (f n) (f f n)) 
 (lambda (f n)
 (if (< n 1)
 1
 (* n (f f (- n 1))))) 10))
}}

_h4 3) memoïzation

{prewrap
{AST

{q (def fib
 (lambda (:n)
 (fib.r 2 :n (#.new 0 1))))}
(join '=> (def fib
 (lambda (:n)
 (fib.r 2 :n (#.new 0 1)))))
'
{q (def fib.r
 (lambda (:i :n :a)
 (if (<= :i :n)
 (fib.r (+ :i 1)
 :n 
 (#.set! :i
 (long_add (#.get (- :i 1) :a)
 (#.get (- :i 2) :a)) :a))
 (#.get :n :a))))}
(join '=> (def fib.r
 (lambda (:i :n :a)
 (if (<= :i :n)
 (fib.r (+ :i 1)
 :n 
 (#.set! :i (long_add (#.get (- :i 1) :a)
 (#.get (- :i 2) :a)) :a))
 (#.get :n :a)))) )
'
{q (fib 500)}
(join '=> (fib 500))

}}

_h4 4) mutual recursion

{pre
{AST
{q (def even?
 (lambda (x)
  (if (= x 0)
   'true
   (odd? (- x 1)))))}
(join '=> (def even?
 (lambda (x)
  (if (= x 0)
   'true
   (odd? (- x 1))))))
'
{q (def odd?
 (lambda (x)
  (if (= x 0)
   'false
   (even? (- x 1)))))}
(join '=> (def odd?
 (lambda (x)
  (if (= x 0)
   'false
   (even? (- x 1))))))
'
{q (even? 9)}
(join '=> (even? 9))
}}

_h4 5) a double recursive call with the Towers of Hanoï

{pre
{AST

{q (def hanoi 
 (lambda (n from to via)
 (if (= n 0)
 '
 (join
 (hanoi (- n 1) from via to)
 ' 
 'move n 'from 'tower from 'to 'tower to 
 (hanoi (- n 1) via to from) 
))))}
(join '=> (def hanoi 
 (lambda (n from to via)
 (if (= n 0)
 '
 (join
 (hanoi (- n 1) from via to)
 ' 
 'move n 'from 'tower from 'to 'tower to 
 (hanoi (- n 1) via to from) 
)))))
'
{q (hanoi 6 'A 'B 'C)}
(join '=> (hanoi 6 'A 'B 'C))
}}

_h4 6) the dragon curve

_p See page [[lambdacode3]].
}

{{block}
_h2 arrays

_p Beside words and numbers the unique strctured object currently implemented in {b LC} is the array object:

{pre
#.new, #.disp, #.empty?, #.array?, #.length, 
#.get, #.slice, #.first, #.last, #.rest, 
#.concat, #.reverse, #.sort, 
#.set!, #.pop!, #.shift!, #.push!, #.unshift!, 
#.map
}

_h3 1) horner & newton

{pre
{AST
{q (def #.horner
 (lambda (:a :z)
 (#.horner.rec :a :z 0 0) )) }
(join '=> (def #.horner
 (lambda (:a :z)
 (#.horner.rec :a :z 0 0) )) )
'
{q (def #.horner.rec 
 (lambda (:a :z :q :p)
 (if (#.empty? :a)
 (#.new :p (/ :p :q))
 (#.horner.rec (#.rest :a)
 :z 
 (+ (* :z :q) :p)
 (+ (* :z :p) (#.first :a))) ))) }
(join '=> (def #.horner.rec 
 (lambda (:a :z :q :p)
 (if (#.empty? :a)
 (#.new :p (/ :p :q))
 (#.horner.rec (#.rest :a)
 :z 
 (+ (* :z :q) :p)
 (+ (* :z :p) (#.first :a))) ))) )
'
{q (#.horner (#.new 1 -1 -1) 1.618033988749895)}
(join '=> (#.horner (#.new 1 -1 -1) 1.618033988749895))
'
{q (def #.newton
 (lambda (:l :x)
 (let ( (:h (#.horner :l :x))
 ) (if (< (abs (#.first :h)) 1.0e-15)
 :x 
 (#.newton :l (- :x (#.last :h))))))))}
(join '=> (def #.newton
 (lambda (:l :x)
 (let ( (:h (#.horner :l :x))
 ) (if (< (abs (#.first :h)) 1.0e-15)
 :x 
 (#.newton :l (- :x (#.last :h))))))))
'
{q (#.newton (#.new 1 -1 -1) 1)}
(join '=> (#.newton (#.new 1 -1 -1) 1))
}}

_h3 map

_p Sometimes recursion can lead to stackoverflow and {b #.map} will be our friend.

{prewrap
{AST

{q (def M (#.new 1 2 3 4 5))}
(join '=> (def M (#.new 1 2 3 4 5)))
{q (#.map sqrt M)}
(join '=> (#.map sqrt M))
{q (#.map (lambda (x) (* x x)) M)}
(join '=> (#.map (lambda (x) (* x x)) M))
'
{q (def #.sum_elements
 (lambda (a)
  (if (#.empty? a)
   0
   (+ (#.first a) (#.sum_elements (#.rest a)))))) }
(join '=> (def #.sum_elements
 (lambda (a)
  (if (#.empty? a)
   0
   (+ (#.first a) (#.sum_elements (#.rest a)))))) )
'
{q (#.sum_elements M)}
(join '=> (#.sum_elements M))
'
{q (def #.range.r
 (lambda (b n i)
  (if (= i n)
   b
   (#.range.r (#.push! i b) n (+ i 1))))) }
(join '=> (def #.range.r
 (lambda (b n i)
  (if (= i n)
   b
   (#.range.r (#.push! i b) n (+ i 1))))) )
'
{q (def #.range 
 (lambda (a)
  (#.range.r (#.new) (#.length a) 0))) }
(join '=> (def #.range 
 (lambda (a)
  (#.range.r (#.new) (#.length a) 0))) )
'
{q (#.disp (#.range M))}
(join '=> (#.disp (#.range M)))
'
(@ matrix multiplication)
'
{q (def matmat
 (lambda (a b)
  (#.map (lambda (i)
   (#.map (lambda (j) (#.sum_elements 
    (#.map (lambda (k) (* (#.get k (#.get i a)) 
                          (#.get j (#.get k b)))  
    ) (#.range b)) )
   ) (#.range (#.first b)) )
  ) (#.range a))
))}
(join '=> (def matmat
 (lambda (a b)
  (#.map (lambda (i)
   (#.map (lambda (j) (#.sum_elements 
    (#.map (lambda (k) (* (#.get k (#.get i a)) 
                          (#.get j (#.get k b)))  
           ) (#.range b)) )
          ) (#.range (#.first b)))
         ) (#.range a)) )))
'
{q (#.disp
 (matmat
  (#.new (#.new 1 2) 
         (#.new 3 4)
         (#.new 5 6)
         (#.new 7 8)) 
  (#.new (#.new 1 2 3)
         (#.new 4 5 6)) ))}
(join '=> (#.disp
 (matmat
  (#.new (#.new 1 2) 
         (#.new 3 4)
         (#.new 5 6)
         (#.new 7 8)) 
  (#.new (#.new 1 2 3)
         (#.new 4 5 6)) )))

;; (@ [[9,12,15],[19,26,33],[29,40,51],[39,54,69]])
'
{q (#.disp
 (matmat
  (#.new (#.new  0 -1) 
         (#.new  1  0)) 
  (#.new (#.new  0  1) 
         (#.new -1  0))))} 
(join '=> (#.disp (matmat (#.new (#.new 0 -1) 
                       (#.new 1 0)) 
                (#.new (#.new 0 1) 
                       (#.new -1 0)))))
'
{q (def X
 (#.new (#.new 3 2 1 5)
        (#.new 9 1 3 0)))}

(join '=> (def X
 (#.new (#.new 3 2 1 5)
        (#.new 9 1 3 0))))
'
{q (def Y
 (#.new (#.new 2 9 0)
        (#.new 1 3 5)
        (#.new 2 4 7)
        (#.new 8 1 5)))}
(join '=> (def Y
 (#.new (#.new 2 9 0)
        (#.new 1 3 5)
        (#.new 2 4 7)
        (#.new 8 1 5))) )
'
{q (#.disp (matmat X Y))}
(join '=> (#.disp (matmat X Y)))

}}

_p Et voilà !
}

{{block}

_h2 conclusion

_p This is now the state of the dictionary

{prewrap
{AST
{q (lib)}
'=>
(lib)
}}

_p As in lambdatalk a set of {b HTML/CSS/SVG} primitives can be used in {b LC}

{prewrap
div, span, a, ul, ol, li, dl, dt, dd, table, tr, td, h1, h2, h3, h4, h5, h6, p, b, i, u, center, hr, br, blockquote, sup, sub, del, code, img, pre, textarea, canvas, audio, video, source, select, option, object, svg, line, rect, circle, ellipse, polygon, polyline, path, text, g, mpath, use, textPath, pattern, image, clipPath, defs, animate, set, animateMotion, animateTransform,
}

_p but we choose to forget them and use the lambdatalk primitives instead.

_p As a temporary conclusion, comparing LC and lambdatalk, we can say that with LC we {b gain} free variables (closure) but we {b loose} free text, simply because text must be always protected by quotes or embedded in a {b @} container. What is good in a coding console is not necessarily good in a text editor. It's a matter of choice.

_p {i Alain Marty 2021/07/06-10}
}

{{block}

_h2 the {i magic} function

_p The heart of the AST evaluator is the {b evaluate(x, env)} function.

{pre °°
var evaluate = function (x, env) {
 env = env || DICT; // local or global context 
 if ( isNumber(x) || isWord(x) ) { // 123 or _QUOT_xxx from lambdatalk
 return x; 
 } else if ( isQuoted(x) ) { // 'hello
 return x.slice(1);
 } else if ( isOp(x) ) { // a function in DICT
 return env.find(x)[x]; 
 } else if ( x[0] === '@' ) { // (@ a sequence of words)
 return x.slice(1).join(' '); 
 } else if ( x[0] === 'if' ) { // (if bool then_term else_term)
 return evaluate( (evaluate( x[1], env)? x[2] : x[3]), env );
 } else if ( x[0] === 'lambda' ) { // (lambda (args) body)
 return function () {
 var new_env = create_env( x[1], arguments, env );
 return evaluate( x[2], new_env ); 
 }
 } else if ( x[0] === 'def' ) { // (def name expression)
 env[x[1]] = evaluate( x[2], env );
 return '#: ' + x[1];
 } else if ( x[0] === 'let' ) { // (let ( (arg ...) body) val ...)
 var vv = x[1], body = x[2], vars = [], vals = [];
 for (var i=0; i < vv.length; i++) {
 vars.push( vv[i][0] );
 vals.push( evaluate(vv[i][1], env) );
 }
 var new_env = create_env( vars, vals, env );
 return evaluate( body, new_env ); 
 } else if ( x[0] === 'set!' ) { // (set! var exp)
 env.find(x[1])[x[1]] = evaluate( x[2], env )
 } else { // evaluate (x0 x1 x2 ...)
 for (var xx = [], i=0; i < x.length; i++)
 xx[i] = evaluate( x[i], env ); // evaluate all xi
 var proc = xx.shift(); // the function x0
 return proc.apply(null, xx); // applied to values
 }
};
°°}

_p To be compared with the [[python code|http://norvig.com/lispy.html]] written by Peter Norvig

{pre
def eval(x, env=global_env):
    "Evaluate an expression in an environment."
    if isinstance(x, Symbol):      # variable reference
        return env.find(x)[x]
    elif not isinstance(x, List):  # constant literal
        return x                
    elif x[0] == 'quote':          # (quote exp)
        (_, exp) = x
        return exp
    elif x[0] == 'if':             # (if test conseq alt)
        (_, test, conseq, alt) = x
        exp = (conseq if eval(test, env) else alt)
        return eval(exp, env)
    elif x[0] == 'define':         # (define var exp)
        (_, var, exp) = x
        env[var] = eval(exp, env)
    elif x[0] == 'set!':           # (set! var exp)
        (_, var, exp) = x
        env.find(var)[var] = eval(exp, env)
    elif x[0] == 'lambda':         # (lambda (var...) body)
        (_, parms, body) = x
        return Procedure(parms, body, env)
    else:                          # (proc arg...)
        proc = eval(x[0], env)
        args = [eval(exp, env) for exp in x[1:]]
        return proc(*args) 
}

}

{{hide}
{def block div
 {@ style="display:inline-block;
           width:500px; padding:5px; margin:10px;
           text-align:left; vertical-align:top; 
           background:#444; color:#fff"}}
}

{style 
body { background:#444; } 
#page_frame { border:0; background:#444; color:#000; width:600px; margin-left:0; }
#page_content { background:#444; color:#000; border:0; width:4500px; box-shadow:0 0 0; font-family:papyrus, optima; }
.page_menu { background:transparent; color:#fff; }
a { color:#f80; }
pre { box-shadow:0 0 8px #000; padding:5px; background:#444; color:#fff; font:normal 1.0em courier; }
b { color:cyan; }
h1 { font-size:4.0em; margin-left:0; color:#fff}
h2 { font-size:3.0em; }
h3 { font-size:2.0em; }
}

{script

//// 1) THE INTERFACE WITH LAMBDATALK

LAMBDATALK.DICT['AST'] = function() {
 var cod = arguments[0];
 var val = LC.parser( cod );
 var infos = '(' + val.bal[0] + '|' + val.bal[1] + ') ' + val.time + ' ms';
 var evaluation = ( val.bal[0] !== val.bal[1] ) ? cod : val.val;
 return '<center>' + infos + '</center><hr>' + evaluation
};

LAMBDATALK.DICT['q'] = function() {
  return LAMBDATALK.quote( arguments[0] )
};

//// 2) THE KERNEL

var LC = (function () {

var DICT = create_env([],[]);

var tokenize = function ( s ) { 
  return s.replace(/\(/g, ' ( ')
          .replace(/\)/g, ' ) ')
          .trim()
          .split(/\s+/);        
};

var build_tree = function (tokens) {
  var token = tokens.shift();
  if (token !== '(') 
    return token;
  var arr = [];
  while (tokens[0] !== ')')
    arr.push( build_tree(tokens) );
    tokens.shift();
    return arr;
  };

} else if ( x[0] === 'let' ) {
 var vv = x[1], body = x[2], vars = [], vals = [];
 for (var i=0; i < vv.length; i++) {
 vars.push( vv[i][0] );
 vals.push( evaluate(vv[i][1], env) );
 }
 var new_env = create_env( vars, vals, env );
 return evaluate( body, new_env );

} else if ( x[0] === 'set!' ) {           // (set! var exp)
    env.find(x[1])[x[1]] = evaluate( x[2], env )

} else if ( x[0] === 'def' ) {
 env[x[1]] = evaluate( x[2], env );
 return x[1];
 } else {
 for (var xx = [], i=0; i < x.length; i++)
 xx[i] = evaluate( x[i], env );
 var proc = xx.shift();
 return proc.apply(null, xx);
 }
};

var balance = function ( str ) {
  var acc_open = str.match( /\(/g );
  var acc_close = str.match( /\)/g );
  var nb_acc_open = (acc_open)?  acc_open.length : 0;
  var nb_acc_close = (acc_close)? acc_close.length : 0;
  return [nb_acc_open , nb_acc_close]; 
};
 
return { parser, DICT }

}());

var supertrim = function(s) {
    return s.trim().replace(/\s+/g, " ");
};

//// 3) POPULATING THE DICTIONARY

LC.DICT['console'] = function(){
  return [].slice.call(arguments).join('\n')
}; 
LC.DICT['join'] = function() {
  return [].slice.call(arguments).join(' ')
};
LC.DICT['glue'] = function() {
  return [].slice.call(arguments).join('')
};

LC.DICT['equal?'] = function(a, b){ return a === b };

//// MATHS

LC.DICT['+'] = function () {
 for (var r=0, i=0; i < arguments.length; i++) { 
 r += Number( arguments[i] ) 
 }
 return r; 
};
LC.DICT['*'] = function () {
 for (var r=1, i=0; i < arguments.length; i++) { 
 r *= arguments[i] 
 }
 return r; 
};
LC.DICT['-'] = function () {
 var r = arguments[0];
 if (arguments.length === 1) { 
 r = -r;
 } else { 
 for (var i=1; i < arguments.length; i++) { 
 r -= arguments[i] 
 } 
 }
 return r; 
};
LC.DICT['/'] = function () {
 var r = arguments[0];
 if (arguments.length === 1) {
 r = 1/r;
 } else { 
 for (var i=1; i < arguments.length; i++) { 
 r /= arguments[i] 
 } 
 }
 return r; 
};
LC.DICT['%'] = function () {
 return parseFloat(arguments[0]) % parseFloat(arguments[1]) 
};

LC.DICT['<'] = function(){
 return parseFloat(arguments[0]) < parseFloat(arguments[1]) 
};
LC.DICT['>'] = function(){
 return parseFloat(arguments[0]) > parseFloat(arguments[1]) 
};
LC.DICT['<='] = function(){ 
 return parseFloat(arguments[0]) <= parseFloat(arguments[1]) 
};

LC.DICT['>='] = function(){
 return parseFloat(arguments[0]) >= parseFloat(arguments[1]) 
};
LC.DICT['='] = function () {
 var a = parseFloat(arguments[0]), b = parseFloat(arguments[1]); 
 return !(a < b) && !(b < a) 
};
LC.DICT['not'] = function () {
return !arguments[0]
};
LC.DICT['or'] = function () { 
 for (var i=0; i< arguments.length; i++) { if (arguments[i]) return true }
 return false; 
};
LC.DICT['and'] = function () { 
 for (var i=0; i< arguments.length; i++) { if (arguments[i]) return false }
 return true; 
};

//// LONG INTEGER

LC.DICT['long_add'] = function () {
 var a = arguments[0].split("").reverse(),
 b = arguments[1].split("").reverse(),
 n = Math.max(a.length, b.length), 
 c = [], 
 d = 0;
 for (var i=0; i < n; i++) {
 c[i] = (a[i] | 0) + (b[i] | 0) + d;
 if (c[i] > 9) {
 c[i] -= 10;
 d = 1;
 } else {
 d = 0;
 }
 } 
 if (d === 1) c.push(1);
 return c.reverse().join('') 
};

LC.DICT['long_mult'] = function () {
  var a = arguments[0]; 
  var b = arguments[1];

a = (Array.isArray(a)) ? a.split("").reverse() : [a].reverse(); // ???
 b = b.split("").reverse();
 
 var c = [];
 for ( var i1 = 0; i1 < a.length; i1++ ) {
 for ( var i2 = 0; i2 < b.length; i2++ ) {
 var j = i1 + i2;
 c[j] = a[i1] * b[i2] + (c[j] | 0);
 if ( c[j] > 9 ) { 
 var f = Math.floor( c[j] / 10 );
 c[j] -= f * 10;
 c[j+1] = f + (c[j+1] | 0);
 }
 } 
 }
 return c.reverse().join("")
};

//// ARRAYS

LC.DICT['#.new'] = function() {
  return [].slice.call(arguments)
};
LC.DICT['#.array?'] = function() {
  return Array.isArray( arguments[0] )
};
LC.DICT['#.disp'] = function() {
  var args = arguments[0];
  return ( Array.isArray( args ) )? JSON.stringify( args ) : args
};
LC.DICT['#.length'] = function() {
  return arguments[0].length
};
LC.DICT['#.empty?'] = function() {
  return arguments[0].length === 0
};
LC.DICT['#.first'] = function() {
  var args = arguments[0];
  return (Array.isArray( args ))? args[0] : args 
};
LC.DICT['#.last'] = function() {
  var args = arguments[0];
  return (Array.isArray( args ))? args[args.length-1] : args 
};
LC.DICT['#.rest'] = function() {
  var args = arguments[0];
  return (Array.isArray( args ))? args.slice(1) : args 
};
LC.DICT['#.get'] = function() {  // (#.get i a)
  var val = arguments[1][arguments[0]];
  return (val !== undefined)? val : 'undefined'        
};
LC.DICT['#.slice'] = function() { // (#.slice i1 i2 a)
  return arguments[2].slice(arguments[0],arguments[1])
};
LC.DICT['#.concat'] = function() {
  return arguments[0].concat( arguments[1] )
};
LC.DICT['#.reverse'] = function() {
  return arguments[0].reverse()
};
LC.DICT['#.sort'] = function() {
  return (arguments[1] === 'up')? 
    arguments[0].sort( function(a,b) { return a - b } ) :
    arguments[0].sort( function(a,b) { return b - a } )
};
LC.DICT['#.set!'] = function() {  // (#.set! i v a)
  arguments[2][arguments[0]] = arguments[1]
  return arguments[2]
};
LC.DICT['#.pop!'] = function() {
  return arguments[0].pop()
};
LC.DICT['#.shift!'] = function() {
  return arguments[0].shift()
};
LC.DICT['#.push!'] = function() {  // (#.push! v a)
  arguments[1].push( arguments[0] )
  return arguments[1];
};
LC.DICT['#.unshift!'] = function() {  // (#.unshift! v a)
  arguments[1].unshift( arguments[a] )
  return arguments[0];
};

LC.DICT['#.map'] = function () { // (#.map func arr)
 var f = arguments[0]; 
 var a = arguments[1];
 var b = [];
 for (var i=0; i< a.length; i++) 
 b.push( f.call( null, a[i] ) ) 
 return b
};

/*
 var htmltags = [
'div', 'span', 'a', 'ul', 'ol', 'li', 'dl', 'dt', 'dd', 'table', 'tr', 'td', 'h1', 'h2', 'h3', 'h4', 'h5', 'h6', 'p', 'b', 'i', 'u', 'center', 'hr', 'br', 'blockquote', 'sup', 'sub', 'del', 'code', 'img', 'pre', 'textarea', 'canvas', 'audio', 'video', 'source', 'select', 'option', 'object', 
'svg', 'line', 'rect', 'circle', 'ellipse', 'polygon', 'polyline', 'path', 'text', 'g', 'mpath', 'use', 'textPath', 'pattern', 'image', 'clipPath', 'defs', 'animate', 'set', 'animateMotion', 'animateTransform'
];
for (var i=0; i < htmltags.length; i++) {
 LC.DICT[htmltags[i]] = function(tag) {
 return function() {
 var html = (arguments.length === 2)?
 "{"+tag+' {@ '+arguments[0]+'}'+arguments[1]+'}' : 
 "{"+tag+' '+arguments[0]+'}';
 return LAMBDATALK.eval_forms( html ); 
 }
 }(htmltags[i]); 
}
*/

LC.DICT['lib'] = function() {
 var str = '', index = 0;
 for (var key in LC.DICT) {
 if(LC.DICT.hasOwnProperty(key)) { 
 str += key + ', '; index++; 
 }
 }
 return 'DICT: ('+ index+') [ '+ str.substring(0,str.length-2)+' ] ';
};

//// AND SO ON ...
}