fjsc: add arrays, reduce, map, etc

apps/furnace-fjsc/repl.fhtml

@@ -1,5 +1,5 @@
 <form id="toeval" onsubmit="factor.fjsc_eval(document.getElementById('toeval'));return false;" method="post">
-  <textarea name="code" id="code">
+  <textarea name="code" id="code" cols="64" rows="10">
   </textarea>
   <input type="submit"/>
 </form>

apps/furnace-fjsc/resources/bootstrap.js

@@ -10,6 +10,10 @@ function Factor() {
     "*": function() { self.fjsc_times(); },
     "/": function() { self.fjsc_divide(); },
     ".": function() { self.fjsc_dot(); },
+    "call": function() { self.fjsc_call(); },
+    "map": function() { self.fjsc_map(); },
+    "reduce": function() { self.fjsc_reduce(); },
+    "clear": function() { self.fjsc_clear(); },
     alert: function() { self.fjsc_alert(); }
   };  
 }
@@ -92,9 +96,42 @@ Factor.prototype.fjsc_dot = function() {
   alert(this.data_stack.pop());
 }
 
+Factor.prototype.fjsc_call = function() {
+  (this.data_stack.pop())();
+}
+
+Factor.prototype.fjsc_map = function() {
+  var quot = this.data_stack.pop();
+  var seq = this.data_stack.pop();
+  var result = [ ];
+  for(var i=0;i<seq.length;++i) {  
+    this.data_stack.push(seq[i]);
+    (quot)();
+    result[i]=this.data_stack.pop();
+  }
+  this.data_stack.push(result);
+}
+
+Factor.prototype.fjsc_reduce = function() {
+  var quot = this.data_stack.pop();
+  var prev = this.data_stack.pop();
+  var seq = this.data_stack.pop();
+  for(var i=0;i<seq.length;++i) {  
+    this.data_stack.push(prev);
+    this.data_stack.push(seq[i]);
+    (quot)();
+    prev=this.data_stack.pop();
+  }
+  this.data_stack.push(prev);
+}
+
 Factor.prototype.fjsc_alert = function() {
   alert(this.data_stack.pop());
 }
 
+Factor.prototype.fjsc_clear = function() {
+  factor.data_stack = [ ]
+}
+
 
 var factor = new Factor();

libs/fjsc/fjsc.factor

@@ -7,6 +7,8 @@ USING: kernel lazy-lists parser-combinators strings math sequences namespaces io
 TUPLE: ast-number value ;
 TUPLE: ast-identifier value ;
 TUPLE: ast-string value ;
+TUPLE: ast-quotation expression ;
+TUPLE: ast-array elements ;
 TUPLE: ast-define name expression ;
 TUPLE: ast-expression values ;
 
