α-wwwiki

α-wwwiki :: history/lisp_evaluator/20130714-205907.txt

editor : alpha [37.160.44.141] 2013/07/14 20:59:07
_h1 lisp evaluator {sup (4)}

{div {@ style="font:bold 0.9em georgia;text-align:center;color:red;background:#eee;box-shadow:0 0 8px black;"} [[basic_evaluator]] | [[extended_evaluator]] | [[regexp_evaluator]] | lisp_evaluator}

_p Everything in the LISP world began with the initial code of [[initial code|http://epsilonwiki.free.fr/alphawiki/index.php?view=mcCarthy]] of [[John McCarthy|http://www-formal.stanford.edu/jmc/index.html]] on which worked a lot of good people : [[Gerald Jay Sussman|http://en.wikipedia.org/wiki/Gerald_Jay_Sussman]], [[Paul Graham|http://paulgraham.com/lisp.html]], [[Peter Norvig|http://norvig.com/lispy.html]], and young coders as [[Sreedathns|http://sreedathns.blogspot.in/]], [[Sainamdar|https://bitbucket.org/sainamdar/]], [[Pablo Vidal|https://github.com/pabloPXL]], and others too. Alphalisp is my very last attempt to understand what is actually a LISP engine, by translating some portions of the previous codes into a short and understandable Javascript code ! It's a work in progress :).

_h3 console
{p First please, {b click once} one this button : {input {@ type="submit" value="init evaluator" onclick="°° 
  var js = document.createElement('script');
  var input = getId('code').innerHTML;
  js.innerHTML = decode_html_entities(input); // < ,>
  document.head.appendChild( js );
  this.value = 'OK, evaluator inited !'; 
  this.disabled='disabled';
°°"}} , then :}

_ul 1) {u Any number of valid s-expressions entered in the light yellow frame below are evaluated in real-time in a frame below},
_ul 2) You can copy/paste any s-expressions from the frame "examples".
_ul 3) integrated functions : car, cdr, cons, list, list?, null?, equal?, join, not, or, and, ++, --, +, - *, /, < , >, < =, >=, =, %, abs, acos, asin, atan, atan2, ceil, cos, exp, floor, log, max, min, pow, random, round, sin, sqrt, tan, PI, E 
_ul 4) special operators : quote,if,set!,define,lambda,begin
_h3 input
{textarea {@ id="input" style="width:99%; height:500px; font:normal 1em courier; color:red; background:#ffc;" onkeyup="do_evaluate();"} 
(define fact 
  (lambda (n) 
    (if (lte n 1) 
        1 
        (* n (fact (- n 1)))
) ) )

> (fact 6) -> 720

(define D
  (lambda (f)
    (lambda (x) 
      (/ (- (f (+ x 0.0001)) 
            (f (- x 0.0001))
         ) 
         (* 2 0.0001)
) ) ) )

(define cubic (lambda (x) (* x x x)))

> (cubic 1) -> 1
> ((D cubic) 1) -> 3
> ((D (D cubic)) 1) -> 6  
> ((D (D (D cubic))) 1) -> 6	
> ((D (D (D (D cubic)))) 1) -> 0

}
 
_h3 output
{div {@ id="alphalisp_infos" style="text-align:center;"}}
{pre {@ id="output"}}

_h3 examples
{pre
///////// EXAMPLES /////////

///////// LISTS /////////
(define list0
  (quote ())
)
(list? list0) -> true
(null? list0) -> true
(car list0) -> null
(cdr list0) -> null

(define list1
  (quote a)
)
(list? list1) -> true
(car list1) -> a
(cdr list1) -> null

(define list2 
  (cons 
    (quote a) 
    (quote b)
))

(list? list2) -> true
(car list2) -> a
(cdr list2) -> b

(define list3
(cons 
  (quote a) 
  (cons 
    (quote b) 
    (quote c)
)))

(list? list3) -> true
(car list3) -> a
(cdr list3) -> b,c

(define list4
(cons 
  (quote a) 
  (cons 
    (quote b) 
    (cons 
      (quote c)
      (quote d)
))))
(list? list4) -> true
(car list4) -> a
(cdr list4) -> b,c,d

(define qlist4 
  (list (quote a) (quote b) (quote c) (quote d))
)

(list? qlist4) -> true
(car qlist4) -> a
(cdr qlist4) -> b,c,d

(join (quote Hello) (quote brave) (quote new) (quote World)) -> Hello brave new World

(define how-many 
  (lambda (item L) 
    (if L 
      (+ (equal? item (car L)) 
         (how-many item (cdr L))
      ) 
      0
) ) )

> (how-many 0 (list 0 1 2 3 0 0)) -> 3
> (how-many (quote the) (quote (the more the merrier, the bigger the better))) -> 4

(define length
  (lambda (ls)
    (if (null? ls)
      0
      (+ (length (cdr ls)) 1)
) ) )

> (length (quote ())) -> 0
> (length (quote (a))) -> 1
> (length (quote (a b))) -> 3

(define map
  (lambda (func liste)
    (if (null? liste)
      (quote ())
      (cons 
        (func (car liste)) 
        (map func (cdr liste))
) ) ) )

> (map (lambda (x) (* x x x)) (list 1 2 3 4 5 6 7 8 9) ) -> 1,8,27,64,125,216,343,512,729

(define serie
  (lambda (n)
    (if (< = n 1)
      1
      (join (serie (-- n)) n)
) ) )

> (serie 15)

(define iserie
  (lambda (i n)
    (if (< i n)
      (join i (iserie (+ i 1) n))
      n
) ) )

> (iserie 1 15)

(define serie
  (lambda (n)
    (if (< = n 1)
      1
      (join 
        (serie (-- n)) 
        (quote \n)
        ((lambda (n) (pow 2 n)) n)
      )
) ) )

> (serie 32)

///////// S-EXPRESSION EVALUATION /////////
> (* 1 2 3 4 5 6) -> 720
> (sqrt (+ (* 3 3) (* 4 4))) -> 5

(not (< 1 2)) -> false
(or  (< 1 2) (> 1 2)) -> true
(and (< 1 2) (> 1 2)) -> false

///////// A USER FUNCTION /////////
(define area (lambda (r) (* (PI) (* r r))))

> (area 3) -> 28.274333882308138

///////// A USER CONSTANT /////////
(define twoPI (lambda () (* 2 (PI))))

> (twoPI)

///////// c^2 = a^2 + b^2 /////////
(define hypo 
  (lambda (a b) (sqrt (+ (* a a) (* b b))))
)

> (hypo 3 4) -> 5

///////// DERIVEE - a value - /////////
(define derivee 
  (lambda (f x dx) 
    (/ (- (f (+ x dx)) 
          (f (- x dx)) 
       ) 
       (* 2 dx)
) ) )

> (derivee sqrt 1 0.001) -> 0.5000000625000056 ≠ 0.5

///////// DERIVEE - a function - /////////
(define D
  (lambda (f)
    (lambda (x) 
      (/ (- (f (+ x 0.0001)) 
            (f (- x 0.0001))
         ) 
         (* 2 0.0001)
) ) ) )

(define cubic (lambda (x) (* x x x)))

> (cubic 1) -> 1
> ((D cubic) 1) -> 3
> ((D (D cubic)) 1) -> 6  
> ((D (D (D cubic))) 1) -> 6	
> ((D (D (D (D cubic)))) 1) -> 0	
		
///////// AFFECTATION /////////
(define make-account
  (lambda (balance)
    (lambda (amt)
      (begin 
        (set! balance (+ balance amt)) 
        balance
) ) ) )

(define a1 (make-account 100))

> (a1 -20) -> 80
> (a1 -20) -> 60
> (a1 -20) -> 40
> (a1 -20) -> 20
> (a1 -20) ->  0
> (a1 -20) -> [ooops!]

///////// FACTORIAL /////////
(define fact 
  (lambda (n) 
    (if (lte n 1) 
        1 
        (* n (fact (- n 1)))
) ) )

> (fact 6) -> 720

///////// ITERATIVE FACTORIAL /////////
(define factorielle
  (lambda (n)
    (begin
      (define fact-iter
        (lambda (produit compteur max-compteur)
          (if (> compteur max-compteur)
            produit
            (fact-iter (* compteur produit) (+ compteur 1) max-compteur)
      ) ) )
      (fact-iter 1 1 n)
) ) )

> (factorielle 6) -> 720

///////// NEWTON /////////
(define newton 
  (lambda (i x)
    (if (lte i 1)
      1
      (/ 
        (+ (newton (-- i) x) 
           (/ x 
              (newton (-- i) x)
        )  )
        2
) ) ) )

> (newton 1 2) -> 1
> (newton 2 2) -> 1.5
> (newton 7 2) -> 1.414213562373095 ≠ 1.4142135623730951

// golden ratio :
> (/ (+ 1 (newton 1 5)) 2) -> 1
> (/ (+ 1 (newton 2 5)) 2) -> 2
> (/ (+ 1 (newton 7 5)) 2) -> 1.618033988749895 ≠ 1.618033988749895

///////// PASCAL COEFFS C[n,p] /////////
(define pascal 
  (lambda (n p)
    (if 
      (or (lte n 1) (lte p 0))
      1
      (/ (* n 
            (pascal (-- n) (-- p))
         )
         p
) ) ) )

(define pascal-line
  (lambda (n i)
    (if (< i 1)
      1
      (join 
        (pascal n i)
        (pascal-line n (-- i))
) ) ) )

(pascal-line 0 0) -> 1
(pascal-line 1 1) -> 1 1
(pascal-line 2 2) -> 1 2 1
(pascal-line 3 3) -> 1 3 3 1
(pascal-line 4 4) -> 1 4 6 4 1
(pascal-line 5 5) -> 1 5 10 10 5 1 
(pascal-line 6 6) -> 1 6 15 20 15 6 1

///////// PGCD /////////
(define pgcd
  (lambda (a b)
    (if (lte b 0)
      a
      (pgcd b (% a b))
) )  )

> (pgcd 856415 21) -> 7

///////// EXPONENTIAL /////////
(define expt
  (lambda (b n)
    (if (lte n 0)
      1
      (* b (expt b (- n 1)))
) ) )

> (expt 2 8) -> 256
> (expt 2 16) -> 65536
> (expt 2 24) -> 16777216
> (expt 2 32) -> 4294967296
> (expt 2 64) -> 18446744073709552000

///////// SECOND DEGREE EQUATION /////////
(define secondegre 
  (lambda (a b c)
    (begin
      (define delta
        (lambda (a b c) 
          (- (* b b) (* 4 a c))
      ) ) 
      (define root 
        (lambda (a b c d) 
          (if (< d 0)
            (join 
               (quote x1=)
               (/ (- 0 b) (* 2 a)) (quote -i*) (/ (sqrt (abs d)) (* 2 a))
               (quote \nx2=)
               (/ (- 0 b) (* 2 a)) (quote +i*) (/ (sqrt (abs d)) (* 2 a))
            )
            (join
              (quote x1=)(- (/ (- 0 b) (* 2 a)) (/ (sqrt d) (* 2 a)))
              (quote \nx2=)(+ (/ (- 0 b) (* 2 a)) (/ (sqrt d) (* 2 a)))
      ) ) ) )
      (root a b c (delta a b c))  
) ) )

(secondegre 1 -1 -1)
(secondegre 1 -1 1)
(secondegre 1 -2 1)
		
///////// more to come ... /////////
}

_h3 evaluator's code
{pre {@ id="code"}°°

// HTML interface
function do_evaluate() {
  var input = document.getElementById('input').value;
  var output = ALPHALISP.parser( input );
  document.getElementById('output').innerHTML = output.str;
  document.getElementById('alphalisp_infos').innerHTML =  
    '(' + output.bal.left + '|' + output.bal.right + ')';
}

var ALPHALISP = ( function () {

// 1) ENVIRONMENTS
// function creating an environment
var create_env = function (pars,args,out) {
  var env = {}, outer = out || {};
  if (0 !== pars.length)
    for (var i=0; i < pars.length; i++)
      env[pars[i]] = args[i];
  env.find = function (op) { 
  	return (env.hasOwnProperty(op))? env : outer.find(op) 
  };
  return env;
}
// create and start populating the primitive global environment
var global_e = create_env([],[]); // create_env([],[],undefined);
// basics
global_e['car'] = function(x){return (x.length !== 0) ? x[0] : null};
global_e['cdr'] = function(x){return (x.length > 1) ? x.slice(1) :null}; 
global_e['cons'] = function(x, y){var arr = [x]; return arr.concat(y) };
global_e['list'] = function(){return [].slice.call(arguments) }; 
global_e['list?'] = function(x){return Array.isArray(x) };
global_e['null?'] = function(x){return (!x || x.length === 0) };
global_e['equal?'] = function(a, b){return a === b };
global_e['join'] = function(){return [].slice.call(arguments).join(' '); };
global_e['display'] = function() {
  console.log(arguments.toSource()); 
  return arguments.toSource() 
};       
// booleans
global_e['not'] = function (a) { return !a };
global_e['or']  = function () {
  for (var ret=false, i=0; i< arguments.length; i++)
    if (arguments[i])
      return true;
  return ret;
};
global_e['and'] = function () {
  for (var ret=true, i=0; i< arguments.length; i++)
    if (!arguments[i])
      return false;
  return ret;
};
// math operators
global_e['++']  = function(){ return arguments[0]+1 };
global_e['--']  = function(){ return arguments[0]-1 };
global_e['+'] = function(){ 
  return [].slice.call(arguments).reduce( function(a,b){ return Number(a)+Number(b) }) };
global_e['*'] = function(){ 
  return [].slice.call(arguments).reduce( function(a,b){ return a*b }) };
global_e['-'] = function(){ 
  return [].slice.call(arguments).reduce( function(a,b){ return a-b }) };
global_e['/'] = function(){ 
  return [].slice.call(arguments).reduce( function(a,b){ return a/b }) };
global_e['< ']  = function(){ return arguments[0] < arguments[1] };
global_e['>']  = function(){ return arguments[0] > arguments[1] };

// the symbol "less then or equal : < =" is broken by the parser for HTML security :
// global_e['< ='] = function(){ return arguments[0] < = arguments[1] };
// global_e['>='] = function(){ return arguments[0] >= arguments[1] };
// the both are to be replaced by a "litteral symbol":
global_e['lte'] = function(){ 
  return arguments[0] < arguments[1] || arguments[0] == arguments[1]};
global_e['gte'] = function(){ 
  return arguments[0] > arguments[1] || arguments[0] == arguments[1] };

global_e['=']  = function (a,b) { 
  a=parseFloat(a); b=parseFloat(b); return (!(a< b) && !(b< a)) };
global_e['%'] = function (a,b) { return a % b;};
// math JS functions
var mathfns = 
['abs', 'acos', 'asin', 'atan', 'atan2', 'ceil', 'cos', 'exp', 'floor', 
'log', 'max', 'min', 'pow', 'random', 'round', 'sin', 'sqrt', 'tan'];
for (var i=0; i< mathfns.length; i++) { 
  global_e[mathfns[i]] = Math[mathfns[i]]; 
}
global_e['PI'] = function() { return Math.PI };
global_e['E'] = function() { return Math.E };
// end populating global_e
////////////////////////////////////////////////////////////////////////////////
// 2) EVALUATION
// functions evaluate and associated

var evaluate = function (x, e) {
   e = e || global_e;
   return ((eval