]> gitweb.factorcode.org Git - factor.git/commitdiff
Use new style accessors in fjsc
authorChris Double <chris@bethia.(none)>
Thu, 10 Jul 2008 23:28:47 +0000 (11:28 +1200)
committerChris Double <chris@bethia.(none)>
Thu, 10 Jul 2008 23:37:02 +0000 (11:37 +1200)
extra/fjsc/fjsc.factor

index ecefd862d3572676f9547887725eae579501ce1d..5f1f977d20ca47e8017c331606704a9fe3c96b6e 100755 (executable)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2006 Chris Double. All Rights Reserved.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel peg strings promises sequences math
+USING: accessors kernel peg strings sequences math
 math.parser namespaces words quotations arrays hashtables io
-io.streams.string assocs ascii peg.parsers ;
+io.streams.string assocs ascii peg.parsers accessors ;
 IN: fjsc
 
 TUPLE: ast-number value ;
@@ -20,21 +20,6 @@ TUPLE: ast-using names ;
 TUPLE: ast-in name ;
 TUPLE: ast-hashtable elements ;
 
-C: <ast-number> ast-number
-C: <ast-identifier> ast-identifier
-C: <ast-string> ast-string
-C: <ast-quotation> ast-quotation
-C: <ast-array> ast-array
-C: <ast-define> ast-define
-C: <ast-expression> ast-expression
-C: <ast-word> ast-word
-C: <ast-comment> ast-comment
-C: <ast-stack-effect> ast-stack-effect
-C: <ast-use> ast-use
-C: <ast-using> ast-using
-C: <ast-in> ast-in
-C: <ast-hashtable> ast-hashtable
-
 : identifier-middle? ( ch -- bool )
   [ blank? not ] keep
   [ "}];\"" member? not ] keep
@@ -61,7 +46,7 @@ C: <ast-hashtable> ast-hashtable
     'identifier-middle' ,
     'identifier-ends' ,
   ] seq* [
-    concat >string f <ast-identifier>
+    concat >string f ast-identifier boa
   ] action ;
 
 
@@ -83,43 +68,43 @@ DEFER: 'expression'
     'effect-name' sp repeat0 ,
     ")" token sp hide ,
   ] seq* [
-    first2 <ast-stack-effect>
+    first2 ast-stack-effect boa
   ] action ;
 
 : 'define' ( -- parser )
   [
     ":" token sp hide ,
-    'identifier' sp [ ast-identifier-value ] action ,
+    'identifier' sp [ value>> ] action ,
     'stack-effect' sp optional ,
     'expression' ,
     ";" token sp hide ,
-  ] seq* [ first3 <ast-define> ] action ;
+  ] seq* [ first3 ast-define boa ] action ;
 
 : 'quotation' ( -- parser )
   [
     "[" token sp hide ,
-    'expression' [ ast-expression-values ] action ,
+    'expression' [ values>> ] action ,
     "]" token sp hide ,
-  ] seq* [ first <ast-quotation> ] action ;
+  ] seq* [ first ast-quotation boa ] action ;
 
 : 'array' ( -- parser )
   [
     "{" token sp hide ,
-    'expression' [ ast-expression-values ] action ,
+    'expression' [ values>> ] action ,
     "}" token sp hide ,
-  ] seq* [ first <ast-array> ] action ;
+  ] seq* [ first ast-array boa ] action ;
 
 : 'word' ( -- parser )
   [
     "\\" token sp hide ,
     'identifier' sp ,
-  ] seq* [ first ast-identifier-value f <ast-word> ] action ;
+  ] seq* [ first value>> f ast-word boa ] action ;
 
 : 'atom' ( -- parser )
   [
     'identifier' ,
-    'integer' [ <ast-number> ] action ,
-    'string' [ <ast-string> ] action ,
+    'integer' [ ast-number boa ] action ,
+    'string' [ ast-string boa ] action ,
   ] choice* ;
 
 : 'comment' ( -- parser )
@@ -131,33 +116,33 @@ DEFER: 'expression'
     [
       dup CHAR: \n = swap CHAR: \r = or not
     ] satisfy repeat0 ,
