]> gitweb.factorcode.org Git - factor.git/commitdiff
math.parser: cleanup uses of 16/8/2 >base/base>.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 14 Oct 2011 17:09:12 +0000 (10:09 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 14 Oct 2011 17:09:12 +0000 (10:09 -0700)
basis/prettyprint/backend/backend.factor
basis/tools/disassembler/utils/utils.factor
basis/uuid/uuid.factor
core/math/parser/parser.factor
extra/cpu/8080/emulator/emulator.factor
unmaintained/dns/dns.factor

index 9352673a61a3ac9e287e142c4b2426d0a5b05aac..5d41f4af002d1cb3852ea94412fbb6946a806bc1 100644 (file)
@@ -48,9 +48,9 @@ M: method pprint*
 
 M: real pprint*
     number-base get {
-        { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
-        {  8 [ \ OCT: [  8 >base text ] pprint-prefix ] }
-        {  2 [ \ BIN: [  2 >base text ] pprint-prefix ] }
+        { 16 [ \ HEX: [ >hex text ] pprint-prefix ] }
+        {  8 [ \ OCT: [ >oct text ] pprint-prefix ] }
+        {  2 [ \ BIN: [ >bin text ] pprint-prefix ] }
         [ drop number>string text ]
     } case ;
 
@@ -59,7 +59,7 @@ M: float pprint*
         \ NAN: [ fp-nan-payload >hex text ] pprint-prefix
     ] [
         number-base get {
-            { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
+            { 16 [ \ HEX: [ >hex text ] pprint-prefix ] }
             [ drop number>string text ]
         } case
     ] if ;
index 11981c81ae290cfa336602448357f583ca95f2e6..e3a5e18affd3659e94a8c68997937aa4012edf41 100644 (file)
@@ -6,14 +6,14 @@ IN: tools.disassembler.utils
 
 : complete-address ( n seq -- str )
     [ nip owner>> unparse-short ] [ entry-point>> - ] 2bi
-    [ 16 >base 0x " + " glue ] unless-zero ;
+    [ >hex 0x " + " glue ] unless-zero ;
 
 : search-xt ( addr -- str/f )
     dup lookup-return-address
     dup [ complete-address ] [ 2drop f ] if ;
 
 : resolve-xt ( str -- str' )
-    [ 0x ] [ 16 base> ] bi
+    [ 0x ] [ hex> ] bi
     [ search-xt [ " (" ")" surround append ] when* ] when* ;
 
 : resolve-call ( str -- str' )
index 6c1e1de55b05ea96abac24aa3326384fd5037561..a41a5e868fc36b58b93a7b4ecceba4b9f8bf1d1a 100644 (file)
@@ -48,7 +48,7 @@ IN: uuid
     [ CHAR: - 8 ] dip insert-nth ;
  
 : string>uuid ( string -- n )
-    [ CHAR: - = not ] filter 16 base> ;
+    [ CHAR: - = not ] filter hex> ;
 
 PRIVATE>
 
index 14fd6a298392451ad9749fe63dc998fa67eed173..31ab2e7da9b544dcf542d52b543b8ebf1b9a25e0 100644 (file)
@@ -279,6 +279,11 @@ PRIVATE>
 
 GENERIC# >base 1 ( n radix -- str )
 
+: number>string ( n -- str ) 10 >base ; inline
+: >bin ( n -- str ) 2 >base ; inline
+: >oct ( n -- str ) 8 >base ; inline
+: >hex ( n -- str ) 16 >base ; inline
+
 <PRIVATE
 
 SYMBOL: radix
@@ -345,7 +350,7 @@ M: ratio >base
     -0.0 double>bits bitand zero? "" "-" ? ;
 
 : float>hex-value ( mantissa -- str )
-    16 >base 13 CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
+    >hex 13 CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
     [ "0" ] [ ] if-empty "1." prepend ;
 
 : float>hex-expt ( mantissa -- str )
@@ -383,9 +388,4 @@ M: float >base
         [ float>base ]
     } cond ;
 
-: number>string ( n -- str ) 10 >base ; inline
-: >bin ( n -- str ) 2 >base ; inline
-: >oct ( n -- str ) 8 >base ; inline
-: >hex ( n -- str ) 16 >base ; inline
-
 : # ( n -- ) number>string % ; inline
index 73c7560416d76ab8bebf722e19a12f7c4b9820f5..eff9b6db2a88927beedb4d721960690ad078b2f3 100644 (file)
@@ -400,7 +400,7 @@ CONSTANT: sign-flag         HEX: 80
  
 : interrupt ( number cpu -- )
   #! Perform a hardware interrupt
-!  "***Interrupt: " write over 16 >base print 
+!  "***Interrupt: " write over >hex print
   dup f>> interrupt-flag bitand 0 = not [
     dup push-pc
     pc<<
@@ -528,32 +528,32 @@ SYMBOL: rom-root
   [ pc>> ] keep read-byte instructions nth first ;
 
 : cpu. ( cpu -- )
-  [ " PC: " write pc>> 16 >base 4 CHAR: \s pad-head write ] keep 
-  [ " B: " write b>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " C: " write c>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " D: " write d>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " E: " write e>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " F: " write f>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " H: " write h>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " L: " write l>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " A: " write a>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " SP: " write sp>> 16 >base 4 CHAR: \s pad-head write ] keep 
-  [ " cycles: " write cycles>> number>string 5 CHAR: \s pad-head write ] keep 
+  [ " PC: " write pc>> >hex 4 CHAR: \s pad-head write ] keep
+  [ " B: " write b>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " C: " write c>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " D: " write d>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " E: " write e>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " F: " write f>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " H: " write h>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " L: " write l>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " A: " write a>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " SP: " write sp>> >hex 4 CHAR: \s pad-head write ] keep
+  [ " cycles: " write cycles>> number>string 5 CHAR: \s pad-head write ] keep
   [ " " write peek-instruction name>> write " " write ] keep
   nl drop ;
 
 : cpu*. ( cpu -- )
-  [ " PC: " write pc>> 16 >base 4 CHAR: \s pad-head write ] keep 
-  [ " B: " write b>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " C: " write c>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " D: " write d>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " E: " write e>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " F: " write f>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " H: " write h>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " L: " write l>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " A: " write a>> 16 >base 2 CHAR: \s pad-head write ] keep 
-  [ " SP: " write sp>> 16 >base 4 CHAR: \s pad-head write ] keep 
-  [ " cycles: " write cycles>> number>string 5 CHAR: \s pad-head write ] keep 
+  [ " PC: " write pc>> >hex 4 CHAR: \s pad-head write ] keep
+  [ " B: " write b>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " C: " write c>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " D: " write d>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " E: " write e>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " F: " write f>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " H: " write h>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " L: " write l>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " A: " write a>> >hex 2 CHAR: \s pad-head write ] keep
+  [ " SP: " write sp>> >hex 4 CHAR: \s pad-head write ] keep
+  [ " cycles: " write cycles>> number>string 5 CHAR: \s pad-head write ] keep
   nl drop ;
 
 : register-lookup ( string -- vector )
@@ -1396,11 +1396,11 @@ SYMBOL: last-opcode
 SYNTAX: INSTRUCTION:  ";" parse-tokens parse-instructions ;
 
 SYNTAX: cycles 
-  #! Set the number of cycles for the last instruction that was defined. 
-  scan-token string>number last-opcode get-global instruction-cycles set-nth ; 
+  #! Set the number of cycles for the last instruction that was defined.
+  scan-token string>number last-opcode get-global instruction-cycles set-nth ;
 
 SYNTAX: opcode ( -- )
   #! Set the opcode number for the last instruction that was defined.
-  last-instruction get-global 1quotation scan-token 16 base>
-  dup last-opcode set-global set-instruction ; 
+  last-instruction get-global 1quotation scan-token hex>
+  dup last-opcode set-global set-instruction ;
 
index f16664fb0272c19cba3296da89bf3f73c2567f15..ae46e3cd7ab4be410d6134064c57319d41e806e9 100644 (file)
@@ -127,7 +127,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
 
 : ip->ba ( ip -- ba ) "." split [ string>number ] map >byte-array ;
 
-: ipv6->ba ( ip -- ba ) ":" split [ 16 base> ] map [ 2 >be ] map concat ;
+: ipv6->ba ( ip -- ba ) ":" split [ hex> ] map [ 2 >be ] map concat ;
 
 : label->ba ( label -- ba ) [ >byte-array ] [ length ] bi prefix ;
 
@@ -341,7 +341,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : get-ipv6 ( ba i -- ip )
-  dup 16 + subseq 2 group [ be> 16 >base ] map ":" join ;
+  dup 16 + subseq 2 group [ be> >hex ] map ":" join ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!