]> gitweb.factorcode.org Git - factor.git/commitdiff
more prettyprinter fixes
authorSlava Pestov <slava@factorcode.org>
Sun, 21 Aug 2005 18:40:12 +0000 (18:40 +0000)
committerSlava Pestov <slava@factorcode.org>
Sun, 21 Aug 2005 18:40:12 +0000 (18:40 +0000)
library/compiler/compiler.factor
library/inference/print-dataflow.factor
library/syntax/prettyprint.factor
library/tools/debugger.factor
library/tools/inspector.factor
library/ui/presentations.factor

index ac37b982aea509ef2362a64bd8c5cfa04918f460..40d75018c894387628dd241e8ed2413a896b8414 100644 (file)
@@ -12,7 +12,7 @@ io kernel lists math namespaces prettyprint words ;
     ] unless ;
 
 : compiling ( word -- word parameter )
-    check-architecture "Compiling " write dup pp dup word-def ;
+    check-architecture "Compiling " write dup . dup word-def ;
 
 GENERIC: (compile) ( word -- )
 
@@ -41,7 +41,7 @@ M: compound (compile) ( word -- )
     "compile" get [ word compile ] when ; parsing
 
 : cannot-compile ( word error -- )
-    "Cannot compile " write swap pp print-error ;
+    "Cannot compile " write swap . print-error ;
 
 : try-compile ( word -- )
     [ compile ] [ [ cannot-compile ] when* ] catch ;
@@ -50,7 +50,7 @@ M: compound (compile) ( word -- )
 
 : decompile ( word -- )
     dup compiled? [
-        "Decompiling " write dup pp
+        "Decompiling " write dup .
         [ word-primitive ] keep set-word-primitive
     ] [
         drop
index 9fe0705decd6bf69f1f78c6a3122ef9531de002f..808684456f653f3669f76683de5208bed509e951 100644 (file)
@@ -82,4 +82,4 @@ M: #entry node>quot ( ? node -- ) "#entry" comment, ;
 : dataflow. ( quot ? -- )
     #! Print dataflow IR for a quotation. Flag indicates if
     #! annotations should be printed or not.
-    >r dataflow optimize r> dataflow>quot pp ;
+    >r dataflow optimize r> dataflow>quot . ;
index 83c18faa987f243dd11926c4707c4e4b591d79c1..2d0a2dc19a27ac39875a7acc782473565cd88d99 100644 (file)
@@ -244,17 +244,22 @@ M: wrapper pprint* ( wrapper -- )
 : pprint>string ( object -- string )
     [ pprint ] string-out ;
 
-: pp ( obj -- ) pprint terpri ;
+: . ( obj -- ) pprint terpri ;
 
-: . ( obj -- )
-    [ 2 nesting-limit set 100 length-limit set pp ] with-scope ;
+: pprint-short ( object -- string )
+    [
+        1 line-limit set
+        5 length-limit set
+        2 nesting-limit set
+        pprint
+    ] with-scope ;
+
+: pprint>short-string ( object -- string )
+    [ pprint-short ] string-out ;
 
 : [.] ( sequence -- )
     #! Unparse each element on its own line.
-    [
-        1 line-limit set 10 length-limit set
-        [ pp ] each
-    ] with-scope ;
+    [ [ pprint>short-string print ] each ] with-scope ;
 
 : stack. reverse-slice [.] ;
 
index b22e6774e453fa575d18124e8e4d2d1edee94f16..674004dc26481920fc231fd53391c93cc3d17280 100644 (file)
@@ -17,8 +17,8 @@ vectors words ;
 : type-check-error. ( list -- )
     "Type check error" print
     uncons car dup "Object: " write .
-    "Object type: " write class pp
-    "Expected type: " write type>class pp ;
+    "Object type: " write class .
+    "Expected type: " write type>class . ;
 
 : float-format-error. ( list -- )
     "Invalid floating point literal format: " write . ;
index 43dd1c2470413dc9c06748cf3d443d7f19869aa4..48d604f5dd621f75c94afdc9b8842e3dc3d5a963 100644 (file)
@@ -15,9 +15,7 @@ M: object sheet ( obj -- sheet )
     tuck [ execute ] map-with
     2list ;
 
-PREDICATE: list nonvoid cons? ;
-
-M: nonvoid sheet unit ;
+M: list sheet unit ;
 
 M: vector sheet unit ;
 
@@ -26,7 +24,7 @@ M: array sheet unit ;
 M: hashtable sheet dup hash-keys swap hash-values 2list ;
 
 : format-column ( list -- list )
-    [ unparse ] map
+    [ pprint>short-string ] map
     [ max-length ] keep
     [ swap CHAR: \s pad-right ] map-with ;
 
@@ -45,7 +43,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2list ;
             "This is an orphan not part of the dictionary." print
             "It claims to belong to the " write
         ] ifte
-        word-vocabulary unparse write " vocabulary." print
+        word-vocabulary pprint " vocabulary." print
     ] [
         drop
         "The word is a uniquely generated symbol." print
@@ -65,7 +63,7 @@ M: object extra-banner ( obj -- ) drop ;
 : inspect-banner ( obj -- )
     "You are looking at an instance of the " write dup class pprint
     " class:" print
-    "  " write dup pp
+    "  " write dup pprint-short terpri
     "It takes up " write dup size pprint " bytes of memory." print
     extra-banner ;
 
index 29a2fd396bbcddb5be0dc5451a66ed4827e36be7..a937f248f5a3db4729f2185bf04c2ef79f139553 100644 (file)
@@ -47,7 +47,7 @@ global [ 100 <vector> commands set ] bind
     "This stream does not support live gadgets"
     swap format terpri ;
 
-[ drop t ] "Prettyprint" [ pp ] define-command
+[ drop t ] "Prettyprint" [ . ] define-command
 [ drop t ] "Inspect" [ inspect ] define-command
 [ drop t ] "References" [ references inspect ] define-command