-  ] seq* [ drop <ast-comment> ] action ;
+  ] seq* [ drop ast-comment boa ] action ;
 
 : 'USE:' ( -- parser )
   [
     "USE:" token sp hide ,
     'identifier' sp ,
-  ] seq* [ first ast-identifier-value <ast-use> ] action ;
+  ] seq* [ first value>> ast-use boa ] action ;
 
 : 'IN:' ( -- parser )
   [
     "IN:" token sp hide ,
     'identifier' sp ,
-  ] seq* [ first ast-identifier-value <ast-in> ] action ;
+  ] seq* [ first value>> ast-in boa ] action ;
 
 : 'USING:' ( -- parser )
   [
     "USING:" token sp hide ,
-    'identifier' sp [ ast-identifier-value ] action repeat1 ,
+    'identifier' sp [ value>> ] action repeat1 ,
     ";" token sp hide ,
-  ] seq* [ first <ast-using> ] action ;
+  ] seq* [ first ast-using boa ] action ;
 
 : 'hashtable' ( -- parser )
   [
     "H{" token sp hide ,
-    'expression' [ ast-expression-values ] action ,
+    'expression' [ values>> ] action ,
     "}" token sp hide ,
-  ] seq* [ first <ast-hashtable> ] action ;
+  ] seq* [ first ast-hashtable boa ] action ;
 
 : 'parsing-word' ( -- parser )
   [
@@ -177,7 +162,7 @@ DEFER: 'expression'
       'hashtable' sp ,
       'word' sp ,
       'atom' sp ,
-    ] choice* repeat0 [ <ast-expression> ] action
+    ] choice* repeat0 [ ast-expression boa ] action
   ] delay ;
 
 : 'statement' ( -- parser )
@@ -187,7 +172,7 @@ GENERIC: (compile) ( ast -- )
 GENERIC: (literal) ( ast -- )
 
 M: ast-number (literal)
-  ast-number-value number>string , ;
+  value>> number>string , ;
 
 M: ast-number (compile)
   "factor.push_data(" ,
@@ -196,7 +181,7 @@ M: ast-number (compile)
 
 M: ast-string (literal)
   "\"" ,
-  ast-string-value ,
+  value>> ,
   "\"" , ;
 
 M: ast-string (compile)
@@ -205,14 +190,14 @@ M: ast-string (compile)
   "," , ;
 
 M: ast-identifier (literal)
