steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

more prettyprinter updates, unparser is gone

cvs
Slava Pestov 2005-08-22 00:50:14 +00:00
parent 119cb1ba6b
commit b3e58b4380
50 changed files with 385 additions and 352 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
CHANGES.html
View File

@ -33,6 +33,16 @@
</li>
<li>Prettyprinter:
<ul>
<li>The prettyprinter has been merged with the unparser. The <code>unparse ( object -- string )</code> word has been moved to the <code>prettyprint</code> vocabulary, and can now produce a parsable string for any class supported by the prettyprinter.</li>
<li>New <code>unparse-short ( object -- string )</code> returns a string no longer than a single line.</li>
<li>The prettyprinter now supports many more configuration variables. See the handbook for details.</li>
</ul>
</li>
<li>Everything else:
<ul>

6
library/alien/compiler.factor
View File

@ -2,8 +2,8 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: alien
USING: assembler compiler compiler-backend compiler-frontend
errors generic hashtables inference kernel lists math namespaces
sequences io strings unparser words ;
errors generic hashtables inference io kernel lists math
namespaces prettyprint sequences strings words ;
! ! ! WARNING ! ! !
! Reloading this file into a running Factor instance on Win32
@ -93,7 +93,7 @@ C: alien-node make-node ;
: incr-param ( reg-class -- )
#! OS X is so ugly.
dup class [ 1 + ] change dup float-regs? [
dup class inc dup float-regs? [
os "macosx" = [
int-regs [ swap float-regs-size 4 / + ] change
] [

2
library/alien/enums.factor
View File

@ -14,7 +14,7 @@ USING: kernel lists math parser words ;
#! END-ENUM
#!
#! This is the same as : x 0 ; : y 1 ; : z 2 ;.
scan str>number ; parsing
scan string>number ; parsing
: ENUM:
dup CREATE swap unit define-compound 1 + ; parsing

1
library/bootstrap/boot-stage1.factor
View File

@ -73,7 +73,6 @@ parser prettyprint sequences io vectors words ;
"/library/alien/aliens.factor"
"/library/syntax/unparser.factor"
"/library/syntax/prettyprint.factor"
"/library/tools/gensym.factor"

3
library/bootstrap/boot-stage2.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
USING: alien assembler command-line compiler errors generic
hashtables io kernel lists memory namespaces parser sequences
unparser words ;
hashtables io kernel lists memory namespaces parser sequences words ;
: pull-in ( ? list -- )
swap [

5
library/bootstrap/boot-stage3.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
USING: alien assembler command-line compiler compiler-backend
compiler-frontend inference io-internals kernel lists math
namespaces parser sequences io unparser words ;
namespaces parser sequences io words ;
"Compiling base..." print
@ -36,7 +36,8 @@ compile? [
\ car compile
\ * compile
\ = compile
\ unparse compile
\ string>number compile
\ number>string compile
\ scan compile
\ (generate) compile
] when

10
library/bootstrap/boot-stage4.factor
View File

@ -3,8 +3,7 @@
IN: kernel
USING: alien assembler command-line compiler console errors
generic inference kernel-internals listener lists math memory
namespaces parser presentation prettyprint random io
unparser words ;
namespaces parser presentation prettyprint random io words ;
"Bootstrap stage 4..." print
@ -37,12 +36,13 @@ terpri
terpri
0 [ compiled? [ 1 + ] when ] each-word
unparse write " words compiled" print
number>string write " words compiled" print
0 [ drop 1 + ] each-word
unparse write " words total" print
number>string write " words total" print
"Total bootstrap GC time: " write gc-time unparse write " ms" print
"Total bootstrap GC time: " write gc-time
number>string write " ms" print
"Bootstrapping is complete." print
"Now, you can run ./f factor.image" print

2
library/bootstrap/primitives.factor
View File

@ -44,7 +44,7 @@ vocabularies get [
{ ">float" "math" }
{ "(fraction>)" "math-internals" }
{ "str>float" "parser" }
{ "(unparse-float)" "unparser" }
{ "(unparse-float)" "parser" }
{ "float>bits" "math" }
{ "double>bits" "math" }
{ "bits>float" "math" }

12
library/collections/namespaces.factor
View File

@ -65,10 +65,6 @@ strings vectors words ;
: set ( value variable -- ) namespace set-hash ;
: on ( var -- ) t swap set ;
: off ( var -- ) f swap set ;
: nest ( variable -- hash )
#! If the variable is set in the current namespace, return
#! its value, otherwise set its value to a new namespace.
@ -80,6 +76,14 @@ strings vectors words ;
#! quotation.
>r dup get r> rot slip set ; inline
: on ( var -- ) t swap set ; inline
: off ( var -- ) f swap set ; inline
: inc ( var -- ) [ 1 + ] change ; inline
: dec ( var -- ) [ 1 - ] change ; inline
: bind ( namespace quot -- )
#! Execute a quotation with a namespace on the namestack.
swap >n call n> drop ; inline

2
library/collections/sequences-epilogue.factor
View File

@ -212,7 +212,7 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
: flip ( seq -- seq )
#! An example illustrates this word best:
#! { { 1 2 3 } { 4 5 6 } } ==> { { 1 2 } { 3 4 } { 5 6 } }
#! { { 1 2 3 } { 4 5 6 } } ==> { { 1 4 } { 2 5 } { 3 6 } }
dup empty? [
dup first length [ swap [ nth ] map-with ] map-with
] unless ; flushable

5
library/httpd/cont-responder.factor
View File

@ -22,7 +22,7 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cont-responder
USING: http httpd math random namespaces io
lists strings kernel html unparser hashtables
lists strings kernel html hashtables
parser generic sequences ;
#! Used inside the session state of responders to indicate whether the
@ -40,7 +40,8 @@ SYMBOL: post-refresh-get?
: get-random-id ( -- id )
#! Generate a random id to use for continuation URL's
[ 32 [ 0 9 random-int unparse % ] times ] make-string str>number 36 >base ;
[ 32 [ 0 9 random-int CHAR: 0 + , ] times ] make-string
string>number 36 >base ;
#! Name of variable holding the table of continuations.
SYMBOL: table

4
library/httpd/file-responder.factor
View File

@ -2,14 +2,14 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: file-responder
USING: html httpd kernel lists namespaces parser sequences
io strings unparser ;
io strings ;
: serving-path ( filename -- filename )
[ "" ] unless* "doc-root" get swap append ;
: file-response ( mime-type length -- )
[
unparse "Content-Length" swons ,
number>string "Content-Length" swons ,
"Content-Type" swons ,
] make-list "200 OK" response terpri ;

6
library/httpd/html.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: html
USING: #<unknown> generic http io kernel lists namespaces
presentation sequences strings styles unparser words ;
USING: generic http io kernel lists namespaces parser
presentation sequences strings styles words ;
: html-entities ( -- alist )
[
@ -35,7 +35,7 @@ presentation sequences strings styles unparser words ;
[ "text-decoration: underline; " % ] when ;
: size-css, ( size -- )
"font-size: " % unparse % "; " % ;
"font-size: " % number>string % "; " % ;
: font-css, ( font -- )
"font-family: " % % "; " % ;

12
library/httpd/http-client.factor
View File

@ -2,11 +2,11 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: http-client
USING: errors http kernel lists namespaces parser sequences
io strings unparser ;
io strings ;
: parse-host ( url -- host port )
#! Extract the host name and port number from an HTTP URL.
":" split1 [ str>number ] [ 80 ] ifte* ;
":" split1 [ string>number ] [ 80 ] ifte* ;
: parse-url ( url -- host resource )
"http://" ?head [
@ -16,13 +16,15 @@ io strings unparser ;
: parse-response ( line -- code )
"HTTP/" ?head [ " " split1 nip ] when
" " split1 drop str>number ;
" " split1 drop string>number ;
: read-response ( -- code header )
#! After sending a GET oR POST we read a response line and
#! header.
flush readln parse-response read-header ;
: crlf "\r\n" write ;
: http-request ( host resource method -- )
write " " write write " HTTP/1.0" write crlf
"Host: " write write crlf ;
@ -53,8 +55,8 @@ DEFER: http-get
#! Note: It is up to the caller to url encode the content if
#! it is required according to the content-type.
"POST" http-request [
"Content-Length: " write length unparse write crlf
"Content-Type: " write write crlf
"Content-Length: " write length number>string write crlf
"Content-Type: " write url-encode write crlf
crlf
] keep write ;

2
library/httpd/http-common.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2005 Slava Pestov
IN: http
USING: errors kernel lists math namespaces parser sequences
io strings unparser ;
io strings ;
: header-line ( alist line -- alist )
": " split1 dup [ cons swons ] [ 2drop ] ifte ;

2
library/httpd/responder.factor
View File

@ -62,7 +62,7 @@ SYMBOL: responders
: read-post-request ( header -- alist )
"Content-Length" swap assoc dup
[ str>number read query>alist ] when ;
[ string>number read query>alist ] when ;
: log-user-agent ( alist -- )
"User-Agent" swap assoc* [

5
library/inference/branches.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: errors generic hashtables interpreter kernel lists math
namespaces prettyprint sequences strings unparser vectors words ;
namespaces parser prettyprint sequences strings vectors words ;
: unify-lengths ( seq -- seq )
#! Pad all vectors to the same length. If one vector is
@ -31,7 +31,8 @@ namespaces prettyprint sequences strings unparser vectors words ;
[ unify-stacks >r unify-stacks r> ]
[
{ "Unbalanced branches:" } -rot [
swap length unparse " " rot length unparse append3
swap length number>string
" " rot length number>string append3
] 2map append "\n" join inference-error
] ifte ;

4
library/inference/inference.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: inference
USING: errors generic interpreter io kernel lists math
namespaces prettyprint sequences strings unparser vectors words ;
namespaces parser prettyprint sequences strings vectors words ;
! This variable takes a boolean value.
SYMBOL: inferring-base-case
@ -112,7 +112,7 @@ M: wrapper apply-object wrapped apply-literal ;
: check-return ( -- )
#! Raise an error if word leaves values on return stack.
meta-r get empty? [
"Word leaves " meta-r get length unparse
"Word leaves " meta-r get length number>string
" element(s) on return stack. Check >r/r> usage." append3
inference-error
] unless ;

2
library/inference/known-words.factor
View File

@ -1,7 +1,7 @@
IN: inference
USING: alien assembler errors generic hashtables interpreter io
io-internals kernel kernel-internals lists math math-internals
memory parser sequences strings unparser vectors words ;
memory parser sequences strings vectors words prettyprint ;
! Primitive combinators
\ call [

2
library/io/directories.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: io
USING: hashtables kernel lists namespaces presentation sequences
strings styles unparser ;
strings styles ;
! Hyperlinked directory listings.

4
library/io/logging.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: io
USING: kernel namespaces io sequences strings unparser ;
USING: io kernel namespaces parser sequences strings ;
! A simple logging framework.
SYMBOL: log-stream
@ -21,7 +21,7 @@ SYMBOL: log-stream
"Accepted connection from " %
dup client-stream-host %
CHAR: : ,
client-stream-port unparse %
client-stream-port number>string %
] make-string log ;
: with-log-file ( file quot -- )

5
library/io/stdio.factor
View File

@ -14,12 +14,13 @@ USING: errors generic kernel lists namespaces strings styles ;
: terpri ( -- ) stdio get stream-terpri ;
: close ( -- ) stdio get stream-close ;
: crlf ( -- ) "\r\n" write ;
: write-icon ( resource -- )
#! Write an icon. Eg, /library/icons/File.png
icon swons unit "" swap format ;
: write-object ( string object -- )
presented swons unit format ;
: with-stream ( stream quot -- )
#! Close the stream no matter what happens.
[ swap stdio set [ close rethrow ] catch ] with-scope ;

55
library/syntax/parse-numbers.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: parser
USING: errors generic kernel math sequences strings ;
USING: errors generic kernel math namespaces sequences strings ;
! Number parsing
@ -28,19 +28,62 @@ M: object digit> not-a-number ;
#! conversion fails.
swap "-" ?head [ (base>) neg ] [ (base>) ] ifte ;
GENERIC: str>number ( str -- num )
GENERIC: string>number ( str -- num )
M: string str>number 10 base> ;
M: string string>number 10 base> ;
PREDICATE: string potential-ratio CHAR: / swap member? ;
M: potential-ratio str>number ( str -- num )
M: potential-ratio string>number ( str -- num )
"/" split1 >r 10 base> r> 10 base> / ;
PREDICATE: string potential-float CHAR: . swap member? ;
M: potential-float str>number ( str -- num )
M: potential-float string>number ( str -- num )
str>float ;
: bin> 2 base> ;
: oct> 8 base> ;
: dec> 10 base> ;
: hex> 16 base> ;
GENERIC: number>string ( str -- num )
: >digit ( n -- ch )
dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
: integer, ( num radix -- )
dup >r /mod >digit , dup 0 > [
r> integer,
] [
r> 2drop
] ifte ;
: >base ( num radix -- string )
#! Convert a number to a string in a certain base.
[
over 0 < [
swap neg swap integer, CHAR: - ,
] [
integer,
] ifte
] make-rstring ;
: >bin ( num -- string ) 2 >base ;
: >oct ( num -- string ) 8 >base ;
: >hex ( num -- string ) 16 >base ;
M: integer number>string ( obj -- str ) 10 >base ;
M: ratio number>string ( num -- str )
[
dup
numerator number>string %
CHAR: / ,
denominator number>string %
] make-string ;
: fix-float ( str -- str )
#! This is terrible. Will go away when we do our own float
#! output.
CHAR: . over member? [ ".0" append ] unless ;
M: float number>string ( float -- str )
(unparse-float) fix-float ;

2
library/syntax/parse-syntax.factor
View File

@ -4,7 +4,7 @@
! Bootstrapping trick; see doc/bootstrap.txt.
IN: !syntax
USING: alien errors generic hashtables kernel lists math
namespaces parser sequences strings syntax unparse vectors
namespaces parser sequences strings syntax vectors
words ;
: parsing ( -- )

4
library/syntax/parse-words.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: parser
USING: errors kernel lists math namespaces sequences io
strings unparser words ;
strings words ;
! The parser uses a number of variables:
! line - the line being parsed
@ -60,7 +60,7 @@ global [ string-mode off ] bind
: scan-word ( -- obj )
scan dup [
dup ";" = not string-mode get and [
dup "use" get search [ ] [ str>number ] ?ifte
dup "use" get search [ ] [ string>number ] ?ifte
] unless
] when ;

204
library/syntax/prettyprint.factor
View File

@ -2,16 +2,11 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: prettyprint
USING: alien generic hashtables io kernel lists math namespaces
parser sequences strings styles unparser vectors words ;
parser sequences strings styles vectors words ;
! TODO:
! - newline styles: forced, long output style, normal
! - long output flag, off with .
! - margin & indent calculation fix
! - out of memory when printing global namespace
! - formatting HTML code
! - limit strings
! - merge unparse into this
! State
SYMBOL: column
@ -23,12 +18,15 @@ SYMBOL: line-count
SYMBOL: end-printing
! Configuration
SYMBOL: tab-size
SYMBOL: margin
SYMBOL: nesting-limit
SYMBOL: length-limit
SYMBOL: line-limit
SYMBOL: string-limit
global [
4 tab-size set
64 margin set
recursion-check off
0 column set
@ -36,30 +34,34 @@ global [
last-newline? off
0 last-newline set
0 line-count set
string-limit off
] bind
TUPLE: pprinter blocks block ;
TUPLE: pprinter stack ;
GENERIC: pprint-section*
TUPLE: section start end ;
TUPLE: section start end nl-after? indent ;
C: section ( length -- section )
>r column [ dup rot + dup ] change r>
[ set-section-end ] keep
[ set-section-start ] keep ;
[ set-section-start ] keep
0 over set-section-indent ;
: section-fits? ( section -- ? )
section-end last-newline get - margin get <= ;
section-end last-newline get - indent get + margin get <= ;
: line-limit? ( -- ? )
line-limit get dup [ line-count get <= ] when ;
: fresh-line ( section -- )
section-start last-newline set
line-count [ 1 + ] change
: do-indent indent get CHAR: \s fill write ;
: fresh-line ( n -- )
last-newline set
line-count inc
line-limit? [ " ..." write end-printing get call ] when
terpri indent get CHAR: \s fill write ;
terpri do-indent ;
TUPLE: text string style ;
@ -75,24 +77,55 @@ TUPLE: block sections ;
C: block ( -- block )
0 <section> over set-delegate
{ } clone over set-block-sections ;
{ } clone over set-block-sections
t over set-section-nl-after?
tab-size get over set-section-indent ;
: pprinter-block pprinter-stack peek ;
: block-empty? ( section -- ? )
dup block? [ block-sections empty? ] [ drop f ] ifte ;
: add-section ( section stream -- )
pprinter-block block-sections push ;
over block-empty? [
2drop
] [
pprinter-block block-sections push
] ifte ;
: text ( string style -- )
<text> pprinter get add-section ;
: bl ( -- ) " " f text ;
: <indent ( section -- ) section-indent indent [ + ] change ;
: indent> ( section -- ) section-indent indent [ swap - ] change ;
: inset-section ( section -- )
dup <indent
dup section-start fresh-line dup pprint-section*
dup indent>
dup section-nl-after?
[ section-end fresh-line ] [ drop ] ifte ;
: advance ( section -- )
section-start last-newline get = [
last-newline inc
] [
" " write
] ifte ;
: pprint-section ( section -- )
last-newline? get [
dup section-fits? [
" " write
last-newline? off dup section-fits? [
dup advance pprint-section*
] [
dup fresh-line
] ifte last-newline? off
] when pprint-section* ;
inset-section
] ifte
] [
pprint-section*
] ifte ;
TUPLE: newline forced? ;
@ -102,46 +135,29 @@ C: newline ( forced -- section )
M: newline pprint-section*
dup newline-forced?
[ fresh-line ] [ drop last-newline? on ] ifte ;
: section-length ( section -- n )
dup section-end swap section-start - ;
: block-indent ( block -- indent )
block-sections first
dup block? [ drop 0 ] [ section-length 1 + ] ifte ;
[ section-start fresh-line ] [ drop last-newline? on ] ifte ;
M: block pprint-section* ( block -- )
indent get dup >r
over block-indent + indent set
block-sections [ pprint-section ] each
r> indent set ;
block-sections [ pprint-section ] each ;
: <block ( -- )
pprinter get dup pprinter-block over pprinter-blocks push
<block> swap set-pprinter-block ;
: <block ( -- ) <block> pprinter get pprinter-stack push ;
: newline ( forced -- )
<newline> pprinter get add-section ;
: newline ( forced -- ) <newline> pprinter get add-section ;
: end-block ( block -- )
column get swap set-section-end ;
: end-block ( block -- ) column get swap set-section-end ;
: pop-block ( pprinter -- )
dup pprinter-blocks pop swap set-pprinter-block ;
: block-empty? block-sections empty? ;
: pop-block ( pprinter -- ) pprinter-stack pop drop ;
: block> ( -- )
pprinter get dup pprinter-block dup block-empty? [
drop pop-block
] [
dup end-block swap dup pop-block add-section
] ifte ;
pprinter get dup pprinter-block
dup end-block swap dup pop-block add-section ;
: block; ( -- )
pprinter get pprinter-block f swap set-section-nl-after?
block> ;
C: pprinter ( -- stream )
{ } clone over set-pprinter-blocks
<block> over set-pprinter-block ;
<block> 1vector over set-pprinter-stack ;
: do-pprint ( pprinter -- )
[
@ -162,23 +178,71 @@ GENERIC: pprint* ( obj -- )
[[ "io-internals" [ [[ foreground [ 192 0 0 ] ]] ] ]]
}} hash ;
: object-style ( obj -- style )
dup word? [ dup word-vocabulary vocab-style ] [ { } ] ifte
swap presented swons add ;
: word-style ( word -- style )
dup word-vocabulary vocab-style swap presented swons add ;
: pprint-object ( obj -- )
dup unparse swap object-style text ;
: pprint-word ( obj -- ) dup word-name swap word-style text ;
M: object pprint* ( obj -- )
pprint-object ;
"( unprintable object: " swap class word-name " )" append3
f text ;
M: real pprint* ( obj -- )
number>string f text ;
M: complex pprint* ( num -- )
\ #{ pprint-word bl
dup real pprint* bl imaginary pprint* bl
\ }# pprint-word ;
: ch>ascii-escape ( ch -- esc )
[
[[ CHAR: \e "\\e" ]]
[[ CHAR: \n "\\n" ]]
[[ CHAR: \r "\\r" ]]
[[ CHAR: \t "\\t" ]]
[[ CHAR: \0 "\\0" ]]
[[ CHAR: \\ "\\\\" ]]
[[ CHAR: \" "\\\"" ]]
] assoc ;
: ch>unicode-escape ( ch -- esc )
>hex 4 CHAR: 0 pad-left "\\u" swap append ;
: unparse-ch ( ch -- ch/str )
dup quotable? [
,
] [
dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?ifte %
] ifte ;
: do-string-limit ( string -- string )
string-limit get [
dup length margin get > [
margin get 3 - swap head "..." append
] when
] when ;
: pprint-string ( string prefix -- )
[ % [ unparse-ch ] each CHAR: " , ] make-string
do-string-limit f text ;
M: string pprint* ( str -- str ) "\"" pprint-string ;
M: sbuf pprint* ( str -- str ) "SBUF\" " pprint-string ;
M: word pprint* ( word -- )
dup parsing? [ \ POSTPONE: pprint-object bl ] when
pprint-object ;
dup parsing? [ \ POSTPONE: pprint-word bl ] when pprint-word ;
M: t pprint* drop "t" f text ;
M: f pprint* drop "f" f text ;
M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;
: nesting-limit? ( -- ? )
nesting-limit get dup
[ pprinter get pprinter-blocks length < ] when ;
[ pprinter get pprinter-stack length < ] when ;
: check-recursion ( obj quot -- indent )
#! We detect circular structure.
@ -205,8 +269,8 @@ M: word pprint* ( word -- )
r> [ "... " f text ] when ;
: pprint-sequence ( seq start end -- )
<block swap pprint-object f newline
swap pprint-elements pprint-object block> ;
swap pprint-word f newline <block
swap pprint-elements block> pprint-word ;
M: cons pprint* ( list -- )
[
@ -224,11 +288,11 @@ M: tuple pprint* ( tuple -- )
[ <mirror> \ << \ >> pprint-sequence ] check-recursion ;
M: alien pprint* ( alien -- )
\ ALIEN: pprint-object bl alien-address pprint-object ;
\ ALIEN: pprint-word bl alien-address number>string f text ;
M: wrapper pprint* ( wrapper -- )
dup wrapped word? [
\ \ pprint-object bl wrapped pprint-object
\ \ pprint-word bl wrapped pprint-word
] [
wrapped 1vector \ W[ \ ]W pprint-sequence
] ifte ;
@ -238,11 +302,9 @@ M: wrapper pprint* ( wrapper -- )
<pprinter> pprinter set call pprinter get do-pprint
] with-scope ; inline
: pprint ( object -- )
[ pprint* ] with-pprint ;
: pprint ( object -- ) [ pprint* ] with-pprint ;
: pprint>string ( object -- string )
[ pprint ] string-out ;
: unparse ( object -- str ) [ pprint ] string-out ;
: . ( obj -- ) pprint terpri ;
@ -251,15 +313,15 @@ M: wrapper pprint* ( wrapper -- )
1 line-limit set
5 length-limit set
2 nesting-limit set
string-limit on
pprint
] with-scope ;
: pprint>short-string ( object -- string )
[ pprint-short ] string-out ;
: unparse-short ( object -- str ) [ pprint-short ] string-out ;
: [.] ( sequence -- )
#! Unparse each element on its own line.
[ [ pprint>short-string print ] each ] with-scope ;
[ dup unparse-short swap write-object terpri ] each ;
: stack. reverse-slice [.] ;

66
library/syntax/see.factor
View File

@ -5,8 +5,7 @@ USING: generic hashtables io kernel lists namespaces sequences
styles words ;
: declaration. ( word prop -- )
tuck word-name word-prop
[ bl pprint-object ] [ drop ] ifte ;
tuck word-name word-prop [ bl pprint-word ] [ drop ] ifte ;
: declarations. ( word -- )
[
@ -19,11 +18,16 @@ styles words ;
: comment. ( comment -- )
[ [[ font-style italic ]] ] text ;
: stack-picture ( seq -- string )
[ [ word-name % " " % ] each ] make-string ;
: stack-picture% ( seq -- string )
[ word-name % " " % ] each ;
: effect>string ( effect -- string )
2unseq stack-picture >r stack-picture "-- " r> append3 ;
[
" " %
dup first stack-picture%
"-- " %
second stack-picture%
] make-string ;
: stack-effect ( word -- string )
dup "stack-effect" word-prop [ ] [
@ -32,15 +36,15 @@ styles words ;
] ?ifte ;
: stack-effect. ( string -- )
[ bl "( " swap ")" append3 comment. ] when* ;
[ bl "(" swap ")" append3 comment. ] when* ;
: in. ( word -- )
<block \ IN: pprint-object bl word-vocabulary f text block>
<block \ IN: pprint-word bl word-vocabulary f text block;
t newline ;
: definer. ( word -- )
dup definer pprint-object bl
dup pprint-object
dup definer pprint-word bl
dup pprint-word
stack-effect stack-effect.
f newline ;
@ -53,27 +57,26 @@ M: word (see) definer. t newline ;
"\n" split [ "#!" swap append comment. t newline ] each
] when* ;
: pprint-; \ ; pprint-object ;
: pprint-; \ ; pprint-word ;
: see-body ( quot word -- )
dup definer. <block dup documentation. swap pprint-elements
pprint-; declarations. block> ;
pprint-; declarations. block; ;
M: compound (see)
dup word-def swap see-body t newline ;
: method. ( word [[ class method ]] -- )
<block
\ M: pprint-object bl
unswons pprint-object bl
swap pprint-object t newline
pprint-elements pprint-;
block> t newline ;
\ M: pprint-word bl
unswons pprint-word bl
swap pprint-word f newline
<block pprint-elements pprint-;
block; t newline ;
M: generic (see)
<block
dup dup { "picker" "combination" } [ word-prop ] map-with
swap see-body block> t newline
swap see-body block; t newline
dup methods [ method. ] each-with ;
GENERIC: class. ( word -- )
@ -81,7 +84,6 @@ GENERIC: class. ( word -- )
: methods. ( class -- )
#! List all methods implemented for this class.
dup metaclass [
t newline
dup implementors [
dup in. tuck "methods" word-prop hash* method.
] each-with
@ -90,28 +92,28 @@ GENERIC: class. ( word -- )
] ifte ;
M: union class.
\ UNION: pprint-object bl
dup pprint-object bl
"members" word-prop pprint-elements pprint-; ;
\ UNION: pprint-word bl
dup pprint-word bl
"members" word-prop pprint-elements pprint-; t newline ;
M: complement class.
\ COMPLEMENT: pprint-object bl
dup pprint-object bl
"complement" word-prop pprint-object ;
\ COMPLEMENT: pprint-word bl
dup pprint-word bl
"complement" word-prop pprint-word t newline ;
M: predicate class.
\ PREDICATE: pprint-object bl
dup "superclass" word-prop pprint-object bl
dup pprint-object f newline
\ PREDICATE: pprint-word bl
dup "superclass" word-prop pprint-word bl
dup pprint-word f newline
<block
"definition" word-prop pprint-elements
pprint-; block> ;
pprint-; block; t newline ;
M: tuple-class class.
\ TUPLE: pprint-object bl
dup pprint-object bl
\ TUPLE: pprint-word bl
dup pprint-word bl
"slot-names" word-prop [ f text bl ] each
pprint-; ;
pprint-; t newline ;
M: word class. drop ;

100
library/syntax/unparser.factor
View File

@ -1,100 +0,0 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: unparser
USING: alien generic kernel lists math memory namespaces parser
sequences sequences stdio strings words ;
GENERIC: unparse ( obj -- str )
M: object unparse ( obj -- str )
"( " swap class word-name " )" append3 ;
: >digit ( n -- ch )
dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
: integer, ( num radix -- )
dup >r /mod >digit , dup 0 > [
r> integer,
] [
r> 2drop
] ifte ;
: >base ( num radix -- string )
#! Convert a number to a string in a certain base.
[
over 0 < [
swap neg swap integer, CHAR: - ,
] [
integer,
] ifte
] make-rstring ;
: >dec ( num -- string ) 10 >base ;
: >bin ( num -- string ) 2 >base ;
: >oct ( num -- string ) 8 >base ;
: >hex ( num -- string ) 16 >base ;
M: integer unparse ( obj -- str ) >dec ;
M: ratio unparse ( num -- str )
[
dup
numerator unparse %
CHAR: / ,
denominator unparse %
] make-string ;
: fix-float ( str -- str )
#! This is terrible. Will go away when we do our own float
#! output.
CHAR: . over member? [ ".0" append ] unless ;
M: float unparse ( float -- str )
(unparse-float) fix-float ;
M: complex unparse ( num -- str )
[
"#{ " %
dup
real unparse %
" " %
imaginary unparse %
" }#" %
] make-string ;
: ch>ascii-escape ( ch -- esc )
[
[[ CHAR: \e "\\e" ]]
[[ CHAR: \n "\\n" ]]
[[ CHAR: \r "\\r" ]]
[[ CHAR: \t "\\t" ]]
[[ CHAR: \0 "\\0" ]]
[[ CHAR: \\ "\\\\" ]]
[[ CHAR: \" "\\\"" ]]
] assoc ;
: ch>unicode-escape ( ch -- esc )
>hex 4 CHAR: 0 pad-left "\\u" swap append ;
: unparse-ch ( ch -- ch/str )
dup quotable? [
,
] [
dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?ifte %
] ifte ;
: unparse-string [ unparse-ch ] each ;
M: string unparse ( str -- str )
[ CHAR: " , unparse-string CHAR: " , ] make-string ;
M: sbuf unparse ( str -- str )
[ "SBUF\" " % unparse-string CHAR: " , ] make-string ;
M: word unparse ( obj -- str ) word-name dup "( unnamed )" ? ;
M: t unparse drop "t" ;
M: f unparse drop "f" ;
M: dll unparse ( obj -- str )
[ "DLL\" " % dll-path unparse-string CHAR: " , ] make-string ;

5
library/test/generic.factor
View File

@ -1,5 +1,5 @@
IN: temporary
USING: parser prettyprint sequences io strings unparser ;
USING: parser prettyprint sequences io strings ;
USE: hashtables
USE: namespaces
@ -160,9 +160,6 @@ M: f testing 3 ;
M: sequence testing 4 ;
[ [ 1 2 ] 2 ] [ [ 1 2 ] testing ] unit-test
! Bootstrap hashing
[ f ] [ \ f \ unparse "methods" word-prop hash not ] unit-test
GENERIC: union-containment
M: integer union-containment drop 1 ;
M: number union-containment drop 2 ;

2
library/test/inference.factor
View File

@ -180,7 +180,7 @@ M: real iterate drop ;
[ [ 2 1 ] ] [ [ >= ] infer ] unit-test
[ [ 2 1 ] ] [ [ number= ] infer ] unit-test
[ [ 1 1 ] ] [ [ str>number ] infer ] unit-test
[ [ 1 1 ] ] [ [ string>number ] infer ] unit-test
[ [ 2 1 ] ] [ [ = ] infer ] unit-test
[ [ 1 1 ] ] [ [ get ] infer ] unit-test

5
library/test/interpreter.factor
View File

@ -1,5 +1,4 @@
IN: temporary
USING: unparser ;
USE: vectors
USE: interpreter
USE: test
@ -76,10 +75,6 @@ USE: sequences
[ [ "hi" print ] string-out ] test-interpreter
] unit-test
[ { "4\n" } ] [
[ [ 2 2 + unparse print ] string-out ] test-interpreter
] unit-test
[ { "4\n" } ] [
[ [ 2 2 + . ] string-out ] test-interpreter
] unit-test

2
library/test/math/integer.factor
View File

@ -1,5 +1,5 @@
IN: temporary
USING: kernel math test unparser ;
USING: kernel math prettyprint test ;
[ "-8" ] [ -8 unparse ] unit-test

1
library/test/math/rational.factor
View File

@ -2,7 +2,6 @@ IN: temporary
USE: kernel
USE: math
USE: test
USE: unparser
[ 1 2 ] [ 1/2 >fraction ] unit-test

24
library/test/parse-number.factor
View File

@ -1,9 +1,9 @@
IN: temporary
USING: errors kernel math parser test unparser ;
USING: errors kernel math parser test ;
: parse-number ( str -- num )
#! Convert a string to a number; return f on error.
[ str>number ] [ [ drop f ] when ] catch ;
[ string>number ] [ [ drop f ] when ] catch ;
[ f ]
[ f parse-number ]
@ -30,19 +30,19 @@ unit-test
unit-test
[ "100.0" ]
[ "1.0e2" parse-number unparse ]
[ "1.0e2" parse-number number>string ]
unit-test
[ "-100.0" ]
[ "-1.0e2" parse-number unparse ]
[ "-1.0e2" parse-number number>string ]
unit-test
[ "0.01" ]
[ "1.0e-2" parse-number unparse ]
[ "1.0e-2" parse-number number>string ]
unit-test
[ "-0.01" ]
[ "-1.0e-2" parse-number unparse ]
[ "-1.0e-2" parse-number number>string ]
unit-test
[ f ]
@ -50,7 +50,7 @@ unit-test
unit-test
[ "3.14" ]
[ "3.14" parse-number unparse ]
[ "3.14" parse-number number>string ]
unit-test
[ f ]
@ -62,19 +62,19 @@ unit-test
unit-test
[ "101.0" ]
[ "1.01e2" parse-number unparse ]
[ "1.01e2" parse-number number>string ]
unit-test
[ "-101.0" ]
[ "-1.01e2" parse-number unparse ]
[ "-1.01e2" parse-number number>string ]
unit-test
[ "1.01" ]
[ "101.0e-2" parse-number unparse ]
[ "101.0e-2" parse-number number>string ]
unit-test
[ "-1.01" ]
[ "-101.0e-2" parse-number unparse ]
[ "-101.0e-2" parse-number number>string ]
unit-test
[ 5 ]
@ -106,7 +106,7 @@ unit-test
unit-test
[ "33/100" ]
[ "66/200" parse-number unparse ]
[ "66/200" parse-number number>string ]
unit-test
[ "12" bin> ] unit-test-fails

1
library/test/parser.factor
View File

@ -1,7 +1,6 @@
IN: temporary
USE: parser
USE: test
USE: unparser
USE: lists
USE: kernel
USE: generic

56
library/test/prettyprint.factor
View File

@ -1,45 +1,52 @@
IN: temporary
USING: io kernel lists math prettyprint sequences test words ;
USING: alien io kernel lists math prettyprint sequences
test words inference namespaces vectors ;
[ "4" ] [ 4 pprint>string ] unit-test
[ "1.0" ] [ 1.0 pprint>string ] unit-test
[ "#{ 1/2 2/3 }#" ] [ #{ 1/2 2/3 }# pprint>string ] unit-test
[ "1267650600228229401496703205376" ] [ 1 100 shift pprint>string ] unit-test
[ "4" ] [ 4 unparse ] unit-test
[ "1.0" ] [ 1.0 unparse ] unit-test
[ "#{ 1/2 2/3 }#" ] [ #{ 1/2 2/3 }# unparse ] unit-test
[ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
[ "+" ] [ \ + pprint>string ] unit-test
[ "+" ] [ \ + unparse ] unit-test
[ "\\ +" ] [ [ \ + ] first pprint>string ] unit-test
[ "\\ +" ] [ [ \ + ] first unparse ] unit-test
[ "1" ] [
[ [ <block 1 pprint-object block> ] with-pprint ] string-out
] unit-test
[ "{ }" ] [ { } unparse ] unit-test
[ "{ }" ] [ { } pprint>string ] unit-test
[ "{ 1 2 3 }" ] [ { 1 2 3 } pprint>string ] unit-test
[ "{ 1 2 3 }" ] [ { 1 2 3 } unparse ] unit-test
[ "\"hello\\\\backslash\"" ]
[ "hello\\backslash" pprint>string ]
[ "hello\\backslash" unparse ]
unit-test
[ "\"\\u1234\"" ]
[ "\u1234" pprint>string ]
[ "\u1234" unparse ]
unit-test
[ "\"\\e\"" ]
[ "\e" pprint>string ]
[ "\e" unparse ]
unit-test
[ "f" ] [ f pprint>string ] unit-test
[ "t" ] [ t pprint>string ] unit-test
[ "f" ] [ f unparse ] unit-test
[ "t" ] [ t unparse ] unit-test
[ "SBUF\" hello world\"" ] [ SBUF" hello world" pprint>string ] unit-test
[ "SBUF\" hello world\"" ] [ SBUF" hello world" unparse ] unit-test
: foo dup * ; inline
[ "IN: temporary\n: foo dup * ; inline\n" ]
[ [ \ foo see ] string-out ] unit-test
: bar ( x -- y ) 2 + ;
[ "IN: temporary\n: bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
: baz dup ;
[ ] [ [ baz ] infer drop ] unit-test
[ "IN: temporary\n: baz ( object -- object object ) dup ;\n" ]
[ [ \ baz see ] string-out ] unit-test
[ ] [ \ fixnum see ] unit-test
[ ] [ \ integer see ] unit-test
@ -49,3 +56,14 @@ unit-test
[ ] [ \ compound see ] unit-test
[ ] [ \ pprinter see ] unit-test
[ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
[ "{\n 5 5 5 5 5 5 5 5 5 5\n}" ]
[
[
4 tab-size set
23 margin set
10 5 <repeated> >vector unparse
] with-scope
] unit-test

7
library/test/test.factor
View File

@ -2,7 +2,7 @@
IN: test
USING: errors kernel lists math memory namespaces parser
prettyprint sequences io strings unparser vectors words ;
prettyprint sequences io strings vectors words ;
TUPLE: assert got expect ;
@ -22,7 +22,8 @@ M: assert error.
#! execute it.
millis >r gc-time >r call gc-time r> - millis r> -
[
unparse % " ms run / " % unparse % " ms GC time" %
number>string % " ms run / " %
number>string % " ms GC time" %
] make-string print ;
: unit-test ( output input -- )
@ -79,7 +80,7 @@ SYMBOL: failures
"continuations" "errors" "hashtables" "strings"
"namespaces" "generic" "tuple" "files" "parser"
"parse-number" "init" "io/io"
"listener" "vectors" "words" "unparser" "random"
"listener" "vectors" "words" "prettyprint" "random"
"stream" "math/bitops"
"math/math-combinators" "math/rational" "math/float"
"math/complex" "math/irrational" "math/integer"

5
library/tools/debugger.factor
View File

@ -2,8 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: errors
USING: generic kernel kernel-internals lists math namespaces
parser prettyprint sequences io strings unparser
vectors words ;
parser prettyprint sequences io strings vectors words ;
: expired-error. ( obj -- )
"Object did not survive image save/load: " write . ;
@ -76,7 +75,7 @@ M: no-math-method error. ( error -- )
"Parsing " write
dup parse-error-file [ "<interactive>" ] unless* write
":" write
dup parse-error-line [ 1 ] unless* unparse print
dup parse-error-line [ 1 ] unless* number>string print
dup parse-error-text dup string? [ print ] [ drop ] ifte

5
library/tools/gensym.factor
View File

@ -1,14 +1,13 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: words USING: kernel math namespaces sequences strings
unparser ;
IN: words USING: kernel math namespaces parser sequences strings ;
SYMBOL: gensym-count
: (gensym) ( -- name )
"G:" global [
gensym-count [ 1 + dup ] change
] bind unparse append ;
] bind number>string append ;
: gensym ( -- word )
#! Return a word that is distinct from every other word, and

11
library/tools/inspector.factor
View File

@ -3,7 +3,7 @@
IN: inspector
USING: generic hashtables io kernel kernel-internals lists math
memory namespaces prettyprint sequences strings styles test
unparser vectors words ;
vectors words ;
SYMBOL: inspecting
@ -13,7 +13,7 @@ M: object sheet ( obj -- sheet )
dup class "slots" word-prop
[ second ] map
tuck [ execute ] map-with
2list ;
2vector ;
M: list sheet unit ;
@ -24,7 +24,7 @@ M: array sheet unit ;
M: hashtable sheet dup hash-keys swap hash-values 2list ;
: format-column ( list -- list )
[ pprint>short-string ] map
[ unparse-short ] map
[ max-length ] keep
[ swap CHAR: \s pad-right ] map-with ;
@ -68,9 +68,8 @@ M: object extra-banner ( obj -- ) drop ;
extra-banner ;
: describe ( obj -- )
sheet dup format-sheet
swap peek [ presented swons unit ] map
[ format terpri ] 2each ;
sheet dup format-sheet swap peek
[ write-object terpri ] 2each ;
: inspect ( obj -- )
dup inspecting set dup inspect-banner describe ;

22
library/tools/jedit.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: jedit
USING: kernel lists namespaces parser sequences io strings
unparser words ;
USING: io kernel lists namespaces parser prettyprint sequences
strings unparser vectors words ;
! Some words to send requests to a running jEdit instance to
! edit files and position the cursor on a specific line number.
@ -14,17 +14,17 @@ unparser words ;
: jedit-server-info ( -- port auth )
jedit-server-file <file-reader> [
readln drop
readln str>number
readln str>number
readln string>number
readln string>number
] with-stream ;
: make-jedit-request ( files params -- code )
[
"EditServer.handleClient(false,false,false,null," %
"new String[] {" %
[ unparse % "," % ] each
"null});\n" %
] make-string ;
"EditServer.handleClient(false,false,false,null," write
"new String[] {" write
[ pprint "," write ] each
"null});\n" write
] string-out ;
: send-jedit-request ( request -- )
jedit-server-info swap "localhost" swap <client> [
@ -34,11 +34,11 @@ unparser words ;
] with-stream ;
: jedit-line/file ( file line -- )
unparse "+line:" swap append 2list
number>string "+line:" swap append 2vector
make-jedit-request send-jedit-request ;
: jedit-file ( file -- )
unit make-jedit-request send-jedit-request ;
1vector make-jedit-request send-jedit-request ;
: jedit ( word -- )
#! Note that line numbers here start from 1

2
library/tools/listener.factor
View File

@ -2,7 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: listener
USING: errors io kernel lists math memory namespaces parser
presentation sequences strings styles unparser vectors words ;
presentation sequences strings styles vectors words ;
SYMBOL: listener-prompt
SYMBOL: quit-flag

17
library/tools/memory.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: memory
USING: errors generic hashtables kernel kernel-internals lists
math namespaces prettyprint sequences io strings unparser
vectors words ;
USING: errors generic hashtables io kernel kernel-internals
lists math namespaces parser prettyprint sequences strings
unparser vectors words ;
: generations 15 getenv ;
@ -15,7 +15,10 @@ vectors words ;
! Printing an overview of heap usage.
: kb. 1024 /i unparse 6 CHAR: \s pad-left write " KB" write ;
: kb.
1024 /i number>string
6 CHAR: \s pad-left write
" KB" write ;
: (room.) ( free total -- )
2dup swap - swap ( free used total )
@ -26,7 +29,7 @@ vectors words ;
: room. ( -- )
room
0 swap [
"Generation " write over unparse write ":" write
"Generation " write over pprint ":" write
uncons (room.) 1 +
] each drop
"Semi-space: " write kb. terpri
@ -92,8 +95,8 @@ M: object each-slot ( obj quot -- )
3drop
] [
rot type>class word-name write ": " write
unparse write " bytes, " write
unparse write " instances" print
pprint " bytes, " write
pprint " instances" print
] ifte ;
: heap-stats. ( -- )

4
library/tools/telnetd.factor
View File

@ -24,7 +24,7 @@ USING: errors listener kernel namespaces io threads parser ;
IN: shells
: telnet
"telnetd-port" get str>number telnetd ;
"telnetd-port" get string>number telnetd ;
! This is a string since we str>number it above.
! This is a string since we string>number it above.
global [ "9999" "telnetd-port" set ] bind

3
library/tools/word-tools.factor
View File

@ -2,8 +2,7 @@
! See http://factor.sf.net/license.txt for BSD license.
IN: words
USING: generic inspector lists kernel namespaces
prettyprint io strings sequences unparser math
hashtables parser ;
prettyprint io strings sequences math hashtables parser ;
: vocab-apropos ( substring vocab -- list )
#! Push a list of all words in a vocabulary whose names

4
library/ui/ui.factor
View File

@ -28,13 +28,13 @@ SYMBOL: stack-display
[[ font-style plain ]]
}} world get set-gadget-paint
{ 640 768 0 } world get set-gadget-dim
{ 700 800 0 } world get set-gadget-dim
<plain-gadget> add-layer
<pane> dup pane set <scroller>
<pane> dup stack-display set <scroller>
3/4 <x-splitter> add-layer
5/6 <x-splitter> add-layer
[
pane get [

8
library/unix/io.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: io-internals
USING: alien assembler errors generic hashtables kernel
kernel-internals lists math sequences io strings threads
unix-internals unparser vectors ;
USING: alien assembler errors generic hashtables io kernel
kernel-internals lists math parser sequences strings threads
unix-internals vectors ;
! We want namespaces::bind to shadow the bind system call from
! unix-internals
@ -79,7 +79,7 @@ M: port set-timeout ( timeout port -- )
: report-error ( error port -- )
[
"Error on fd " %
dup port-handle unparse %
dup port-handle number>string %
": " % swap %
] make-string swap set-port-error ;

12
library/unix/sockets.factor
View File

@ -4,8 +4,8 @@
! We need to fiddle with the exact search order here, since
! unix-internals::accept shadows streams::accept.
IN: io-internals
USING: errors namespaces io threads unparser alien generic
kernel math unix-internals ;
USING: alien errors generic io kernel math namespaces parser
threads unix-internals ;
: <socket-stream> ( fd -- stream )
dup f <fd-stream> ;
@ -81,10 +81,10 @@ C: accept-task ( port -- task )
: inet-ntoa ( n -- str )
ntohl [
dup -24 shift HEX: ff bitand unparse % CHAR: . ,
dup -16 shift HEX: ff bitand unparse % CHAR: . ,
dup -8 shift HEX: ff bitand unparse % CHAR: . ,
HEX: ff bitand unparse %
dup -24 shift HEX: ff bitand number>string % CHAR: . ,
dup -16 shift HEX: ff bitand number>string % CHAR: . ,
dup -8 shift HEX: ff bitand number>string % CHAR: . ,
HEX: ff bitand number>string %
] make-string ;
: do-accept ( port sockaddr fd -- )

2
library/vocabularies.factor
View File

@ -88,5 +88,5 @@ SYMBOL: vocabularies
"jedit" "kernel" "listener" "lists" "math" "matrices"
"memory" "namespaces" "parser" "prettyprint"
"sequences" "io" "strings" "styles" "syntax" "test"
"threads" "unparser" "vectors" "words" "scratchpad"
"threads" "vectors" "words" "scratchpad"
] "use" set ;

2
library/win32/win32-server.factor
View File

@ -25,7 +25,7 @@
IN: win32-stream
USING: alien errors generic kernel kernel-internals lists math namespaces
prettyprint sequences io strings threads unparser win32-api
prettyprint sequences io strings threads win32-api
win32-io-internals io-internals ;
TUPLE: win32-server this ;