α-wwwiki

α-wwwiki :: history/psil/20130911-111740.txt

editor : alpha [82.249.88.162] 2013/09/11 11:17:40
_h1 psil (& [[psil2]])
_p I just discover on Github a [[smart pocket lisp interpreter|https://gist.github.com/pabloPXL/1679611]] written by [[Pablo Vidal|https://github.com/pabloPXL]].

_h3 code
{pre °°
// start dictionary / global environment
function env(){
  var inst  = this;
  inst.atom = function(a){ return atomp(a) };
  inst.set  = function(as){ return inst[as[0]] = as[1] };
  inst.quote = function(as){ return as[0] };
  inst.fst  = function(as){ return as[0][0] };
  inst.rst  = function(as){ return as[0].slice(1) };
  inst.cons = function(as){ return [as[0]].concat(as[1]) };
  inst.eq   = function(as){ return as[0] === as[1] };
  inst.cond = function(as,cx){ 
    return evaluate(as[0],cx) ? 
      evaluate(as[1],cx) : 
      evaluate(as[2],cx) 
  };

inst['+'] = function(as){ 
    for (var i=0, r=0; i< as.length; i++) r += as[i];
    return r;
  };
  inst['*'] = function(as){ 
    for (var i=0, r=1; i< as.length; i++) r *= as[i];
    return r;
  };
  inst['-'] = function(as){  return as[0] - as[1] };
  inst['/'] = function(as){  return as[0] / as[1] };
  inst['++'] = function(as){ as[0] = as[0] + 1; return as[0] };
  inst['--'] = function(as){ as[0] = as[0] - 1; return as[0] };

var mathfns = 
  ['abs', 'acos', 'asin', 'atan', 'atan2', 'ceil', 'cos', 'exp', 
  'floor', 'log', 'max', 'min', 'random', 'round', 'sin', 'sqrt', 'tan'];
  for (var i=0; i< mathfns.length; i++)
    inst[mathfns[i]] = function( tag ) { 
      return function (as) { return Math[tag](as[0]) } 
    }(mathfns[i]);

return inst;
}
// end dictionary / global environment

// start parser
function extended_cx( ar, cx ){
  var foo = function(o, kv){ 
   o[ kv[0] ] = kv[1]; 
   return o; 
  };
  return ar.reduce( foo, cx || {} );
}
function zip( ar1, ar2 ){
  var foo = function(ar, v1, i1){ 
   if (ar2[i1]) 
    ar.push( [v1,ar2[i1]] ); 
   return ar; 
  };
  return ar1.reduce( foo, [] );
}
function atomp( a ){ 
  return !(typeof a in {object:0,array:0}) 
}
function lazyp( a ){ 
  return (a in {cond:0,quote:0,lambda:0}) 
}
function apply( rf, as, cx ){
  return rf in cx && cx[rf].call ? 
    cx[rf].call(null, as, cx) : 
    evaluate( cx[rf][2], extended_cx( zip( cx[rf][1], as ), cx ) );
}
function evaluate( sx, cx ){
  if (atomp(sx))
    return sx in cx ? cx[sx] : sx;
  var rf = sx[0];
  var foo = function( a ){ 
   return lazyp(rf) ? a : evaluate(a, cx); 
  };
  var as = sx.slice(1).map( foo);
  return apply(rf, as, cx);
}
// end parser

°°}

_h3 test

{input {@ type="submit" value="Click on me !" onclick="°°
 
// start dictionary / global environment
function env(){
  var inst  = this;
  inst.atom = function(a){ return atomp(a) };
  inst.set  = function(as){ return inst[as[0]] = as[1] };
  inst.quote = function(as){ return as[0] };
  inst.fst  = function(as){ return as[0][0] };
  inst.rst  = function(as){ return as[0].slice(1) };
  inst.cons = function(as){ return [as[0]].concat(as[1]) };
  inst.eq   = function(as){ return as[0] === as[1] };
  inst.cond = function(as,cx){ 
    return evaluate(as[0],cx) ? 
      evaluate(as[1],cx) : 
      evaluate(as[2],cx) 
  };

return inst;
}
// end dictionary / global environment

// start test
function psil () {
  var cx = new env;
  var str = ''

+ '\nSTART TESTS'
+ '\n[set,a,42] -> ' + evaluate(['set','a',42],cx)
+ '\na -> ' + evaluate('a',cx)
+ '\n[eq,42,a] -> ' + evaluate(['eq',42,'a'],cx)
+ '\n[quote,[1,2]] -> ' + evaluate(['quote',[1,2]],cx)
+ '\n[fst,[quote,[1,2]]] -> ' + evaluate(['fst',['quote',[1,2]]],cx)
+ '\n[rst,[quote,[1,2]]] -> ' + evaluate(['rst',['quote',[1,2]]],cx)
+ '\n[cons,1,[quote,[2,3]]] -> ' + evaluate(['cons',1,['quote',[2,3]]],cx)
+ '\n[cond,[eq,1,2],42,43] -> ' + evaluate(['cond',['eq',1,2],42,43],cx)
+ '\n[atom,[quote,[1,2]]] -> ' + evaluate(['atom',['quote',[1,2]]],cx)
+ '\n[set,second,[quote,[lambda,[x],[fst,[rst,x]]]]] -> ' 
+ evaluate(['set','second',['quote',['lambda',['x'],['fst',['rst','x']]]]],cx)
+ '\n[second,[quote,[1,2,3]]] -> ' + evaluate(['second',['quote',[1,2,3]]],cx)
+ '\n'
+ '\n[set,y,10] -> ' + evaluate(['set','y',10],cx)
+ '\n[set,z,11] -> ' + evaluate(['set','z',11],cx)
+ '\n[cond,[eq,y,z],true,false] -> ' + evaluate(['cond',['eq','y','z'],true,false],cx)
+ '\n[++,10] -> ' + evaluate(['++',10],cx)
+ '\n[--,10] -> ' + evaluate(['--',10],cx)
+ '\n[*,1,2,3,4,5,6] -> ' + evaluate(['*',1,2,3,4,5,6],cx)

+ '\n'
+ '\nUSER FUNCTIONS'
+ '\n[set,cubic,[quote,[lambda,[x],[*,x,x,x]]]] -> ' 
+ evaluate( 
['set','cubic',['quote',['lambda',['x'],['*','x','x','x']]]],cx)
+ '\n[cubic,4] -> ' + evaluate(['cubic',4],cx)

+ '\n'
+ '\nJS MATH FUNCTIONS'
+ '\n[sqrt,2] -> ' + evaluate(['sqrt',2],cx)
+ '\n[exp,1] -> ' + evaluate(['exp',1],cx)

+ '\n'
+ '\nPYTHAGORE'
+ '\n[set,hypo,[quote,[lambda,[a,b],[sqrt,[+,[*,a,a],[*,b,b]]]]]] -> '
+ evaluate(
  ['set','hypo',
    ['quote',
      ['lambda',['a','b'],
        ['sqrt',
          ['+',
            ['*','a','a'],
            ['*','b','b']
          ]
        ]
      ]
    ]
  ],cx)

+ '\n[hypo,3,4] -> ' + evaluate(['hypo',3,4],cx)
+ '\n'
+ '\nDERIVEE'
+ '\n[set,derivee,[quote,[lambda,[f,x,dx],[/,[-,[f,[+,x,dx]],[f,[-,x,dx]]],[*,2,dx]]]]] -> '
+ '\n' + evaluate(
  ['set','derivee',
   ['quote',
     ['lambda',['f','x','dx'],
       ['/', 
         ['-',
           ['f', ['+','x','dx']],
           ['f', ['-','x','dx']]
         ],
         ['*',2,'dx']
       ]
     ]
   ]
  ],cx) 
+ '\n[derivee,sqrt,1,0.001] -> ' + evaluate(['derivee','sqrt',1,0.001],cx)

+ '\n'
+ '\nFACTORIAL'
+ '\n[set,fac,[quote,[lambda,[x],[cond,[eq,x,0],1,[*,[x],[fac,[--,x]]]]]]]'

+ '\n' + evaluate( 
  ['set','fac',
    ['quote',
      ['lambda',['x'], 
        ['cond', 
          ['eq','x',0],
            1, 
            ['*', 
            ['x'], 
            ['fac', ['--','x'] ]       
          ]    
        ]       
      ]
    ]
  ]
  ,cx) 
  
+ '\n[fac,6] -> TypeError: ar1 is undefined ?'  // + evaluate(['fac',6],cx)

return str;

}

getId('output').innerHTML = psil();
this.disabled = true;
°°"}}

{pre {@ id="output"}}

_p A lot to explore : Recursive functions, partial/currying, etc ...