-  dup ast-identifier-vocab [
+  dup vocab>> [
    "factor.get_word(\"" ,
-   dup ast-identifier-vocab ,
+   dup vocab>> ,
    "\",\"" ,
-   ast-identifier-value ,
+   value>> ,
    "\")" ,
   ] [
-   "factor.find_word(\"" , ast-identifier-value , "\")" ,
+   "factor.find_word(\"" , value>> , "\")" ,
   ] if ;
 
 M: ast-identifier (compile)
@@ -220,9 +205,9 @@ M: ast-identifier (compile)
 
 M: ast-define (compile)
   "factor.define_word(\"" ,
-  dup ast-define-name ,
+  dup name>> ,
   "\",\"source\"," ,
-  ast-define-expression (compile)
+  expression>> (compile)
   "," , ;
 
 : do-expressions ( seq -- )
@@ -242,17 +227,17 @@ M: ast-define (compile)
 
 M: ast-quotation (literal)
   "factor.make_quotation(\"source\"," ,
-  ast-quotation-values do-expressions
+  values>> do-expressions
   ")" , ;
 
 M: ast-quotation (compile)
   "factor.push_data(factor.make_quotation(\"source\"," ,
-  ast-quotation-values do-expressions
+  values>> do-expressions
   ")," , ;
 
 M: ast-array (literal)
   "[" ,
-  ast-array-elements [ "," , ] [ (literal) ] interleave
+  elements>> [ "," , ] [ (literal) ] interleave
   "]" , ;
 
 M: ast-array (compile)
@@ -260,7 +245,7 @@ M: ast-array (compile)
 
 M: ast-hashtable (literal)
   "new Hashtable().fromAlist([" ,
-  ast-hashtable-elements [ "," , ] [ (literal) ] interleave
+  elements>> [ "," , ] [ (literal) ] interleave
   "])" , ;
 
 M: ast-hashtable (compile)
@@ -268,22 +253,22 @@ M: ast-hashtable (compile)
 
 
 M: ast-expression (literal)
-  ast-expression-values [
+  values>> [
     (literal)
   ] each ;
 
 M: ast-expression (compile)
-  ast-expression-values do-expressions ;
+  values>> do-expressions ;
 
 M: ast-word (literal)
-  dup ast-word-vocab [
+  dup vocab>> [
    "factor.get_word(\"" ,
-   dup ast-word-vocab ,
+   dup vocab>> ,
    "\",\"" ,
-   ast-word-value ,
+   value>> ,
    "\")" ,
   ] [
-   "factor.find_word(\"" , ast-word-value , "\")" ,
+   "factor.find_word(\"" , value>> , "\")" ,
   ] if ;
 
 M: ast-word (compile)
@@ -299,17 +284,17 @@ M: ast-stack-effect (compile)
 
 M: ast-use (compile)
   "factor.use(\"" ,
-  ast-use-name ,
+  name>> ,
   "\"," , ;
 
 M: ast-in (compile)
   "factor.set_in(\"" ,
-  ast-in-name ,
+  name>> ,
   "\"," , ;
 
 M: ast-using (compile)
   "factor.using([" ,
-  ast-using-names [
+  names>> [
     "," ,
   ] [
     "\"" , , "\"" ,
@@ -319,34 +304,34 @@ M: ast-using (compile)
 GENERIC: (parse-factor-quotation) ( object -- ast )
 
 M: number (parse-factor-quotation) ( object -- ast )
-  <ast-number> ;
+  ast-number boa ;
 
 M: symbol (parse-factor-quotation) ( object -- ast )
-  dup >string swap vocabulary>> <ast-identifier> ;
+  dup >string swap vocabulary>> ast-identifier boa ;
 
 M: word (parse-factor-quotation) ( object -- ast )
-  dup name>> swap vocabulary>> <ast-identifier> ;
+  dup name>> swap vocabulary>> ast-identifier boa ;
 
 M: string (parse-factor-quotation) ( object -- ast )
-  <ast-string> ;
+  ast-string boa ;
 
 M: quotation (parse-factor-quotation) ( object -- ast )
   [
     [ (parse-factor-quotation) , ] each
-  ] { } make <ast-quotation> ;
+  ] { } make ast-quotation boa ;
 
 M: array (parse-factor-quotation) ( object -- ast )
   [
     [ (parse-factor-quotation) , ] each
-  ] { } make <ast-array> ;
+  ] { } make ast-array boa ;
 
 M: hashtable (parse-factor-quotation) ( object -- ast )
   >alist [
     [ (parse-factor-quotation) , ] each
-  ] { } make <ast-hashtable> ;
+  ] { } make ast-hashtable boa ;
 
 M: wrapper (parse-factor-quotation) ( object -- ast )
-  wrapped>> dup name>> swap vocabulary>> <ast-word> ;
+  wrapped>> dup name>> swap vocabulary>> ast-word boa ;
 
 GENERIC: fjsc-parse ( object -- ast )
 
@@ -356,7 +341,7 @@ M: string fjsc-parse ( object -- ast )
 M: quotation fjsc-parse ( object -- ast )
   [
     [ (parse-factor-quotation) , ] each
-  ] { } make <ast-expression> ;
+  ] { } make ast-expression boa ;
 
 : fjsc-compile ( ast -- string )
   [
@@ -372,7 +357,7 @@ M: quotation fjsc-parse ( object -- ast )
 
 : fc* ( string -- string )
   [
-  'statement' parse parse-result-ast ast-expression-values do-expressions
+  'statement' parse parse-result-ast values>> do-expressions
   ] { } make [ write ] each ;