@@ -27,20 +29,28 @@ LAZY: 'string' ( -- parser )
 LAZY: 'identifier-ends' ( -- parser )  
   [ 
     [ blank? not ] keep 
+    [ CHAR: [ = not ] keep 
+    [ CHAR: ] = not ] keep 
+    [ CHAR: { = not ] keep 
+    [ CHAR: } = not ] keep 
     [ CHAR: : = not ] keep 
     [ CHAR: " = not ] keep 
     CHAR: ; = not 
-    and and and 
+    and and and and and and and
   ] satisfy <*> ;
 
 LAZY: 'identifier-middle' ( -- parser )  
   [ 
     [ blank? not ] keep 
+    [ CHAR: [ = not ] keep 
+    [ CHAR: ] = not ] keep 
+    [ CHAR: { = not ] keep 
+    [ CHAR: } = not ] keep 
     [ CHAR: : = not ] keep 
     [ CHAR: " = not ] keep 
     [ CHAR: ; = not ] keep
     digit? not
-    and and and and
+    and and and and and and and and
   ] satisfy <+> ;
 
 USE: prettyprint
@@ -56,29 +66,55 @@ LAZY: 'define' ( -- parser )
   'expression' <&>
   ";" token sp <& [ first2 <ast-define> ] <@ ;
 
+LAZY: 'quotation' ( -- parser )
+  "[" token sp 
+  'expression' &>
+  "]" token sp <& [ <ast-quotation> ] <@ ;
+
+LAZY: 'array' ( -- parser )
+  "{" token sp 
+  'expression' &>
+  "}" token sp <& [ <ast-array> ] <@ ;
+
 LAZY: 'atom' ( -- parser )
   'identifier' 'number' <|> 'string' <|> ;
 
 LAZY: 'expression' ( -- parser )
-  'define' sp 'atom' sp <|> <*> [ <ast-expression> ] <@ ;
+  'define' sp 
+  'atom' sp <|> 
+  'quotation' sp <|> 
+  'array' sp <|>
+  <*> [ <ast-expression> ] <@ ;
 
 LAZY: 'statement' ( -- parser )
   'define' 'expression' <|> ;
 
 GENERIC: (compile) ( ast -- )
+GENERIC: (literal) ( ast -- )
+
+M: ast-number (literal) 
+  ast-number-value number>string , ;
 
 M: ast-number (compile) 
   "factor.data_stack.push(" ,
-  ast-number-value number>string , 
+  (literal)  
-  ")" , ;
+  ");" , ;
+
+M: ast-string (literal) 
+  "'" ,
+  ast-string-value ,
+  "'" , ;
 
 M: ast-string (compile) 
-  "factor.data_stack.push('" ,
+  "factor.data_stack.push(" ,
-  ast-string-value , 
+  (literal)
-  "')" , ;
+  ");" , ;
+
+M: ast-identifier (literal) 
+  "factor.words[\"" , ast-identifier-value , "\"]" ,  ;
 
 M: ast-identifier (compile) 
-  "factor.words[\"" , ast-identifier-value , "\"]()" ,  ;
+  (literal) "();" ,  ;
 
 M: ast-define (compile) 
   "factor.words[\"" , 
@@ -87,13 +123,41 @@ M: ast-define (compile)
   ast-define-expression (compile)
   "}" , ;
 
-M: ast-expression (compile)
+M: ast-quotation (literal)   
+  "function() { " ,  
+  ast-quotation-expression (compile)
+  "}" , ;
+
+M: ast-quotation (compile)   
+  "factor.data_stack.push(" ,  
+  (literal)
+  ")" , ;
+
+M: ast-array (literal)   
+  "[" ,  
+  ast-array-elements ast-expression-values [ (literal) ] [ "," , ] interleave
+  "]" , ;
+
+M: ast-array (compile)   
+  "factor.data_stack.push(" ,  
+  (literal)
+  ")" , ;
+
+M: ast-expression (literal)
   ast-expression-values [
-    (compile) "; " ,
+    (literal) 
   ] each ;
 
+M: ast-expression (compile)
+  ast-expression-values [ (compile) ] [ ";" , ] interleave ;
+
 : fjsc-compile ( ast -- string )
   [
     [ (compile) ] { } make [ write ] each
   ] string-out ;
   
+: fjsc-literal ( ast -- string )
+  [
+    [ (literal) ] { } make [ write ] each
+  ] string-out ;
+  

libs/fjsc/tests.factor

@@ -8,23 +8,31 @@ IN: temporary
   "55 2abc1 100" 'expression' parse car parse-result-parsed
 ] unit-test
 
-{ "factor.words[\"alert\"]()" } [
+{ T{ ast-quotation f T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } } [
+  "[ 55 2abc1 100 ]" 'quotation' parse car parse-result-parsed
+] unit-test
+
+{ T{ ast-array f T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } } [
+  "{ 55 2abc1 100 }" 'array' parse car parse-result-parsed
+] unit-test
+
+{ "factor.words[\"alert\"]();" } [
   "alert" 'identifier' parse car parse-result-parsed fjsc-compile 
 ] unit-test
 
-{ "factor.data_stack.push(123); factor.words[\"alert\"](); " } [
+{ "factor.data_stack.push(123);factor.words[\"alert\"]();" } [
   "123 alert" 'expression' parse car parse-result-parsed fjsc-compile 
 ] unit-test
 
-{ "factor.data_stack.push(123); factor.data_stack.push('hello'); factor.words[\"alert\"](); " } [
+{ "factor.data_stack.push(123);factor.data_stack.push('hello');factor.words[\"alert\"]();" } [
   "123 \"hello\" alert" 'expression' parse car parse-result-parsed fjsc-compile 
 ] unit-test
  
-{ "factor.words[\"foo\"]=function() { factor.data_stack.push(123); factor.data_stack.push('hello'); }" } [
+{ "factor.words[\"foo\"]=function() { factor.data_stack.push(123);factor.data_stack.push('hello');}" } [
   ": foo 123 \"hello\" ;" 'define' parse car parse-result-parsed fjsc-compile 
 ] unit-test
 
-{ "factor.words[\"foo\"]=function() { factor.data_stack.push(123); factor.data_stack.push('hello'); }; " } [
+{ "factor.words[\"foo\"]=function() { factor.data_stack.push(123);factor.data_stack.push('hello');}" } [
   ": foo 123 \"hello\" ;" 'expression' parse car parse-result-parsed fjsc-compile 
 ] unit-test