unparser generified

diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor
index 682146e059a75324620239ad5a060a5cdfd7d7a7..dfe891c5f28bf2c90e13bc527bf24f359936de5f 100644 (file)
--- a/library/syntax/unparser.factor
+++ b/library/syntax/unparser.factor
@@ -26,6 +26,7 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 IN: unparser
+USE: generic
 USE: kernel
 USE: format
 USE: lists
@@ -36,6 +37,17 @@ USE: stdio
 USE: strings
 USE: words
 
+GENERIC: unparse ( obj -- str )
+
+M: object unparse ( obj -- str )
+    [
+        "#<" ,
+        dup type type-name ,
+        " @ " , 
+        address unparse ,
+        ">" ,
+    ] make-string ;
+
 : >digit ( n -- ch )
     dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
 
@@ -61,9 +73,10 @@ USE: words
 : >oct ( num -- string ) 8 >base ;
 : >hex ( num -- string ) 16 >base ;
 
-DEFER: unparse
+M: fixnum unparse ( obj -- str ) >dec ;
+M: bignum unparse ( obj -- str ) >dec ;
 
-: unparse-ratio ( num -- str )
+M: ratio unparse ( num -- str )
     [
         dup
         numerator unparse ,
@@ -71,7 +84,15 @@ DEFER: unparse
         denominator unparse ,
     ] make-string ;
 
-: unparse-complex ( num -- str )
+: fix-float ( str -- str )
+    #! This is terrible. Will go away when we do our own float
+    #! output.
+    "." over str-contains? [ ".0" cat2 ] unless ;
+
+M: float unparse ( float -- str )
+    (unparse-float) fix-float ;
+
+M: complex unparse ( num -- str )
     [
         "#{ " ,
         dup
@@ -104,50 +125,13 @@ DEFER: unparse
         ] ifte
     ] unless ;
 
-: unparse-str ( str -- str )
+M: string unparse ( str -- str )
     [
         CHAR: " , [ unparse-ch , ] str-each CHAR: " ,
     ] make-string ;
 
-: unparse-word ( word -- str )
+M: word unparse ( obj -- str )
     word-name dup "#<unnamed>" ? ;
 
-: fix-float ( str -- str )
-    #! This is terrible. Will go away when we do our own float
-    #! output.
-    "." over str-contains? [ ".0" cat2 ] unless ;
-
-: unparse-float ( float -- str ) (unparse-float) fix-float ;
-
-: unparse-unknown ( obj -- str )
-    [
-        "#<" ,
-        dup type type-name ,
-        " @ " , 
-        address unparse ,
-        ">" ,
-    ] make-string ;
-
-: unparse-t drop "t" ;
-: unparse-f drop "f" ;
-
-: unparse ( obj -- str )
-    {
-        [ >dec            ]
-        [ unparse-word    ]
-        [ unparse-unknown ]
-        [ unparse-unknown ]
-        [ unparse-ratio   ]
-        [ unparse-complex ]
-        [ unparse-f       ]
-        [ unparse-t       ]
-        [ unparse-unknown ]
-        [ >dec            ]
-        [ unparse-float   ]
-        [ unparse-unknown ]
-        [ unparse-str     ]
-        [ unparse-unknown ]
-        [ unparse-unknown ]
-        [ unparse-unknown ]
-        [ unparse-unknown ]
-    } generic ;
+M: t unparse drop "t" ;
+M: f unparse drop "f" ;

diff --git a/library/test/generic.factor b/library/test/generic.factor
index 62f8f14b5d3731b1dffd2c48444729b2b255766a..801035b794e3c87cad9bd4e44d71c468aca1e1ee 100644 (file)
--- a/library/test/generic.factor
+++ b/library/test/generic.factor
@@ -77,3 +77,16 @@ M: fixnum foobar drop "Goodbye cruel world" ;
 
 [ "Hello world" ] [ 4 foobar foobar ] unit-test
 [ "Goodbye cruel world" ] [ 4 foobar ] unit-test
+
+GENERIC: bool>str
+M: t bool>str drop "true" ;
+M: f bool>str drop "false" ;
+
+: str>bool
+    [
+        [ "true" | t ]
+        [ "false" | f ]
+    ] assoc ;
+
+[ t ] [ t bool>str str>bool ] unit-test
+[ f ] [ f bool>str str>bool ] unit-test

diff --git a/library/test/unparser.factor b/library/test/unparser.factor
index fb29224e02ae5feb59baaee573ee4871c1dc425f..e540ff9dfaae4dab694e1d6911faaffcfd98f727 100644 (file)
--- a/library/test/unparser.factor
+++ b/library/test/unparser.factor
@@ -4,6 +4,8 @@ USE: math
 USE: parser
 USE: test
 USE: unparser
+USE: kernel
+USE: io-internals
 
 [ "\"hello\\\\backslash\"" ]
 [ "hello\\backslash" ]
@@ -26,3 +28,6 @@ test-word
 [ "car" ] [ \ car unparse ] unit-test
 [ "#{ 1/2 2/3 }" ] [ #{ 1/2 2/3 } unparse ] unit-test
 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
+
+[ ] [ { 1 2 3 } unparse drop ] unit-test
+[ stdin unparse parse ] unit-test-fails

diff --git a/library/types.factor b/library/types.factor
index a955940bf1c6fcc258f2f4ce36e9e58dc1b009fc..12384f40a13b428c4f9517c59c2af6a5140010dd 100644 (file)
--- a/library/types.factor
+++ b/library/types.factor
@@ -35,6 +35,8 @@ IN: words        BUILTIN: word    1
 IN: lists        BUILTIN: cons    2
 IN: math         BUILTIN: ratio   4
 IN: math         BUILTIN: complex 5
+IN: syntax       BUILTIN: f       6 FORGET: f?
+IN: syntax       BUILTIN: t       7 FORGET: t?
 IN: math         BUILTIN: bignum  9
 IN: math         BUILTIN: float   10
 IN: vectors      BUILTIN: vector  11