Fixing basis -> extra dependencies
parent
dc88d45762
commit
aea0fed14c
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Channels - based on ideas from newsqueak
|
||||
USING: kernel sequences sequences.lib threads continuations
|
||||
random math accessors ;
|
||||
USING: kernel sequences threads continuations
|
||||
random math accessors random ;
|
||||
IN: channels
|
||||
|
||||
TUPLE: channel receivers senders ;
|
||||
|
|
0
basis/html/parser/analyzer/authors.txt → basis/checksums/common/authors.txt
Executable file → Normal file
0
basis/html/parser/analyzer/authors.txt → basis/checksums/common/authors.txt
Executable file → Normal file
|
@ -0,0 +1,21 @@
|
|||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.bitwise strings io.binary namespaces
|
||||
grouping ;
|
||||
IN: checksums.common
|
||||
|
||||
SYMBOL: bytes-read
|
||||
|
||||
: calculate-pad-length ( length -- pad-length )
|
||||
dup 56 < 55 119 ? swap - ;
|
||||
|
||||
: pad-last-block ( str big-endian? length -- str )
|
||||
[
|
||||
rot %
|
||||
HEX: 80 ,
|
||||
dup HEX: 3f bitand calculate-pad-length 0 <string> %
|
||||
3 shift 8 rot [ >be ] [ >le ] if %
|
||||
] "" make 64 group ;
|
||||
|
||||
: update-old-new ( old new -- )
|
||||
[ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
|
|
@ -0,0 +1 @@
|
|||
Some code shared by MD5, SHA1 and SHA2 implementations
|
|
@ -1,11 +1,14 @@
|
|||
! See http://www.faqs.org/rfcs/rfc1321.html
|
||||
|
||||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io io.binary io.files io.streams.byte-array math
|
||||
math.functions math.parser namespaces splitting grouping strings
|
||||
sequences crypto.common byte-arrays locals sequences.private
|
||||
io.encodings.binary symbols math.bitfields.lib checksums ;
|
||||
sequences byte-arrays locals sequences.private
|
||||
io.encodings.binary symbols math.bitwise checksums
|
||||
checksums.common ;
|
||||
IN: checksums.md5
|
||||
|
||||
! See http://www.faqs.org/rfcs/rfc1321.html
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOLS: a b c d old-a old-b old-c old-d ;
|
||||
|
|
|
@ -1,7 +1,9 @@
|
|||
USING: arrays combinators crypto.common kernel io
|
||||
io.encodings.binary io.files io.streams.byte-array math.vectors
|
||||
strings sequences namespaces math parser sequences vectors
|
||||
io.binary hashtables symbols math.bitfields.lib checksums ;
|
||||
! Copyright (C) 2006, 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators kernel io io.encodings.binary io.files
|
||||
io.streams.byte-array math.vectors strings sequences namespaces
|
||||
math parser sequences assocs grouping vectors io.binary hashtables
|
||||
symbols math.bitwise checksums checksums.common ;
|
||||
IN: checksums.sha1
|
||||
|
||||
! Implemented according to RFC 3174.
|
||||
|
@ -45,6 +47,9 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
|
|||
{ 3 [ bitxor bitxor ] }
|
||||
} case ;
|
||||
|
||||
: nth-int-be ( string n -- int )
|
||||
4 * dup 4 + rot <slice> be> ; inline
|
||||
|
||||
: make-w ( str -- )
|
||||
#! compute w, steps a-b of RFC 3174, section 6.1
|
||||
16 [ nth-int-be w get push ] with each
|
||||
|
@ -113,6 +118,14 @@ INSTANCE: sha1 checksum
|
|||
M: sha1 checksum-stream ( stream -- sha1 )
|
||||
drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
|
||||
|
||||
: seq>2seq ( seq -- seq1 seq2 )
|
||||
#! { abcdefgh } -> { aceg } { bdfh }
|
||||
2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
|
||||
|
||||
: 2seq>seq ( seq1 seq2 -- seq )
|
||||
#! { aceg } { bdfh } -> { abcdefgh }
|
||||
[ zip concat ] keep like ;
|
||||
|
||||
: sha1-interleave ( string -- seq )
|
||||
[ zero? ] left-trim
|
||||
dup length odd? [ rest ] when
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
USING: crypto.common kernel splitting grouping
|
||||
math sequences namespaces io.binary symbols
|
||||
math.bitfields.lib checksums ;
|
||||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel splitting grouping math sequences namespaces
|
||||
io.binary symbols math.bitwise checksums checksums.common
|
||||
sbufs strings ;
|
||||
IN: checksums.sha2
|
||||
|
||||
<PRIVATE
|
||||
|
@ -81,6 +83,8 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
|
|||
[ -11 bitroll-32 ] keep
|
||||
-25 bitroll-32 bitxor bitxor ; inline
|
||||
|
||||
: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ; inline
|
||||
|
||||
: T1 ( W n -- T1 )
|
||||
[ swap nth ] keep
|
||||
K get nth +
|
||||
|
@ -112,6 +116,15 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
|
|||
: seq>byte-array ( n seq -- string )
|
||||
[ swap [ >be % ] curry each ] B{ } make ;
|
||||
|
||||
: preprocess-plaintext ( string big-endian? -- padded-string )
|
||||
#! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
|
||||
>r >sbuf r> over [
|
||||
HEX: 80 ,
|
||||
dup length HEX: 3f bitand
|
||||
calculate-pad-length 0 <string> %
|
||||
length 3 shift 8 rot [ >be ] [ >le ] if %
|
||||
] "" make over push-all ;
|
||||
|
||||
: byte-array>sha2 ( byte-array -- string )
|
||||
t preprocess-plaintext
|
||||
block-size get group [ process-chunk ] each
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math cocoa cocoa.messages cocoa.classes
|
||||
sequences math.bitfields ;
|
||||
sequences math.bitwise ;
|
||||
IN: cocoa.windows
|
||||
|
||||
: NSBorderlessWindowMask 0 ; inline
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: arrays byte-arrays generic assocs hashtables io.binary
|
||||
kernel kernel.private math namespaces sequences words
|
||||
quotations strings alien.accessors alien.strings layouts system
|
||||
combinators math.bitfields words.private cpu.architecture
|
||||
combinators math.bitwise words.private cpu.architecture
|
||||
math.order accessors growable ;
|
||||
IN: compiler.generator.fixup
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: compiler.generator.fixup kernel namespaces sequences
|
||||
words math math.bitfields io.binary parser lexer ;
|
||||
words math math.bitwise io.binary parser lexer ;
|
||||
IN: cpu.ppc.assembler.backend
|
||||
|
||||
: insn ( operand opcode -- ) { 26 0 } bitfield , ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs classes continuations destructors kernel math
|
||||
namespaces sequences sequences.lib classes.tuple words strings
|
||||
tools.walker accessors combinators.lib combinators ;
|
||||
namespaces sequences classes.tuple words strings
|
||||
tools.walker accessors combinators ;
|
||||
IN: db
|
||||
|
||||
TUPLE: db
|
||||
|
|
|
@ -4,8 +4,8 @@ USING: arrays assocs alien alien.syntax continuations io
|
|||
kernel math math.parser namespaces prettyprint quotations
|
||||
sequences debugger db db.postgresql.lib db.postgresql.ffi
|
||||
db.tuples db.types tools.annotations math.ranges
|
||||
combinators sequences.lib classes locals words tools.walker
|
||||
namespaces.lib accessors random db.queries destructors ;
|
||||
combinators classes locals words tools.walker
|
||||
nmake accessors random db.queries destructors ;
|
||||
USE: tools.walker
|
||||
IN: db.postgresql
|
||||
|
||||
|
|
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math namespaces sequences random
|
||||
strings math.parser math.intervals combinators
|
||||
math.bitfields.lib namespaces.lib db db.tuples db.types
|
||||
sequences.lib db.sql classes words shuffle arrays ;
|
||||
USING: accessors kernel math namespaces sequences random strings
|
||||
math.parser math.intervals combinators math.bitwise nmake db
|
||||
db.tuples db.types db.sql classes words shuffle arrays ;
|
||||
IN: db.queries
|
||||
|
||||
GENERIC: where ( specs obj -- )
|
||||
|
@ -142,8 +141,8 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
|
|||
: make-query ( tuple query -- tuple' )
|
||||
dupd
|
||||
{
|
||||
[ group>> [ do-group ] [ drop ] if-seq ]
|
||||
[ order>> [ do-order ] [ drop ] if-seq ]
|
||||
[ group>> [ drop ] [ do-group ] if-empty ]
|
||||
[ order>> [ drop ] [ do-order ] if-empty ]
|
||||
[ limit>> [ do-limit ] [ drop ] if* ]
|
||||
[ offset>> [ do-offset ] [ drop ] if* ]
|
||||
} 2cleave ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel parser quotations classes.tuple words math.order
|
||||
namespaces.lib namespaces sequences arrays combinators
|
||||
prettyprint strings math.parser sequences.lib math symbols ;
|
||||
nmake namespaces sequences arrays combinators
|
||||
prettyprint strings math.parser math symbols ;
|
||||
IN: db.sql
|
||||
|
||||
SYMBOLS: insert update delete select distinct columns from as
|
||||
|
|
|
@ -1,13 +1,11 @@
|
|||
! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien arrays assocs classes compiler db
|
||||
hashtables io.files kernel math math.parser namespaces
|
||||
prettyprint sequences strings classes.tuple alien.c-types
|
||||
continuations db.sqlite.lib db.sqlite.ffi db.tuples
|
||||
words combinators.lib db.types combinators math.intervals
|
||||
io namespaces.lib accessors vectors math.ranges random
|
||||
math.bitfields.lib db.queries destructors ;
|
||||
USE: tools.walker
|
||||
USING: alien arrays assocs classes compiler db hashtables
|
||||
io.files kernel math math.parser namespaces prettyprint
|
||||
sequences strings classes.tuple alien.c-types continuations
|
||||
db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
|
||||
math.intervals io nmake accessors vectors math.ranges random
|
||||
math.bitwise db.queries destructors ;
|
||||
IN: db.sqlite
|
||||
|
||||
TUPLE: sqlite-db < db path ;
|
||||
|
|
|
@ -3,8 +3,8 @@
|
|||
USING: io.files kernel tools.test db db.tuples classes
|
||||
db.types continuations namespaces math math.ranges
|
||||
prettyprint calendar sequences db.sqlite math.intervals
|
||||
db.postgresql accessors random math.bitfields.lib
|
||||
math.ranges strings sequences.lib urls fry ;
|
||||
db.postgresql accessors random math.bitwise
|
||||
math.ranges strings urls fry ;
|
||||
IN: db.tuples.tests
|
||||
|
||||
TUPLE: person the-id the-name the-number the-real
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: arrays assocs classes db kernel namespaces
|
||||
classes.tuple words sequences slots math accessors
|
||||
math.parser io prettyprint db.types continuations
|
||||
destructors mirrors sequences.lib combinators.lib ;
|
||||
destructors mirrors ;
|
||||
IN: db.tuples
|
||||
|
||||
: define-persistent ( class table columns -- )
|
||||
|
@ -71,13 +71,14 @@ SINGLETON: retryable
|
|||
] 2map >>bind-params ;
|
||||
|
||||
M: retryable execute-statement* ( statement type -- )
|
||||
drop [
|
||||
drop [ retries>> ] [
|
||||
[
|
||||
nip
|
||||
[ query-results dispose t ]
|
||||
[ ]
|
||||
[ regenerate-params bind-statement* f ] cleanup
|
||||
] curry
|
||||
] [ retries>> ] bi retry drop ;
|
||||
] bi attempt-all drop ;
|
||||
|
||||
: resulting-tuple ( class row out-params -- tuple )
|
||||
rot class new [
|
||||
|
@ -159,7 +160,8 @@ M: retryable execute-statement* ( statement type -- )
|
|||
dup dup class <select-by-slots-statement> do-select ;
|
||||
|
||||
: select-tuple ( tuple -- tuple/f )
|
||||
dup dup class \ query new 1 >>limit <query> do-select ?first ;
|
||||
dup dup class \ query new 1 >>limit <query> do-select
|
||||
[ f ] [ first ] if-empty ;
|
||||
|
||||
: do-count ( exemplar-tuple statement -- tuples )
|
||||
[
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs db kernel math math.parser
|
||||
sequences continuations sequences.deep sequences.lib
|
||||
sequences continuations sequences.deep
|
||||
words namespaces slots slots.private classes mirrors
|
||||
classes.tuple combinators calendar.format symbols
|
||||
classes.singleton accessors quotations random ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors strings namespaces assocs hashtables
|
||||
mirrors math fry sequences sequences.lib words continuations ;
|
||||
mirrors math fry sequences words continuations ;
|
||||
IN: html.forms
|
||||
|
||||
TUPLE: form errors values validation-failed ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2003, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel combinators math namespaces
|
||||
assocs assocs.lib sequences splitting sorting sets debugger
|
||||
assocs sequences splitting sorting sets debugger
|
||||
strings vectors hashtables quotations arrays byte-arrays
|
||||
math.parser calendar calendar.format present
|
||||
|
||||
|
@ -27,9 +27,12 @@ IN: http
|
|||
: (read-header) ( -- alist )
|
||||
[ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
|
||||
|
||||
: collect-headers ( assoc -- assoc' )
|
||||
H{ } clone [ '[ , push-at ] assoc-each ] keep ;
|
||||
|
||||
: process-header ( alist -- assoc )
|
||||
f swap [ [ swap or dup ] dip swap ] assoc-map nip
|
||||
[ ?push ] histogram [ "; " join ] assoc-map
|
||||
collect-headers [ "; " join ] assoc-map
|
||||
>hashtable ;
|
||||
|
||||
: read-header ( -- assoc )
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend io.ports io.unix.backend io.files io
|
||||
unix unix.stat unix.time kernel math continuations
|
||||
math.bitfields byte-arrays alien combinators calendar
|
||||
math.bitwise byte-arrays alien combinators calendar
|
||||
io.encodings.binary accessors sequences strings system
|
||||
io.files.private destructors ;
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel io.ports io.unix.backend math.bitfields
|
||||
USING: kernel io.ports io.unix.backend math.bitwise
|
||||
unix io.files.unique.backend system ;
|
||||
IN: io.unix.files.unique
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types kernel math math.bitfields namespaces
|
||||
USING: alien.c-types kernel math math.bitwise namespaces
|
||||
locals accessors combinators threads vectors hashtables
|
||||
sequences assocs continuations sets
|
||||
unix unix.time unix.kqueue unix.process
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: kernel io.backend io.monitors io.monitors.recursive
|
|||
io.files io.buffers io.monitors io.ports io.timeouts
|
||||
io.unix.backend io.unix.select io.encodings.utf8
|
||||
unix.linux.inotify assocs namespaces threads continuations init
|
||||
math math.bitfields sets alien alien.strings alien.c-types
|
||||
math math.bitwise sets alien alien.strings alien.c-types
|
||||
vocabs.loader accessors system hashtables destructors unix ;
|
||||
IN: io.unix.linux.monitors
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien io io.files kernel math math.bitfields system unix
|
||||
USING: alien io io.files kernel math math.bitwise system unix
|
||||
io.unix.backend io.ports io.mmap destructors locals accessors ;
|
||||
IN: io.unix.mmap
|
||||
|
||||
|
|
|
@ -4,8 +4,7 @@ USING: alien.c-types io.binary io.backend io.files io.buffers
|
|||
io.windows kernel math splitting
|
||||
windows windows.kernel32 windows.time calendar combinators
|
||||
math.functions sequences namespaces words symbols system
|
||||
io.ports destructors accessors
|
||||
math.bitfields math.bitfields.lib ;
|
||||
io.ports destructors accessors math.bitwise ;
|
||||
IN: io.windows.files
|
||||
|
||||
: open-file ( path access-mode create-mode flags -- handle )
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: alien alien.c-types arrays destructors generic io.mmap
|
||||
io.ports io.windows io.windows.files io.windows.privileges
|
||||
kernel libc math math.bitfields namespaces quotations sequences
|
||||
kernel libc math math.bitwise namespaces quotations sequences
|
||||
windows windows.advapi32 windows.kernel32 io.backend system
|
||||
accessors locals ;
|
||||
IN: io.windows.mmap
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types libc destructors locals
|
||||
kernel math assocs namespaces continuations sequences hashtables
|
||||
sorting arrays combinators math.bitfields strings system
|
||||
sorting arrays combinators math.bitwise strings system
|
||||
accessors threads splitting
|
||||
io.backend io.windows io.windows.nt.backend io.windows.nt.files
|
||||
io.monitors io.ports io.buffers io.files io.timeouts io
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types arrays destructors io io.windows libc
|
||||
windows.types math.bitfields windows.kernel32 windows namespaces
|
||||
windows.types math.bitwise windows.kernel32 windows namespaces
|
||||
kernel sequences windows.errors assocs math.parser system random
|
||||
combinators accessors io.pipes io.ports ;
|
||||
IN: io.windows.nt.pipes
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: alien alien.c-types alien.syntax arrays continuations
|
||||
destructors generic io.mmap io.ports io.windows io.windows.files
|
||||
kernel libc math math.bitfields namespaces quotations sequences windows
|
||||
kernel libc math math.bitwise namespaces quotations sequences windows
|
||||
windows.advapi32 windows.kernel32 io.backend system accessors
|
||||
io.windows.privileges ;
|
||||
IN: io.windows.nt.privileges
|
||||
|
|
|
@ -5,7 +5,7 @@ io.buffers io.files io.ports io.sockets io.binary
|
|||
io.sockets io.timeouts windows.errors strings
|
||||
kernel math namespaces sequences windows windows.kernel32
|
||||
windows.shell32 windows.types windows.winsock splitting
|
||||
continuations math.bitfields system accessors ;
|
||||
continuations math.bitwise system accessors ;
|
||||
IN: io.windows
|
||||
|
||||
: set-inherit ( handle ? -- )
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
USING: sequences kernel math locals math.order math.ranges
|
||||
accessors combinators.lib arrays namespaces combinators
|
||||
combinators.short-circuit ;
|
||||
accessors arrays namespaces combinators combinators.short-circuit ;
|
||||
IN: lcs
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
@ -2,8 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors peg peg.parsers memoize kernel sequences
|
||||
logging arrays words strings vectors io io.files io.encodings.utf8
|
||||
namespaces combinators combinators.lib logging.server
|
||||
calendar calendar.format ;
|
||||
namespaces combinators logging.server calendar calendar.format ;
|
||||
IN: logging.parser
|
||||
|
||||
TUPLE: log-entry date level word-name message ;
|
||||
|
|
|
@ -1,27 +0,0 @@
|
|||
USING: accessors math math.bitfields tools.test kernel words ;
|
||||
IN: math.bitfields.tests
|
||||
|
||||
[ 0 ] [ { } bitfield ] unit-test
|
||||
[ 256 ] [ 1 { 8 } bitfield ] unit-test
|
||||
[ 268 ] [ 3 1 { 8 2 } bitfield ] unit-test
|
||||
[ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
|
||||
[ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
|
||||
|
||||
: a 1 ; inline
|
||||
: b 2 ; inline
|
||||
|
||||
: foo ( -- flags ) { a b } flags ;
|
||||
|
||||
[ 3 ] [ foo ] unit-test
|
||||
[ 3 ] [ { a b } flags ] unit-test
|
||||
\ foo must-infer
|
||||
|
||||
[ 0 ] [ { } bitfield-quot call ] unit-test
|
||||
|
||||
[ 256 ] [ 1 { 8 } bitfield-quot call ] unit-test
|
||||
|
||||
[ 268 ] [ 3 1 { 8 2 } bitfield-quot call ] unit-test
|
||||
|
||||
[ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
|
||||
|
||||
[ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test
|
|
@ -1,37 +0,0 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math sequences words
|
||||
namespaces stack-checker.transforms ;
|
||||
IN: math.bitfields
|
||||
|
||||
GENERIC: (bitfield) ( value accum shift -- newaccum )
|
||||
|
||||
M: integer (bitfield) ( value accum shift -- newaccum )
|
||||
swapd shift bitor ;
|
||||
|
||||
M: pair (bitfield) ( value accum pair -- newaccum )
|
||||
first2 >r dup word? [ swapd execute ] when r> shift bitor ;
|
||||
|
||||
: bitfield ( values... bitspec -- n )
|
||||
0 [ (bitfield) ] reduce ;
|
||||
|
||||
: flags ( values -- n )
|
||||
0 [ dup word? [ execute ] when bitor ] reduce ;
|
||||
|
||||
GENERIC: (bitfield-quot) ( spec -- quot )
|
||||
|
||||
M: integer (bitfield-quot) ( spec -- quot )
|
||||
[ swapd shift bitor ] curry ;
|
||||
|
||||
M: pair (bitfield-quot) ( spec -- quot )
|
||||
first2 over word? [ >r swapd execute r> ] [ ] ?
|
||||
[ shift bitor ] append 2curry ;
|
||||
|
||||
: bitfield-quot ( spec -- quot )
|
||||
[ (bitfield-quot) ] map [ 0 ] prefix concat ;
|
||||
|
||||
\ bitfield [ bitfield-quot ] 1 define-transform
|
||||
|
||||
\ flags [
|
||||
[ 0 , [ , \ bitor , ] each ] [ ] make
|
||||
] 1 define-transform
|
|
@ -1 +0,0 @@
|
|||
Domain-specific language for constructing integers
|
|
@ -1 +1,2 @@
|
|||
Slava Pestov
|
||||
Doug Coleman
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax math ;
|
||||
IN: math.bitfields
|
||||
IN: math.bitwise
|
||||
|
||||
ARTICLE: "math-bitfields" "Constructing bit fields"
|
||||
"Some applications, such as binary communication protocols and assemblers, need to construct integers from elaborate bit field specifications. Hand-coding this using " { $link shift } " and " { $link bitor } " results in repetitive code. A higher-level facility exists to factor out this repetition:"
|
||||
|
@ -35,3 +35,16 @@ HELP: bitfield
|
|||
" } ;"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: bits
|
||||
{ $values { "m" integer } { "n" integer } { "m'" integer } }
|
||||
{ $description "Keep only n bits from the integer m." }
|
||||
{ $example "USING: math.bitwise prettyprint ;" "HEX: 123abcdef 16 bits .h" "cdef" } ;
|
||||
|
||||
HELP: bitroll
|
||||
{ $values { "x" "an integer (input)" } { "s" "an integer (shift)" } { "w" "an integer (wrap)" } { "y" integer } }
|
||||
{ $description "Roll n by s bits to the left, wrapping around after w bits." }
|
||||
{ $examples
|
||||
{ $example "USING: math.bitwise prettyprint ;" "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
|
||||
{ $example "USING: math.bitwise prettyprint ;" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
|
||||
} ;
|
|
@ -0,0 +1,29 @@
|
|||
USING: accessors math math.bitwise tools.test kernel words ;
|
||||
IN: math.bitwise.tests
|
||||
|
||||
[ 0 ] [ 1 0 0 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 1 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 2 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 20 2 bitroll ] unit-test
|
||||
[ 1 ] [ 1 8 8 bitroll ] unit-test
|
||||
[ 1 ] [ 1 -8 8 bitroll ] unit-test
|
||||
[ 1 ] [ 1 -32 8 bitroll ] unit-test
|
||||
[ 128 ] [ 1 -1 8 bitroll ] unit-test
|
||||
[ 8 ] [ 1 3 32 bitroll ] unit-test
|
||||
|
||||
[ 0 ] [ { } bitfield ] unit-test
|
||||
[ 256 ] [ 1 { 8 } bitfield ] unit-test
|
||||
[ 268 ] [ 3 1 { 8 2 } bitfield ] unit-test
|
||||
[ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
|
||||
[ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
|
||||
|
||||
: a 1 ; inline
|
||||
: b 2 ; inline
|
||||
|
||||
: foo ( -- flags ) { a b } flags ;
|
||||
|
||||
[ 3 ] [ foo ] unit-test
|
||||
[ 3 ] [ { a b } flags ] unit-test
|
||||
\ foo must-infer
|
|
@ -0,0 +1,94 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math math.functions sequences
|
||||
sequences.private words namespaces macros hints
|
||||
combinators fry ;
|
||||
IN: math.bitwise
|
||||
|
||||
! utilities
|
||||
: clear-bit ( x n -- y ) 2^ bitnot bitand ; inline
|
||||
: set-bit ( x n -- y ) 2^ bitor ; inline
|
||||
: bit-clear? ( x n -- ? ) 2^ bitand zero? ; inline
|
||||
: unmask ( x n -- ? ) bitnot bitand ; inline
|
||||
: unmask? ( x n -- ? ) unmask 0 > ; inline
|
||||
: mask ( x n -- ? ) bitand ; inline
|
||||
: mask? ( x n -- ? ) mask 0 > ; inline
|
||||
: wrap ( m n -- m' ) 1- bitand ; inline
|
||||
: bits ( m n -- m' ) 2^ wrap ; inline
|
||||
: mask-bit ( m n -- m' ) 1- 2^ mask ; inline
|
||||
|
||||
: shift-mod ( n s w -- n )
|
||||
>r shift r> 2^ wrap ; inline
|
||||
|
||||
: bitroll ( x s w -- y )
|
||||
[ wrap ] keep
|
||||
[ shift-mod ]
|
||||
[ [ - ] keep shift-mod ] 3bi bitor ; inline
|
||||
|
||||
: bitroll-32 ( n s -- n' ) 32 bitroll ;
|
||||
|
||||
HINTS: bitroll-32 bignum fixnum ;
|
||||
|
||||
: bitroll-64 ( n s -- n' ) 64 bitroll ;
|
||||
|
||||
HINTS: bitroll-64 bignum fixnum ;
|
||||
|
||||
! 32-bit arithmetic
|
||||
: w+ ( int int -- int ) + 32 bits ; inline
|
||||
: w- ( int int -- int ) - 32 bits ; inline
|
||||
: w* ( int int -- int ) * 32 bits ; inline
|
||||
|
||||
! flags
|
||||
MACRO: flags ( values -- )
|
||||
[ 0 ] [ [ execute bitor ] curry compose ] reduce ;
|
||||
|
||||
! bitfield
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: (bitfield-quot) ( spec -- quot )
|
||||
|
||||
M: integer (bitfield-quot) ( spec -- quot )
|
||||
[ swapd shift bitor ] curry ;
|
||||
|
||||
M: pair (bitfield-quot) ( spec -- quot )
|
||||
first2 over word? [ >r swapd execute r> ] [ ] ?
|
||||
[ shift bitor ] append 2curry ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
MACRO: bitfield ( bitspec -- )
|
||||
[ 0 ] [ (bitfield-quot) compose ] reduce ;
|
||||
|
||||
! bit-count
|
||||
<PRIVATE
|
||||
|
||||
DEFER: byte-bit-count
|
||||
|
||||
<<
|
||||
|
||||
\ byte-bit-count
|
||||
256 [
|
||||
0 swap [ [ 1+ ] when ] each-bit
|
||||
] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
|
||||
|
||||
>>
|
||||
|
||||
GENERIC: (bit-count) ( x -- n )
|
||||
|
||||
M: fixnum (bit-count)
|
||||
{
|
||||
[ byte-bit-count ]
|
||||
[ -8 shift byte-bit-count ]
|
||||
[ -16 shift byte-bit-count ]
|
||||
[ -24 shift byte-bit-count ]
|
||||
} cleave + + + ;
|
||||
|
||||
M: bignum (bit-count)
|
||||
dup 0 = [ drop 0 ] [
|
||||
[ byte-bit-count ] [ -8 shift (bit-count) ] bi +
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: bit-count ( x -- n )
|
||||
dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline
|
|
@ -0,0 +1 @@
|
|||
Bitwise arithmetic utilities
|
|
@ -0,0 +1,8 @@
|
|||
IN: nmake.tests
|
||||
USING: nmake kernel tools.test ;
|
||||
|
||||
[ ] [ [ ] { } nmake ] unit-test
|
||||
|
||||
[ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
|
||||
|
||||
[ [ ] [ call ] curry { { } } nmake ] must-infer
|
|
@ -0,0 +1,44 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces sequences math.parser kernel macros
|
||||
generalizations locals ;
|
||||
IN: nmake
|
||||
|
||||
SYMBOL: building-seq
|
||||
: get-building-seq ( n -- seq )
|
||||
building-seq get nth ;
|
||||
|
||||
: n, ( obj n -- ) get-building-seq push ;
|
||||
: n% ( seq n -- ) get-building-seq push-all ;
|
||||
: n# ( num n -- ) >r number>string r> n% ;
|
||||
|
||||
: 0, ( obj -- ) 0 n, ;
|
||||
: 0% ( seq -- ) 0 n% ;
|
||||
: 0# ( num -- ) 0 n# ;
|
||||
: 1, ( obj -- ) 1 n, ;
|
||||
: 1% ( seq -- ) 1 n% ;
|
||||
: 1# ( num -- ) 1 n# ;
|
||||
: 2, ( obj -- ) 2 n, ;
|
||||
: 2% ( seq -- ) 2 n% ;
|
||||
: 2# ( num -- ) 2 n# ;
|
||||
: 3, ( obj -- ) 3 n, ;
|
||||
: 3% ( seq -- ) 3 n% ;
|
||||
: 3# ( num -- ) 3 n# ;
|
||||
: 4, ( obj -- ) 4 n, ;
|
||||
: 4% ( seq -- ) 4 n% ;
|
||||
: 4# ( num -- ) 4 n# ;
|
||||
|
||||
MACRO: finish-nmake ( exemplars -- )
|
||||
length [ firstn ] curry ;
|
||||
|
||||
:: nmake ( quot exemplars -- )
|
||||
[
|
||||
exemplars
|
||||
[ 0 swap new-resizable ] map
|
||||
building-seq set
|
||||
|
||||
quot call
|
||||
|
||||
building-seq get
|
||||
exemplars [ [ like ] 2map ] [ finish-nmake ] bi
|
||||
] with-scope ; inline
|
|
@ -2,7 +2,7 @@
|
|||
! Portions copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax combinators kernel system namespaces
|
||||
assocs parser lexer sequences words quotations math.bitfields ;
|
||||
assocs parser lexer sequences words quotations math.bitwise ;
|
||||
|
||||
IN: openssl.libssl
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel compiler.units words arrays strings math.parser sequences
|
||||
quotations vectors namespaces math assocs continuations peg
|
||||
peg.parsers unicode.categories multiline combinators.lib
|
||||
peg.parsers unicode.categories multiline
|
||||
splitting accessors effects sequences.deep peg.search
|
||||
combinators.short-circuit lexer io.streams.string
|
||||
stack-checker io prettyprint combinators parser ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math math.bit-count arrays kernel accessors locals sequences
|
||||
sequences.private sequences.lib
|
||||
USING: math math.bitwise arrays kernel accessors locals sequences
|
||||
sequences.private
|
||||
persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: kernel accessors math arrays fry sequences sequences.lib
|
||||
USING: kernel accessors math arrays fry sequences
|
||||
locals persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math accessors kernel arrays sequences sequences.private
|
||||
locals sequences.lib
|
||||
locals
|
||||
persistent.sequences
|
||||
persistent.hashtables.config
|
||||
persistent.hashtables.nodes ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Based on Clojure's PersistentHashMap by Rich Hickey.
|
||||
|
||||
USING: math arrays kernel sequences sequences.lib
|
||||
USING: math arrays kernel sequences
|
||||
accessors locals persistent.hashtables.config ;
|
||||
IN: persistent.hashtables.nodes
|
||||
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
! mersenne twister based on
|
||||
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
|
||||
USING: arrays kernel math namespaces sequences system init
|
||||
accessors math.ranges random circular math.bitfields.lib
|
||||
accessors math.ranges random circular math.bitwise
|
||||
combinators ;
|
||||
IN: random.mersenne-twister
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: random sequences tools.test ;
|
||||
USING: random sequences tools.test kernel ;
|
||||
IN: random.tests
|
||||
|
||||
[ 4 ] [ 4 random-bytes length ] unit-test
|
||||
|
@ -6,3 +6,6 @@ IN: random.tests
|
|||
|
||||
[ 4 ] [ [ 4 random-bytes length ] with-secure-random ] unit-test
|
||||
[ 7 ] [ [ 7 random-bytes length ] with-secure-random ] unit-test
|
||||
|
||||
[ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
|
||||
[ V{ } [ delete-random drop ] keep length ] must-fail
|
||||
|
|
|
@ -43,6 +43,9 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
|
|||
] keep nth
|
||||
] if ;
|
||||
|
||||
: delete-random ( seq -- elt )
|
||||
[ length random ] keep [ nth ] 2keep delete-nth ;
|
||||
|
||||
: random-bits ( n -- r ) 2^ random ;
|
||||
|
||||
: with-random ( tuple quot -- )
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels,
|
||||
! Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays namespaces io io.timeouts kernel logging io.sockets
|
||||
sequences combinators sequences.lib splitting assocs strings
|
||||
USING: arrays namespaces io io.timeouts kernel logging
|
||||
io.sockets sequences combinators splitting assocs strings
|
||||
math.parser random system calendar io.encodings.ascii summary
|
||||
calendar.format accessors sets hashtables ;
|
||||
IN: smtp
|
||||
|
@ -112,7 +112,7 @@ ERROR: smtp-transaction-failed < smtp-error ;
|
|||
} cond ;
|
||||
|
||||
: multiline? ( response -- boolean )
|
||||
?fourth CHAR: - = ;
|
||||
3 swap ?nth CHAR: - = ;
|
||||
|
||||
: process-multiline ( multiline -- response )
|
||||
>r readln r> 2dup " " append head? [
|
||||
|
@ -184,21 +184,3 @@ PRIVATE>
|
|||
|
||||
: send-email ( email -- )
|
||||
[ email>headers ] keep (send-email) ;
|
||||
|
||||
! Dirk's old AUTH CRAM-MD5 code. I don't know anything about
|
||||
! CRAM MD5, and the old code didn't work properly either, so here
|
||||
! it is in case anyone wants to fix it later.
|
||||
!
|
||||
! check-response used to have this clause:
|
||||
! { [ dup "334" head? ] [ " " split 1 swap nth base64> challenge set ] }
|
||||
!
|
||||
! and the rest of the code was as follows:
|
||||
! : (cram-md5-auth) ( -- response )
|
||||
! swap challenge get
|
||||
! string>md5-hmac hex-string
|
||||
! " " prepend append
|
||||
! >base64 ;
|
||||
!
|
||||
! : cram-md5-auth ( key login -- )
|
||||
! "AUTH CRAM-MD5\r\n" get-ok
|
||||
! (cram-md5-auth) "\r\n" append get-ok ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.streams.string kernel math namespaces sequences
|
||||
strings circular prettyprint debugger ascii sbufs fry summary
|
||||
accessors sequences.lib ;
|
||||
accessors ;
|
||||
IN: state-parser
|
||||
|
||||
! * Basic underlying words
|
||||
|
@ -120,7 +120,7 @@ M: not-enough-characters summary ( obj -- str )
|
|||
|
||||
: take ( n -- string )
|
||||
[ 1- ] [ <sbuf> ] bi [
|
||||
'[ drop get-char [ next , push f ] [ t ] if* ] attempt-each drop
|
||||
'[ drop get-char [ next , push f ] [ t ] if* ] contains? drop
|
||||
] keep get-char [ over push ] when* >string ;
|
||||
|
||||
: pass-blank ( -- )
|
||||
|
|
|
@ -3,8 +3,8 @@
|
|||
USING: assocs io.files hashtables kernel namespaces sequences
|
||||
vocabs.loader io combinators io.encodings.utf8 calendar accessors
|
||||
math.parser io.streams.string ui.tools.operations quotations
|
||||
strings arrays prettyprint words vocabs sorting sets cords
|
||||
classes sequences.lib combinators.lib ;
|
||||
strings arrays prettyprint words vocabs sorting sets
|
||||
classes ;
|
||||
IN: tools.scaffold
|
||||
|
||||
SYMBOL: developer-name
|
||||
|
@ -160,16 +160,18 @@ ERROR: no-vocab vocab ;
|
|||
|
||||
: help-file-string ( str1 -- str2 )
|
||||
[
|
||||
[ "IN: " write print nl ]
|
||||
[ interesting-words. ]
|
||||
[ "ARTICLE: " write unparse dup write bl print ";" print nl ]
|
||||
[ "ABOUT: " write unparse print ] quad
|
||||
{
|
||||
[ "IN: " write print nl ]
|
||||
[ interesting-words. ]
|
||||
[ "ARTICLE: " write unparse dup write bl print ";" print nl ]
|
||||
[ "ABOUT: " write unparse print ]
|
||||
} cleave
|
||||
] with-string-writer ;
|
||||
|
||||
: write-using ( -- )
|
||||
"USING:" write
|
||||
using get keys
|
||||
{ "help.markup" "help.syntax" } cord-append natural-sort
|
||||
{ "help.markup" "help.syntax" } append natural-sort
|
||||
[ bl write ] each
|
||||
" ;" print ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ui.backend ui.gadgets ui.gadgets.theme ui.gadgets.lib
|
||||
USING: ui.backend ui.gadgets ui.gadgets.theme
|
||||
ui.gadgets.worlds ui.render opengl opengl.gl kernel namespaces
|
||||
classes.tuple colors accessors ;
|
||||
IN: ui.gadgets.canvas
|
||||
|
|
|
@ -1,8 +0,0 @@
|
|||
|
||||
USING: accessors kernel ui.backend ui.gadgets.worlds ;
|
||||
|
||||
IN: ui.gadgets.lib
|
||||
|
||||
ERROR: no-world-found ;
|
||||
: find-gl-context ( gadget -- )
|
||||
find-world dup [ handle>> select-gl-context ] [ no-world-found ] if ;
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
|
@ -22,6 +22,12 @@ window-loc ;
|
|||
|
||||
: hide-status ( gadget -- ) f swap show-status ;
|
||||
|
||||
ERROR: no-world-found ;
|
||||
|
||||
: find-gl-context ( gadget -- )
|
||||
find-world dup
|
||||
[ handle>> select-gl-context ] [ no-world-found ] if ;
|
||||
|
||||
: (request-focus) ( child world ? -- )
|
||||
pick parent>> pick eq? [
|
||||
>r >r dup parent>> dup r> r>
|
||||
|
|
|
@ -8,7 +8,7 @@ sequences strings vectors words windows.kernel32 windows.gdi32
|
|||
windows.user32 windows.opengl32 windows.messages windows.types
|
||||
windows.nt windows threads libc combinators continuations
|
||||
command-line shuffle opengl ui.render unicode.case ascii
|
||||
math.bitfields locals symbols accessors math.geometry.rect ;
|
||||
math.bitwise locals symbols accessors math.geometry.rect ;
|
||||
IN: ui.windows
|
||||
|
||||
SINGLETON: windows-ui-backend
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax math math.bitfields ;
|
||||
USING: alien.syntax math math.bitwise ;
|
||||
IN: unix.linux.inotify
|
||||
|
||||
C-STRUCT: inotify-event
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel continuations sequences sequences.lib math
|
||||
USING: kernel continuations sequences math
|
||||
namespaces sets math.parser math.ranges assocs regexp
|
||||
unicode.categories arrays hashtables words
|
||||
classes quotations xmode.catalog ;
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: alias alien.syntax kernel math windows.types math.bitfields ;
|
||||
USING: alias alien.syntax kernel math windows.types math.bitwise ;
|
||||
IN: windows.advapi32
|
||||
LIBRARY: advapi32
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax parser namespaces kernel
|
||||
math math.bitfields windows.types windows.types init assocs
|
||||
math math.bitwise windows.types windows.types init assocs
|
||||
sequences libc ;
|
||||
IN: windows.opengl32
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax parser namespaces kernel math
|
||||
windows.types generalizations math.bitfields alias ;
|
||||
windows.types generalizations math.bitwise alias ;
|
||||
IN: windows.user32
|
||||
|
||||
! HKL for ActivateKeyboardLayout
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
USING: alien alien.c-types alien.strings alien.syntax arrays
|
||||
byte-arrays kernel math sequences windows.types windows.kernel32
|
||||
windows.errors structs windows math.bitfields alias ;
|
||||
windows.errors structs windows math.bitwise alias ;
|
||||
IN: windows.winsock
|
||||
|
||||
USE: libc
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types hashtables kernel math math.vectors math.bitfields
|
||||
namespaces sequences x11.xlib x11.constants x11.glx ;
|
||||
USING: alien alien.c-types hashtables kernel math math.vectors
|
||||
math.bitwise namespaces sequences x11.xlib x11.constants x11.glx ;
|
||||
IN: x11.windows
|
||||
|
||||
: create-window-mask ( -- n )
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
! and note the section.
|
||||
|
||||
USING: kernel arrays alien alien.c-types alien.strings
|
||||
alien.syntax math math.bitfields words sequences namespaces
|
||||
alien.syntax math math.bitwise words sequences namespaces
|
||||
continuations io.encodings.ascii ;
|
||||
IN: x11.xlib
|
||||
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
! Copyright (C) 2006, 2007 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces kernel xml.data xml.utilities assocs splitting
|
||||
sequences parser lexer quotations sequences.lib xml.utilities ;
|
||||
USING: namespaces kernel xml.data xml.utilities assocs sequences ;
|
||||
IN: xml.generator
|
||||
|
||||
: comment, ( string -- ) <comment> , ;
|
||||
|
@ -24,56 +23,3 @@ IN: xml.generator
|
|||
(tag,) build-xml ; inline
|
||||
: make-xml ( name quot -- xml )
|
||||
f swap make-xml* ; inline
|
||||
|
||||
! Word-based XML literal syntax
|
||||
: parsed-name ( accum -- accum )
|
||||
scan ":" split1 [ f <name> ] [ <simple-name> ] if* parsed ;
|
||||
|
||||
: run-combinator ( accum quot1 quot2 -- accum )
|
||||
>r [ ] like parsed r> [ parsed ] each ;
|
||||
|
||||
: parse-tag-contents ( accum contained? -- accum )
|
||||
[ \ contained*, parsed ] [
|
||||
scan-word \ [ =
|
||||
[ POSTPONE: [ \ tag*, parsed ]
|
||||
[ "Expected [ missing" throw ] if
|
||||
] if ;
|
||||
|
||||
DEFER: >>
|
||||
|
||||
: attributes-parsed ( accum quot -- accum )
|
||||
dup empty? [ drop f parsed ] [
|
||||
>r \ >r parsed r> parsed
|
||||
[ H{ } make-assoc r> swap ] [ parsed ] each
|
||||
] if ;
|
||||
|
||||
: <<
|
||||
parsed-name [
|
||||
\ >> parse-until >quotation
|
||||
attributes-parsed \ contained? get
|
||||
] with-scope parse-tag-contents ; parsing
|
||||
|
||||
: ==
|
||||
\ call parsed parsed-name \ set parsed ; parsing
|
||||
|
||||
: //
|
||||
\ contained? on ; parsing
|
||||
|
||||
: parse-special ( accum end-token word -- accum )
|
||||
>r parse-tokens " " join parsed r> parsed ;
|
||||
|
||||
: <!-- "-->" \ comment, parse-special ; parsing
|
||||
|
||||
: <! ">" \ directive, parse-special ; parsing
|
||||
|
||||
: <? "?>" \ instruction, parse-special ; parsing
|
||||
|
||||
: >xml-document ( seq -- xml )
|
||||
dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap
|
||||
[ tag? ] split-around <xml> ;
|
||||
|
||||
DEFER: XML>
|
||||
|
||||
: <XML
|
||||
\ XML> [ >quotation ] parse-literal
|
||||
{ } parsed \ make parsed \ >xml-document parsed ; parsing
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: xmode.marker
|
||||
USING: kernel namespaces xmode.rules xmode.tokens
|
||||
xmode.marker.state xmode.marker.context xmode.utilities
|
||||
xmode.catalog sequences math assocs combinators combinators.lib
|
||||
xmode.catalog sequences math assocs combinators
|
||||
strings regexp splitting parser-combinators ascii unicode.case
|
||||
combinators.short-circuit accessors ;
|
||||
|
||||
|
|
|
@ -315,6 +315,15 @@ HELP: empty?
|
|||
{ $values { "seq" sequence } { "?" "a boolean" } }
|
||||
{ $description "Tests if the sequence has zero length." } ;
|
||||
|
||||
HELP: if-empty
|
||||
{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
|
||||
{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and " { $snippet "quot1" } " is called. Otherwise, if the sequence has any elements, " { $snippet "quot2" } " is called on it." }
|
||||
{ $example
|
||||
"USING: kernel prettyprint sequences sequences.lib ;"
|
||||
"{ 1 2 3 } [ \"empty sequence\" ] [ sum ] if-empty ."
|
||||
"6"
|
||||
} ;
|
||||
|
||||
HELP: delete-all
|
||||
{ $values { "seq" "a resizable sequence" } }
|
||||
{ $description "Resizes the sequence to zero length, removing all elements. Not all sequences are resizable." }
|
||||
|
|
|
@ -3,6 +3,9 @@ sequences.private strings sbufs tools.test vectors
|
|||
generic vocabs.loader ;
|
||||
IN: sequences.tests
|
||||
|
||||
[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
|
||||
[ { 1 } "not empty" ] [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test
|
||||
|
||||
[ V{ 1 2 3 4 } ] [ 1 5 dup <slice> >vector ] unit-test
|
||||
[ 3 ] [ 1 4 dup <slice> length ] unit-test
|
||||
[ 2 ] [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
|
||||
|
|
|
@ -28,6 +28,14 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
|
|||
M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
|
||||
|
||||
: empty? ( seq -- ? ) length zero? ; inline
|
||||
|
||||
: if-empty ( seq quot1 quot2 -- )
|
||||
[ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
|
||||
|
||||
: when-empty ( seq quot1 -- ) [ ] if-empty ; inline
|
||||
|
||||
: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
|
||||
|
||||
: delete-all ( seq -- ) 0 swap set-length ;
|
||||
|
||||
: first ( seq -- first ) 0 swap nth ; inline
|
||||
|
@ -582,6 +590,9 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
|
|||
[ >r >r dup pick length + r> - over r> open-slice ] keep
|
||||
copy ;
|
||||
|
||||
: remove-nth ( n seq -- seq' )
|
||||
[ swap head-slice ] [ swap 1+ tail-slice ] 2bi append ;
|
||||
|
||||
: pop ( seq -- elt )
|
||||
[ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ;
|
||||
|
||||
|
@ -659,6 +670,9 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
|
|||
: cut-slice ( seq n -- before after )
|
||||
[ head-slice ] [ tail-slice ] 2bi ;
|
||||
|
||||
: insert-nth ( elt n seq -- seq' )
|
||||
swap cut-slice [ swap suffix ] dip append ;
|
||||
|
||||
: midpoint@ ( seq -- n ) length 2/ ; inline
|
||||
|
||||
: halves ( seq -- first second )
|
||||
|
|
|
@ -1,55 +1,17 @@
|
|||
USING: arrays kernel io io.binary sbufs splitting grouping
|
||||
strings sequences namespaces math math.parser parser
|
||||
hints math.bitfields.lib assocs ;
|
||||
hints math.bitwise assocs ;
|
||||
IN: crypto.common
|
||||
|
||||
: w+ ( int int -- int ) + 32 bits ; inline
|
||||
|
||||
: (nth-int) ( string n -- int )
|
||||
2 shift dup 4 + rot <slice> ; inline
|
||||
|
||||
: nth-int ( string n -- int ) (nth-int) le> ; inline
|
||||
|
||||
: nth-int-be ( string n -- int ) (nth-int) be> ; inline
|
||||
|
||||
: update ( num var -- ) [ w+ ] change ; inline
|
||||
|
||||
: calculate-pad-length ( length -- pad-length )
|
||||
dup 56 < 55 119 ? swap - ;
|
||||
|
||||
: preprocess-plaintext ( string big-endian? -- padded-string )
|
||||
#! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
|
||||
>r >sbuf r> over [
|
||||
HEX: 80 ,
|
||||
dup length HEX: 3f bitand
|
||||
calculate-pad-length 0 <string> %
|
||||
length 3 shift 8 rot [ >be ] [ >le ] if %
|
||||
] "" make over push-all ;
|
||||
|
||||
SYMBOL: bytes-read
|
||||
SYMBOL: big-endian?
|
||||
|
||||
: pad-last-block ( str big-endian? length -- str )
|
||||
[
|
||||
rot %
|
||||
HEX: 80 ,
|
||||
dup HEX: 3f bitand calculate-pad-length 0 <string> %
|
||||
3 shift 8 rot [ >be ] [ >le ] if %
|
||||
] "" make 64 group ;
|
||||
|
||||
: update-old-new ( old new -- )
|
||||
[ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline
|
||||
|
||||
: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ;
|
||||
|
||||
: seq>2seq ( seq -- seq1 seq2 )
|
||||
#! { abcdefgh } -> { aceg } { bdfh }
|
||||
2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
|
||||
|
||||
: 2seq>seq ( seq1 seq2 -- seq )
|
||||
#! { aceg } { bdfh } -> { abcdefgh }
|
||||
[ zip concat ] keep like ;
|
||||
|
||||
: mod-nth ( n seq -- elt )
|
||||
#! 5 "abcd" -> b
|
||||
[ length mod ] [ nth ] bi ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.bitfields combinators.lib math.parser
|
||||
USING: kernel math math.bitwise combinators.lib math.parser
|
||||
random sequences sequences.lib continuations namespaces
|
||||
io.files io arrays io.files.unique.backend system
|
||||
combinators vocabs.loader ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types assocs combinators destructors
|
||||
kernel math math.bitfields math.parser sequences summary system
|
||||
kernel math math.bitwise math.parser sequences summary system
|
||||
vocabs.loader ;
|
||||
IN: io.serial
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel math.bitfields sequences system io.serial ;
|
||||
USING: alien.syntax kernel math.bitwise sequences system io.serial ;
|
||||
IN: io.serial.unix
|
||||
|
||||
M: bsd lookup-baud ( m -- n )
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math.bitfields serial serial.unix ;
|
||||
USING: accessors kernel math.bitwise serial serial.unix ;
|
||||
IN: io.serial.unix
|
||||
|
||||
: serial-obj ( -- obj )
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.syntax combinators io.ports
|
||||
io.streams.duplex io.unix.backend system kernel math math.bitfields
|
||||
io.streams.duplex io.unix.backend system kernel math math.bitwise
|
||||
vocabs.loader unix io.serial io.serial.unix.termios ;
|
||||
IN: io.serial.unix
|
||||
|
||||
|
|
|
@ -1,38 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions quotations words sequences
|
||||
sequences.private combinators fry ;
|
||||
IN: math.bit-count
|
||||
|
||||
<PRIVATE
|
||||
|
||||
DEFER: byte-bit-count
|
||||
|
||||
<<
|
||||
|
||||
\ byte-bit-count
|
||||
256 [
|
||||
0 swap [ [ 1+ ] when ] each-bit
|
||||
] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
|
||||
|
||||
>>
|
||||
|
||||
GENERIC: (bit-count) ( x -- n )
|
||||
|
||||
M: fixnum (bit-count)
|
||||
{
|
||||
[ byte-bit-count ]
|
||||
[ -8 shift byte-bit-count ]
|
||||
[ -16 shift byte-bit-count ]
|
||||
[ -24 shift byte-bit-count ]
|
||||
} cleave + + + ;
|
||||
|
||||
M: bignum (bit-count)
|
||||
dup 0 = [ drop 0 ] [
|
||||
[ byte-bit-count ] [ -8 shift (bit-count) ] bi +
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: bit-count ( x -- n )
|
||||
dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline
|
|
@ -1,16 +0,0 @@
|
|||
USING: help.markup help.syntax kernel math sequences ;
|
||||
IN: math.bitfields.lib
|
||||
|
||||
HELP: bits
|
||||
{ $values { "m" integer } { "n" integer } { "m'" integer } }
|
||||
{ $description "Keep only n bits from the integer m." }
|
||||
{ $example "USING: math.bitfields.lib prettyprint ;" "HEX: 123abcdef 16 bits .h" "cdef" } ;
|
||||
|
||||
HELP: bitroll
|
||||
{ $values { "x" "an integer (input)" } { "s" "an integer (shift)" } { "w" "an integer (wrap)" } { "y" integer } }
|
||||
{ $description "Roll n by s bits to the left, wrapping around after w bits." }
|
||||
{ $examples
|
||||
{ $example "USING: math.bitfields.lib prettyprint ;" "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
|
||||
{ $example "USING: math.bitfields.lib prettyprint ;" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
|
||||
} ;
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
USING: math.bitfields.lib tools.test ;
|
||||
IN: math.bitfields.lib.test
|
||||
|
||||
[ 0 ] [ 1 0 0 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 1 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 2 bitroll ] unit-test
|
||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
||||
[ 1 ] [ 1 20 2 bitroll ] unit-test
|
||||
[ 1 ] [ 1 8 8 bitroll ] unit-test
|
||||
[ 1 ] [ 1 -8 8 bitroll ] unit-test
|
||||
[ 1 ] [ 1 -32 8 bitroll ] unit-test
|
||||
[ 128 ] [ 1 -1 8 bitroll ] unit-test
|
||||
[ 8 ] [ 1 3 32 bitroll ] unit-test
|
|
@ -1,30 +0,0 @@
|
|||
USING: hints kernel math ;
|
||||
IN: math.bitfields.lib
|
||||
|
||||
: clear-bit ( x n -- y ) 2^ bitnot bitand ; inline
|
||||
: set-bit ( x n -- y ) 2^ bitor ; inline
|
||||
: bit-clear? ( x n -- ? ) 2^ bitand zero? ; inline
|
||||
: unmask ( x n -- ? ) bitnot bitand ; inline
|
||||
: unmask? ( x n -- ? ) unmask 0 > ; inline
|
||||
: mask ( x n -- ? ) bitand ; inline
|
||||
: mask? ( x n -- ? ) mask 0 > ; inline
|
||||
: wrap ( m n -- m' ) 1- bitand ; inline
|
||||
: bits ( m n -- m' ) 2^ wrap ; inline
|
||||
: mask-bit ( m n -- m' ) 1- 2^ mask ; inline
|
||||
|
||||
: shift-mod ( n s w -- n )
|
||||
>r shift r> 2^ wrap ; inline
|
||||
|
||||
: bitroll ( x s w -- y )
|
||||
[ wrap ] keep
|
||||
[ shift-mod ]
|
||||
[ [ - ] keep shift-mod ] 3bi bitor ; inline
|
||||
|
||||
: bitroll-32 ( n s -- n' ) 32 bitroll ;
|
||||
|
||||
HINTS: bitroll-32 bignum fixnum ;
|
||||
|
||||
: bitroll-64 ( n s -- n' ) 64 bitroll ;
|
||||
|
||||
HINTS: bitroll-64 bignum fixnum ;
|
||||
|
|
@ -1,8 +1 @@
|
|||
IN: namespaces.lib.tests
|
||||
USING: namespaces.lib kernel tools.test ;
|
||||
|
||||
[ ] [ [ ] { } nmake ] unit-test
|
||||
|
||||
[ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
|
||||
|
||||
[ [ ] [ call ] curry { { } } nmake ] must-infer
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue