Merge branch 'master' into new_ui
commit
6eebc66be4
basis
base64
http
io
mmap/functor
locals
rewrite/sugar
math/blas
cblas
matrices
syntax
vectors
smtp
server
specialized-arrays/functor
specialized-vectors/functor
xml/utilities
misc/fuel
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators io io.binary io.encodings.binary
|
||||
io.streams.byte-array io.streams.string kernel math namespaces
|
||||
sequences strings ;
|
||||
sequences strings io.crlf ;
|
||||
IN: base64
|
||||
|
||||
<PRIVATE
|
||||
|
@ -32,7 +32,7 @@ SYMBOL: column
|
|||
: write1-lines ( ch -- )
|
||||
write1
|
||||
column get [
|
||||
1+ [ 76 = [ "\r\n" write ] when ]
|
||||
1+ [ 76 = [ crlf ] when ]
|
||||
[ 76 mod column set ] bi
|
||||
] when* ;
|
||||
|
||||
|
|
|
@ -0,0 +1,2 @@
|
|||
parsing
|
||||
web
|
|
@ -34,7 +34,7 @@ WW DEFINES ${W}${W}
|
|||
|
||||
WHERE
|
||||
|
||||
: WW W twice ; inline
|
||||
: WW ( a -- b ) \ W twice ; inline
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
|
|
@ -1,17 +1,42 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel quotations classes.tuple make combinators generic
|
||||
words interpolate namespaces sequences io.streams.string fry
|
||||
classes.mixin effects lexer parser classes.tuple.parser
|
||||
effects.parser locals.types locals.parser
|
||||
locals.rewrite.closures vocabs.parser ;
|
||||
locals.rewrite.closures vocabs.parser arrays accessors ;
|
||||
IN: functors
|
||||
|
||||
! This is a hack
|
||||
|
||||
: scan-param ( -- obj )
|
||||
scan-object dup special? [ literalize ] unless ;
|
||||
|
||||
: define* ( word def effect -- ) pick set-word define-declared ;
|
||||
|
||||
TUPLE: fake-quotation seq ;
|
||||
|
||||
GENERIC: >fake-quotations ( quot -- fake )
|
||||
|
||||
M: callable >fake-quotations
|
||||
>array >fake-quotations fake-quotation boa ;
|
||||
|
||||
M: array >fake-quotations [ >fake-quotations ] { } map-as ;
|
||||
|
||||
M: object >fake-quotations ;
|
||||
|
||||
GENERIC: fake-quotations> ( fake -- quot )
|
||||
|
||||
M: fake-quotation fake-quotations>
|
||||
seq>> [ fake-quotations> ] map >quotation ;
|
||||
|
||||
M: array fake-quotations> [ fake-quotations> ] map ;
|
||||
|
||||
M: object fake-quotations> ;
|
||||
|
||||
: parse-definition* ( -- )
|
||||
parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
|
||||
|
||||
: DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
|
||||
|
||||
: `TUPLE:
|
||||
|
@ -32,7 +57,7 @@ IN: functors
|
|||
scan-param parsed
|
||||
scan-param parsed
|
||||
\ create-method parsed
|
||||
parse-definition parsed
|
||||
parse-definition*
|
||||
DEFINE* ; parsing
|
||||
|
||||
: `C:
|
||||
|
@ -45,7 +70,7 @@ IN: functors
|
|||
: `:
|
||||
effect off
|
||||
scan-param parsed
|
||||
parse-definition parsed
|
||||
parse-definition*
|
||||
DEFINE* ; parsing
|
||||
|
||||
: `INSTANCE:
|
||||
|
|
|
@ -6,7 +6,7 @@ quotations arrays byte-arrays math.parser calendar
|
|||
calendar.format present urls
|
||||
|
||||
io io.encodings io.encodings.iana io.encodings.binary
|
||||
io.encodings.8-bit
|
||||
io.encodings.8-bit io.crlf
|
||||
|
||||
unicode.case unicode.categories
|
||||
|
||||
|
@ -16,12 +16,6 @@ EXCLUDE: fry => , ;
|
|||
|
||||
IN: http
|
||||
|
||||
: crlf ( -- ) "\r\n" write ;
|
||||
|
||||
: read-crlf ( -- bytes )
|
||||
"\r" read-until
|
||||
[ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
|
||||
|
||||
: (read-header) ( -- alist )
|
||||
[ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
|
||||
|
||||
|
|
|
@ -0,0 +1,2 @@
|
|||
Daniel Ehrenberg
|
||||
Slava Pestov
|
|
@ -0,0 +1,12 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup sequences ;
|
||||
IN: io.crlf
|
||||
|
||||
HELP: crlf
|
||||
{ $values }
|
||||
{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ;
|
||||
|
||||
HELP: read-crlf
|
||||
{ $values { "seq" sequence } }
|
||||
{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ;
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io kernel ;
|
||||
IN: io.crlf
|
||||
|
||||
: crlf ( -- )
|
||||
"\r\n" write ;
|
||||
|
||||
: read-crlf ( -- seq )
|
||||
"\r" read-until
|
||||
[ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
|
|
@ -0,0 +1 @@
|
|||
Writing and reading until \r\n
|
|
@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file
|
|||
WHERE
|
||||
|
||||
: <mapped-A> ( mapped-file -- direct-array )
|
||||
T mapped-file>direct <A> execute ; inline
|
||||
T mapped-file>direct <A> ; inline
|
||||
|
||||
: with-mapped-A-file ( path length quot -- )
|
||||
'[ <mapped-A> execute @ ] with-mapped-file ; inline
|
||||
'[ <mapped-A> @ ] with-mapped-file ; inline
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
@ -494,4 +494,6 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
|
|||
|
||||
! Discovered by littledan
|
||||
[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
|
||||
[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
|
||||
[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
|
||||
|
||||
[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
|
|
@ -37,7 +37,7 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ;
|
|||
|
||||
M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
|
||||
|
||||
M: wrapper rewrite-literal? drop t ;
|
||||
M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;
|
||||
|
||||
M: hashtable rewrite-literal? drop t ;
|
||||
|
||||
|
@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- )
|
|||
[ rewrite-element ] each ;
|
||||
|
||||
: rewrite-sequence ( seq -- )
|
||||
[ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
|
||||
[ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ;
|
||||
|
||||
M: array rewrite-element
|
||||
dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
|
||||
|
@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ;
|
|||
M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
|
||||
|
||||
M: tuple rewrite-element
|
||||
[ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
|
||||
[ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ;
|
||||
|
||||
M: quotation rewrite-element rewrite-sugar* ;
|
||||
|
||||
|
@ -84,7 +84,7 @@ M: local-word rewrite-element
|
|||
M: word rewrite-element literalize , ;
|
||||
|
||||
M: wrapper rewrite-element
|
||||
dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
|
||||
dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ;
|
||||
|
||||
M: object rewrite-element , ;
|
||||
|
||||
|
@ -98,7 +98,8 @@ M: def rewrite-sugar* , ;
|
|||
|
||||
M: hashtable rewrite-sugar* rewrite-element ;
|
||||
|
||||
M: wrapper rewrite-sugar* rewrite-element ;
|
||||
M: wrapper rewrite-sugar*
|
||||
dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
|
||||
|
||||
M: word rewrite-sugar*
|
||||
dup { load-locals get-local drop-locals } memq?
|
||||
|
|
|
@ -1,3 +1,2 @@
|
|||
math
|
||||
bindings
|
||||
unportable
|
||||
|
|
|
@ -268,28 +268,28 @@ TUPLE: MATRIX < blas-matrix-base ;
|
|||
M: MATRIX element-type
|
||||
drop TYPE ;
|
||||
M: MATRIX (blas-matrix-like)
|
||||
drop <MATRIX> execute ;
|
||||
drop <MATRIX> ;
|
||||
M: VECTOR (blas-matrix-like)
|
||||
drop <MATRIX> execute ;
|
||||
drop <MATRIX> ;
|
||||
M: MATRIX (blas-vector-like)
|
||||
drop <VECTOR> execute ;
|
||||
drop <VECTOR> ;
|
||||
|
||||
: >MATRIX ( arrays -- matrix )
|
||||
[ >ARRAY execute underlying>> ] (>matrix)
|
||||
<MATRIX> execute ;
|
||||
[ >ARRAY underlying>> ] (>matrix)
|
||||
<MATRIX> ;
|
||||
|
||||
M: VECTOR n*M.V+n*V!
|
||||
[ TYPE>ARG execute ] (prepare-gemv)
|
||||
[ XGEMV execute ] dip ;
|
||||
[ TYPE>ARG ] (prepare-gemv)
|
||||
[ XGEMV ] dip ;
|
||||
M: MATRIX n*M.M+n*M!
|
||||
[ TYPE>ARG execute ] (prepare-gemm)
|
||||
[ XGEMM execute ] dip ;
|
||||
[ TYPE>ARG ] (prepare-gemm)
|
||||
[ XGEMM ] dip ;
|
||||
M: MATRIX n*V(*)V+M!
|
||||
[ TYPE>ARG execute ] (prepare-ger)
|
||||
[ XGERU execute ] dip ;
|
||||
[ TYPE>ARG ] (prepare-ger)
|
||||
[ XGERU ] dip ;
|
||||
M: MATRIX n*V(*)Vconj+M!
|
||||
[ TYPE>ARG execute ] (prepare-ger)
|
||||
[ XGERC execute ] dip ;
|
||||
[ TYPE>ARG ] (prepare-ger)
|
||||
[ XGERC ] dip ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
|
|
@ -1,3 +1,2 @@
|
|||
math
|
||||
bindings
|
||||
unportable
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: kernel math.blas.vectors math.blas.matrices parser
|
||||
arrays prettyprint.backend sequences ;
|
||||
arrays prettyprint.backend prettyprint.custom sequences ;
|
||||
IN: math.blas.syntax
|
||||
|
||||
: svector{
|
||||
|
|
|
@ -1,2 +1 @@
|
|||
math
|
||||
unportable
|
||||
|
|
|
@ -1,2 +1 @@
|
|||
math
|
||||
unportable
|
||||
|
|
|
@ -144,26 +144,26 @@ TUPLE: VECTOR < blas-vector-base ;
|
|||
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
|
||||
|
||||
: >VECTOR ( seq -- v )
|
||||
[ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
|
||||
[ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
|
||||
|
||||
M: VECTOR clone
|
||||
TYPE heap-size (prepare-copy)
|
||||
[ XCOPY execute ] 3dip <VECTOR> execute ;
|
||||
[ XCOPY ] 3dip <VECTOR> ;
|
||||
|
||||
M: VECTOR element-type
|
||||
drop TYPE ;
|
||||
M: VECTOR Vswap
|
||||
(prepare-swap) [ XSWAP execute ] 2dip ;
|
||||
(prepare-swap) [ XSWAP ] 2dip ;
|
||||
M: VECTOR Viamax
|
||||
(prepare-nrm2) IXAMAX execute ;
|
||||
(prepare-nrm2) IXAMAX ;
|
||||
|
||||
M: VECTOR (blas-vector-like)
|
||||
drop <VECTOR> execute ;
|
||||
drop <VECTOR> ;
|
||||
|
||||
M: VECTOR (blas-direct-array)
|
||||
[ underlying>> ]
|
||||
[ [ length>> ] [ inc>> ] bi * ] bi
|
||||
<DIRECT-ARRAY> execute ;
|
||||
<DIRECT-ARRAY> ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
@ -180,17 +180,17 @@ XSCAL IS cblas_${T}scal
|
|||
WHERE
|
||||
|
||||
M: VECTOR V.
|
||||
(prepare-dot) XDOT execute ;
|
||||
(prepare-dot) XDOT ;
|
||||
M: VECTOR V.conj
|
||||
(prepare-dot) XDOT execute ;
|
||||
(prepare-dot) XDOT ;
|
||||
M: VECTOR Vnorm
|
||||
(prepare-nrm2) XNRM2 execute ;
|
||||
(prepare-nrm2) XNRM2 ;
|
||||
M: VECTOR Vasum
|
||||
(prepare-nrm2) XASUM execute ;
|
||||
(prepare-nrm2) XASUM ;
|
||||
M: VECTOR n*V+V!
|
||||
(prepare-axpy) [ XAXPY execute ] dip ;
|
||||
(prepare-axpy) [ XAXPY ] dip ;
|
||||
M: VECTOR n*V!
|
||||
(prepare-scal) [ XSCAL execute ] dip ;
|
||||
(prepare-scal) [ XSCAL ] dip ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
@ -207,13 +207,13 @@ COMPLEX>ARG DEFINES ${TYPE}-complex>arg
|
|||
WHERE
|
||||
|
||||
: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
|
||||
1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
|
||||
1 shift <DIRECT-ARRAY> <complex-sequence> ;
|
||||
: >COMPLEX-ARRAY ( sequence -- sequence )
|
||||
<complex-components> >ARRAY execute ;
|
||||
<complex-components> >ARRAY ;
|
||||
: COMPLEX>ARG ( complex -- alien )
|
||||
>rect 2array >ARRAY execute underlying>> ;
|
||||
>rect 2array >ARRAY underlying>> ;
|
||||
: ARG>COMPLEX ( alien -- complex )
|
||||
2 <DIRECT-ARRAY> execute first2 rect> ;
|
||||
2 <DIRECT-ARRAY> first2 rect> ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
@ -234,22 +234,22 @@ WHERE
|
|||
|
||||
M: VECTOR V.
|
||||
(prepare-dot) TYPE <c-object>
|
||||
[ XDOTU_SUB execute ] keep
|
||||
ARG>TYPE execute ;
|
||||
[ XDOTU_SUB ] keep
|
||||
ARG>TYPE ;
|
||||
M: VECTOR V.conj
|
||||
(prepare-dot) TYPE <c-object>
|
||||
[ XDOTC_SUB execute ] keep
|
||||
ARG>TYPE execute ;
|
||||
[ XDOTC_SUB ] keep
|
||||
ARG>TYPE ;
|
||||
M: VECTOR Vnorm
|
||||
(prepare-nrm2) XXNRM2 execute ;
|
||||
(prepare-nrm2) XXNRM2 ;
|
||||
M: VECTOR Vasum
|
||||
(prepare-nrm2) XXASUM execute ;
|
||||
(prepare-nrm2) XXASUM ;
|
||||
M: VECTOR n*V+V!
|
||||
[ TYPE>ARG execute ] 2dip
|
||||
(prepare-axpy) [ XAXPY execute ] dip ;
|
||||
[ TYPE>ARG ] 2dip
|
||||
(prepare-axpy) [ XAXPY ] dip ;
|
||||
M: VECTOR n*V!
|
||||
[ TYPE>ARG execute ] dip
|
||||
(prepare-scal) [ XSCAL execute ] dip ;
|
||||
[ TYPE>ARG ] dip
|
||||
(prepare-scal) [ XSCAL ] dip ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Daniel Ehrenberg
|
|
@ -0,0 +1,27 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax strings byte-arrays io.encodings.string ;
|
||||
IN: quoted-printable
|
||||
|
||||
ABOUT: "quoted-printable"
|
||||
|
||||
ARTICLE: "quoted-printable" "Quoted printable encoding"
|
||||
"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text."
|
||||
{ $subsection >quoted }
|
||||
{ $subsection >quoted-lines }
|
||||
{ $subsection quoted> } ;
|
||||
|
||||
HELP: >quoted
|
||||
{ $values { "byte-array" byte-array } { "string" string } }
|
||||
{ $description "Encodes a byte array as quoted printable, on a single line." }
|
||||
{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word." } ;
|
||||
|
||||
HELP: >quoted-lines
|
||||
{ $values { "byte-array" byte-array } { "string" string } }
|
||||
{ $description "Encodes a byte array as quoted printable, with soft line breaks inserted so the output lines are no longer than 76 characters." }
|
||||
{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word with a specific encoding." } ;
|
||||
|
||||
HELP: quoted>
|
||||
{ $values { "string" string } { "byte-array" byte-array } }
|
||||
{ $description "Decodes a quoted printable string into an array of the bytes represented." }
|
||||
{ $warning "When decoding something in quoted printable form and using it as a string, be sure to use the " { $link decode } " word rather than simply converting the byte array to a string." } ;
|
|
@ -0,0 +1,30 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test quoted-printable multiline io.encodings.string
|
||||
sequences io.encodings.8-bit splitting kernel ;
|
||||
IN: quoted-printable.tests
|
||||
|
||||
[ <" José was the
|
||||
person who knew how to write the letters:
|
||||
ő and ü
|
||||
and we didn't know hów tö do thât"> ]
|
||||
[ <" Jos=E9 was the
|
||||
person who knew how to write the letters:
|
||||
=F5 and =FC=20
|
||||
and w=
|
||||
e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test
|
||||
|
||||
[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ]
|
||||
[ <" José was the
|
||||
person who knew how to write the letters:
|
||||
ő and ü
|
||||
and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test
|
||||
|
||||
: message ( -- str )
|
||||
55 [ "hello" ] replicate concat ;
|
||||
|
||||
[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test
|
||||
[ 1 ] [ message >quoted string-lines length ] unit-test
|
||||
[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test
|
||||
[ 4 ] [ message >quoted-lines string-lines length ] unit-test
|
||||
[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test
|
|
@ -0,0 +1,62 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences strings kernel io.encodings.string
|
||||
math.order ascii math io io.encodings.utf8 io.streams.string
|
||||
combinators.short-circuit math.parser arrays ;
|
||||
IN: quoted-printable
|
||||
|
||||
! This implements RFC 2045 section 6.7
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: assure-small ( ch -- ch )
|
||||
dup 256 <
|
||||
[ "Cannot quote a character greater than 255" throw ] unless ;
|
||||
|
||||
: printable? ( ch -- ? )
|
||||
{
|
||||
[ CHAR: \s CHAR: < between? ]
|
||||
[ CHAR: > CHAR: ~ between? ]
|
||||
[ CHAR: \t = ]
|
||||
} 1|| ;
|
||||
|
||||
: char>quoted ( ch -- str )
|
||||
dup printable? [ 1string ] [
|
||||
assure-small >hex >upper
|
||||
2 CHAR: 0 pad-left
|
||||
CHAR: = prefix
|
||||
] if ;
|
||||
|
||||
: take-some ( seqs -- seqs seq )
|
||||
0 over [ length + dup 76 >= ] find drop nip
|
||||
[ 1- cut-slice swap ] [ f swap ] if* concat ;
|
||||
|
||||
: divide-lines ( strings -- strings )
|
||||
[ dup ] [ take-some ] [ ] produce nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >quoted ( byte-array -- string )
|
||||
[ char>quoted ] { } map-as concat "" like ;
|
||||
|
||||
: >quoted-lines ( byte-array -- string )
|
||||
[ char>quoted ] { } map-as
|
||||
divide-lines "=\r\n" join ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: read-char ( byte -- ch )
|
||||
dup CHAR: = = [
|
||||
drop read1 dup CHAR: \n =
|
||||
[ drop read1 read-char ]
|
||||
[ read1 2array hex> ] if
|
||||
] when ;
|
||||
|
||||
: read-quoted ( -- bytes )
|
||||
[ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: quoted> ( string -- byte-array )
|
||||
! Input should already be normalized to make \r\n into \n
|
||||
[ read-quoted ] with-string-reader ;
|
|
@ -0,0 +1 @@
|
|||
Quoted printable encoding/decoding
|
|
@ -0,0 +1,2 @@
|
|||
parsing
|
||||
web
|
|
@ -4,7 +4,7 @@ USING: combinators kernel prettyprint io io.timeouts sequences
|
|||
namespaces io.sockets io.sockets.secure continuations calendar
|
||||
io.encodings.ascii io.streams.duplex destructors locals
|
||||
concurrency.promises threads accessors smtp.private
|
||||
io.sockets.secure.unix.debug ;
|
||||
io.sockets.secure.unix.debug io.crlf ;
|
||||
IN: smtp.server
|
||||
|
||||
! Mock SMTP server for testing purposes.
|
||||
|
|
|
@ -6,7 +6,7 @@ io.encodings.utf8 io.timeouts io.sockets io.sockets.secure
|
|||
io.encodings.ascii kernel logging sequences combinators
|
||||
splitting assocs strings math.order math.parser random system
|
||||
calendar summary calendar.format accessors sets hashtables
|
||||
base64 debugger classes prettyprint ;
|
||||
base64 debugger classes prettyprint io.crlf ;
|
||||
IN: smtp
|
||||
|
||||
SYMBOL: smtp-domain
|
||||
|
@ -50,12 +50,6 @@ TUPLE: email
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: crlf ( -- ) "\r\n" write ;
|
||||
|
||||
: read-crlf ( -- bytes )
|
||||
"\r" read-until
|
||||
[ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
|
||||
|
||||
: command ( string -- ) write crlf flush ;
|
||||
|
||||
\ command DEBUG add-input-logging
|
||||
|
|
|
@ -49,9 +49,9 @@ M: A set-nth-unsafe underlying>> SET-NTH call ;
|
|||
|
||||
: >A ( seq -- specialized-array ) A new clone-like ; inline
|
||||
|
||||
M: A like drop dup A instance? [ >A execute ] unless ;
|
||||
M: A like drop dup A instance? [ >A ] unless ;
|
||||
|
||||
M: A new-sequence drop (A) execute ;
|
||||
M: A new-sequence drop (A) ;
|
||||
|
||||
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
|
||||
|
||||
|
@ -70,7 +70,7 @@ M: A >pprint-sequence ;
|
|||
|
||||
M: A pprint* pprint-object ;
|
||||
|
||||
: A{ \ } [ >A execute ] parse-literal ; parsing
|
||||
: A{ \ } [ >A ] parse-literal ; parsing
|
||||
|
||||
INSTANCE: A sequence
|
||||
|
||||
|
|
|
@ -18,16 +18,16 @@ WHERE
|
|||
|
||||
TUPLE: V { underlying A } { length array-capacity } ;
|
||||
|
||||
: <V> ( capacity -- vector ) <A> execute 0 V boa ; inline
|
||||
: <V> ( capacity -- vector ) <A> 0 V boa ; inline
|
||||
|
||||
M: V like
|
||||
drop dup V instance? [
|
||||
dup A instance? [ dup length V boa ] [ >V execute ] if
|
||||
dup A instance? [ dup length V boa ] [ >V ] if
|
||||
] unless ;
|
||||
|
||||
M: V new-sequence drop [ <A> execute ] [ >fixnum ] bi V boa ;
|
||||
M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ;
|
||||
|
||||
M: A new-resizable drop <V> execute ;
|
||||
M: A new-resizable drop <V> ;
|
||||
|
||||
M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
|
||||
|
||||
|
@ -39,7 +39,7 @@ M: V >pprint-sequence ;
|
|||
|
||||
M: V pprint* pprint-object ;
|
||||
|
||||
: V{ \ } [ >V execute ] parse-literal ; parsing
|
||||
: V{ \ } [ >V ] parse-literal ; parsing
|
||||
|
||||
INSTANCE: V growable
|
||||
|
||||
|
|
|
@ -19,10 +19,6 @@ IN: xml.utilities
|
|||
: first-child-tag ( tag -- tag )
|
||||
children>> [ tag? ] find nip ;
|
||||
|
||||
! * Accessing part of an XML document
|
||||
! for tag- words, a start means that it searches all children
|
||||
! and no star searches only direct children
|
||||
|
||||
: tag-named? ( name elem -- ? )
|
||||
dup tag? [ names-match? ] [ 2drop f ] if ;
|
||||
|
||||
|
@ -36,8 +32,6 @@ IN: xml.utilities
|
|||
tags@ '[ _ swap tag-named? ] deep-filter ;
|
||||
|
||||
: tag-named ( tag name/string -- matching-tag )
|
||||
! like get-name-tag but only looks at direct children,
|
||||
! not all the children down the tree.
|
||||
assure-name swap [ tag-named? ] with find nip ;
|
||||
|
||||
: tags-named ( tag name/string -- tags-seq )
|
||||
|
@ -58,7 +52,7 @@ IN: xml.utilities
|
|||
: deep-tags-with-attr ( tag attr-value attr-name -- tags-seq )
|
||||
tags@ '[ _ _ tag-with-attr? ] deep-filter ;
|
||||
|
||||
: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
|
||||
: get-id ( tag id -- elem )
|
||||
"id" deep-tag-with-attr ;
|
||||
|
||||
: deep-tags-named-with-attr ( tag tag-name attr-value attr-name -- tags )
|
||||
|
|
|
@ -233,16 +233,11 @@
|
|||
;; Default is word constituent
|
||||
(dotimes (i 256)
|
||||
(modify-syntax-entry i "w" table))
|
||||
|
||||
;; Whitespace (TAB is not whitespace)
|
||||
(modify-syntax-entry ?\f " " table)
|
||||
(modify-syntax-entry ?\r " " table)
|
||||
(modify-syntax-entry ?\ " " table)
|
||||
(modify-syntax-entry ?\n " " table)
|
||||
|
||||
;; Char quote
|
||||
(modify-syntax-entry ?\\ "/" table)
|
||||
|
||||
table))
|
||||
|
||||
(defconst fuel-syntax--syntactic-keywords
|
||||
|
@ -254,9 +249,9 @@
|
|||
(" \\((\\)( \\([^\n]*\\) )\\()\\)\\( \\|\n\\)" (1 "<b") (2 "w") (3 ">b"))
|
||||
(" \\((\\) \\([^\n]*\\) \\()\\)\\( \\|\n\\)" (1 "<b") (2 "w") (3 ">b"))
|
||||
;; Strings
|
||||
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\)"
|
||||
(3 "\"") (4 "\""))
|
||||
("\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\|$\\)" (1 "\"") (2 "\""))
|
||||
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)"
|
||||
(3 "\"") (5 "\""))
|
||||
("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\""))
|
||||
("\\_<<\\(\"\\)\\_>" (1 "<b"))
|
||||
("\\_<\\(\"\\)>\\_>" (1 ">b"))
|
||||
;; Multiline constructs
|
||||
|
|
Loading…
Reference in New Issue