syntax: removing #! as a comment character.
We don't need two types of comments and shebang (#!) is handled natively by the lexer, so the original reason for #! is not valid.db4
John Benediktsson
parent
5fdc98cb97
commit
59caf874a3
|
|
@ -29,7 +29,6 @@ $nl
|
|||
"\"character strings\""
|
||||
"{ 1 2 3 }"
|
||||
"! by the way, this is a comment"
|
||||
"#! and so is this"
|
||||
}
|
||||
{ $references
|
||||
{ "Factor's syntax can be extended, the parser can be called reflectively, and the " { $link . } " word is in fact a general facility for turning almost any object into a form which can be parsed back in again. If this interests you, consult the following sections:" }
|
||||
|
|
@ -238,7 +237,7 @@ command-line get [
|
|||
{ $code "USE: regexp" "save" }
|
||||
"Now, the " { $snippet "grep.factor" } " script will start up much faster. See " { $link "images" } " for details."
|
||||
{ $heading "Executable scripts" }
|
||||
"It is also possible to make executable scripts. A Factor file can begin with a comment like the following:"
|
||||
"It is also possible to make executable scripts. A Factor file can begin with a 'shebang' like the following:"
|
||||
{ $code "#!/usr/bin/env factor" }
|
||||
"If the text file is made executable, then it can be run, assuming the " { $snippet "factor" } " binary is in your " { $snippet "$PATH" } "."
|
||||
{ $references
|
||||
|
|
|
|||
|
|
@ -9,8 +9,8 @@ IN: io.backend.unix.multiplexers.epoll
|
|||
|
||||
TUPLE: epoll-mx < mx events ;
|
||||
|
||||
#! We read up to 256 events at a time. This is an arbitrary
|
||||
#! constant...
|
||||
! We read up to 256 events at a time. This is an arbitrary
|
||||
! constant...
|
||||
CONSTANT: max-events 256
|
||||
|
||||
: <epoll-mx> ( -- mx )
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ f json-escape-slashes? set-global
|
|||
SYMBOL: json-escape-unicode?
|
||||
f json-escape-unicode? set-global
|
||||
|
||||
#! Writes the object out to a stream in JSON format
|
||||
! Writes the object out to a stream in JSON format
|
||||
GENERIC# stream-json-print 1 ( obj stream -- )
|
||||
|
||||
: json-print ( obj -- )
|
||||
|
|
|
|||
|
|
@ -516,7 +516,7 @@ foo=<foreign any-char> 'd'
|
|||
[ "fail" "foo" set "foo='a'" ebnf-parser parse transform drop t ] with-scope
|
||||
] unit-test
|
||||
|
||||
#! Tokenizer tests
|
||||
! Tokenizer tests
|
||||
{ V{ "a" CHAR: b } } [
|
||||
"ab" [EBNF tokenizer=default foo="a" . EBNF]
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -86,11 +86,11 @@ SYMBOL: lrstack
|
|||
|
||||
reset-pegs
|
||||
|
||||
#! An entry in the table of memoized parse results
|
||||
#! ast = an AST produced from the parse
|
||||
#! or the symbol 'fail'
|
||||
#! or a left-recursion object
|
||||
#! pos = the position in the input string of this entry
|
||||
! An entry in the table of memoized parse results
|
||||
! ast = an AST produced from the parse
|
||||
! or the symbol 'fail'
|
||||
! or a left-recursion object
|
||||
! pos = the position in the input string of this entry
|
||||
TUPLE: memo-entry ans pos ;
|
||||
|
||||
TUPLE: left-recursion seed rule-id head next ;
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ summary accessors continuations make math.parser io.styles namespaces
|
|||
compiler.errors prettyprint source-files.errors.debugger command-line ;
|
||||
IN: tools.errors
|
||||
|
||||
#! Tools for source-files.errors. Used by tools.tests and others
|
||||
#! for error reporting
|
||||
! Tools for source-files.errors. Used by tools.tests and others
|
||||
! for error reporting
|
||||
|
||||
: errors. ( errors -- )
|
||||
group-by-source-file sort-errors
|
||||
|
|
|
|||
|
|
@ -10,7 +10,6 @@ IN: bootstrap.syntax
|
|||
{
|
||||
"!"
|
||||
"\""
|
||||
"#!"
|
||||
"("
|
||||
":"
|
||||
";"
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ unit-test
|
|||
unit-test
|
||||
|
||||
! Test EOL comments in multiline strings.
|
||||
{ "Hello" } [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
|
||||
{ "Hello" } [ "! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
|
||||
|
||||
{ word } [ \ f class-of ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -278,7 +278,7 @@ INSTANCE: repetition immutable-sequence
|
|||
|
||||
ERROR: integer-length-expected obj ;
|
||||
|
||||
#! The check-length call forces partial dispatch
|
||||
! The check-length call forces partial dispatch
|
||||
: check-length ( n -- n )
|
||||
dup integer? [ integer-length-expected ] unless ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -29,7 +29,6 @@ $nl
|
|||
ARTICLE: "syntax-comments" "Comments"
|
||||
{ $subsections
|
||||
POSTPONE: !
|
||||
POSTPONE: #!
|
||||
} ;
|
||||
|
||||
ARTICLE: "syntax-immediate" "Parse time evaluation"
|
||||
|
|
@ -664,20 +663,6 @@ HELP: !
|
|||
{ $values { "comment" "characters" } }
|
||||
{ $description "Discards all input until the end of the line." } ;
|
||||
|
||||
{ POSTPONE: ! POSTPONE: #! } related-words
|
||||
|
||||
HELP: #!
|
||||
{ $syntax "#!comment..." }
|
||||
{ $values { "comment" "characters" } }
|
||||
{ $description "Discards all input until the end of the line." }
|
||||
{ $notes "To allow Unix-style \"shebang\" scripts to work as expected, " { $snippet "#!" } " is parsed as a separate token regardless of following whitespace if it appears at the beginning of a line."
|
||||
{ $example
|
||||
"#!/usr/bin/env/factor"
|
||||
"USING: io ;"
|
||||
"\"Hello world\" print"
|
||||
"Hello world"
|
||||
} } ;
|
||||
|
||||
HELP: NAN:
|
||||
{ $syntax "NAN: payload" }
|
||||
{ $values { "payload" "64-bit hexadecimal integer" } }
|
||||
|
|
|
|||
|
|
@ -50,8 +50,6 @@ IN: bootstrap.syntax
|
|||
|
||||
"!" [ lexer get next-line ] define-core-syntax
|
||||
|
||||
"#!" [ POSTPONE: ! ] define-core-syntax
|
||||
|
||||
"IN:" [ scan-token set-current-vocab ] define-core-syntax
|
||||
|
||||
"<PRIVATE" [ begin-private ] define-core-syntax
|
||||
|
|
|
|||
|
|
@ -134,6 +134,6 @@ PRIVATE>
|
|||
: stop ( -- )
|
||||
"stop" { } bitcoin-request drop ;
|
||||
|
||||
#! requires patched bitcoind
|
||||
! requires patched bitcoind
|
||||
:: list-transactions ( count include-generated -- seq )
|
||||
"listtransactions" { count include-generated } bitcoin-request ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors byte-arrays.hex crypto.aes crypto.aes.private
|
|||
crypto.aes.utils grouping kernel sequences tools.test ;
|
||||
IN: crypto.aes.tests
|
||||
|
||||
#! fips-197 test vectors
|
||||
! fips-197 test vectors
|
||||
CONSTANT: plaintext HEX{ 32 43 f6 a8 88 5a 30 8d 31 31 98 a2 e0 37 07 34 }
|
||||
CONSTANT: key HEX{ 2b 7e 15 16 28 ae d2 a6 ab f7 15 88 09 cf 4f 3c }
|
||||
|
||||
|
|
@ -145,10 +145,10 @@ CONSTANT: key HEX{ 2b 7e 15 16 28 ae d2 a6 ab f7 15 88 09 cf 4f 3c }
|
|||
0x4141c382 0x9999b029 0x2d2d775a 0x0f0f111e 0xb0b0cb7b 0x5454fca8 0xbbbbd66d 0x16163a2c
|
||||
} } [ t-table ] unit-test
|
||||
|
||||
#! NOT TESTED:
|
||||
#! ui32
|
||||
#! set-t
|
||||
#! set-d
|
||||
! NOT TESTED:
|
||||
! ui32
|
||||
! set-t
|
||||
! set-d
|
||||
|
||||
{ { 0x01020304 0x02030401 0x03040102 0x04010203 } } [
|
||||
{ 0x01010101 0x02020202 0x03030303 0x04040404 } shift-rows
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@ sequences.unrolled ;
|
|||
IN: crypto.aes
|
||||
|
||||
CONSTANT: AES_BLOCK_SIZE 16
|
||||
#! FIPS-197 AES
|
||||
#! input block, state, output block -- 4 32-bit words
|
||||
! FIPS-197 AES
|
||||
! input block, state, output block -- 4 32-bit words
|
||||
CONSTANT: FIPS-197 {
|
||||
{ 128 10 } ! aes-128 -- Key(4) Block(4) Rounds(10)
|
||||
{ 192 12 } ! aes-192 -- Key(6) Block(4) Rounds(12)
|
||||
|
|
@ -61,19 +61,19 @@ CONSTANT: FIPS-197 {
|
|||
256 0 <array>
|
||||
dup 256 [ dup sbox nth rot set-nth ] with each-integer ;
|
||||
|
||||
#! applies sbox to each byte of word
|
||||
! applies sbox to each byte of word
|
||||
: subword ( word -- word' )
|
||||
[ gb0 sbox nth ] keep [ gb1 sbox nth ] keep
|
||||
[ gb2 sbox nth ] keep gb3 sbox nth >ui32 ;
|
||||
|
||||
#! applies inverse sbox to each byte of word
|
||||
! applies inverse sbox to each byte of word
|
||||
: inv-subword ( word -- word' )
|
||||
[ gb0 inv-sbox nth ] keep [ gb1 inv-sbox nth ] keep
|
||||
[ gb2 inv-sbox nth ] keep gb3 inv-sbox nth >ui32 ;
|
||||
|
||||
: rotword ( n -- n ) 8 bitroll-32 ;
|
||||
|
||||
#! round constants, 2^n over GF(2^8)
|
||||
! round constants, 2^n over GF(2^8)
|
||||
: rcon ( -- array )
|
||||
{
|
||||
0x00 0x01 0x02 0x04 0x08 0x10
|
||||
|
|
@ -82,12 +82,12 @@ CONSTANT: FIPS-197 {
|
|||
|
||||
: (rcon-nth) ( n -- rcon[n] ) rcon nth 24 shift ;
|
||||
|
||||
#! Galois field product related
|
||||
! Galois field product related
|
||||
: xtime ( x -- x' )
|
||||
[ 1 shift ]
|
||||
[ 0x80 bitand 0 = 0 0x1b ? ] bi bitxor 8 bits ;
|
||||
|
||||
#! generate t-box
|
||||
! generate t-box
|
||||
:: set-t ( T i -- )
|
||||
i sbox nth :> a1
|
||||
a1 xtime :> a2
|
||||
|
|
@ -102,7 +102,7 @@ MEMO:: t-table ( -- array )
|
|||
1024 0 <array>
|
||||
dup 256 [ set-t ] with each-integer ;
|
||||
|
||||
#! generate inverse t-box
|
||||
! generate inverse t-box
|
||||
:: set-d ( D i -- )
|
||||
i inv-sbox nth :> a1
|
||||
a1 xtime :> a2
|
||||
|
|
@ -132,8 +132,8 @@ MEMO:: d-table ( -- array )
|
|||
: t-transform ( a0 a1 a2 a3 -- word' ) t-table (transform) ;
|
||||
: d-transform ( a0 a1 a2 a3 -- word' ) d-table (transform) ;
|
||||
|
||||
#! key schedule
|
||||
#! expands an 128/192/256 bit key into an 176/208/240 byte schedule
|
||||
! key schedule
|
||||
! expands an 128/192/256 bit key into an 176/208/240 byte schedule
|
||||
|
||||
SYMBOL: aes-expand-inner
|
||||
HOOK: key-expand-round aes-expand-inner ( temp i -- temp' )
|
||||
|
|
@ -166,8 +166,8 @@ M: aes-256-key key-expand-round ( temp i -- temp' )
|
|||
6 > [ aes-256-key ] [ aes-128-key ] if
|
||||
] tri ;
|
||||
|
||||
#! K -- input key (byte-array), Nr -- number of rounds
|
||||
#! output: sched, Nb(Nr+1) byte key schedule
|
||||
! K -- input key (byte-array), Nr -- number of rounds
|
||||
! output: sched, Nb(Nr+1) byte key schedule
|
||||
: (expand-enc-key) ( K Nr -- sched )
|
||||
[ bytes>words ] dip
|
||||
[ drop (init-round) ]
|
||||
|
|
@ -182,7 +182,7 @@ TUPLE: aes-state nrounds key state ;
|
|||
|
||||
: <aes> ( nrounds key state -- aes-state ) \ aes-state boa ;
|
||||
|
||||
#! grabs the 4n...4(n+1) words of the key
|
||||
! grabs the 4n...4(n+1) words of the key
|
||||
: (key-at-nth-round) ( nth aes -- seq )
|
||||
[ 4 * dup 4 + ] [ key>> ] bi* <slice> ;
|
||||
|
||||
|
|
@ -198,18 +198,18 @@ SINGLETON: aes-decrypt
|
|||
SINGLETON: aes-encrypt
|
||||
|
||||
|
||||
#! rotates the 2nd row left by one element
|
||||
#! rotates the 3rd row left by two elements
|
||||
#! rotates the 4th row left by three elements
|
||||
#!
|
||||
#! Kind of ugly because the algorithm is specified and
|
||||
#! implemented in terms of columns. This approach is very
|
||||
#! efficient in terms of execution and only requires one new
|
||||
#! word to implement.
|
||||
#!
|
||||
#! The alternative is to split into arrays of bytes, transpose,
|
||||
#! rotate each row n times, transpose again, and then
|
||||
#! smash them back into 4-byte words.
|
||||
! rotates the 2nd row left by one element
|
||||
! rotates the 3rd row left by two elements
|
||||
! rotates the 4th row left by three elements
|
||||
!
|
||||
! Kind of ugly because the algorithm is specified and
|
||||
! implemented in terms of columns. This approach is very
|
||||
! efficient in terms of execution and only requires one new
|
||||
! word to implement.
|
||||
!
|
||||
! The alternative is to split into arrays of bytes, transpose,
|
||||
! rotate each row n times, transpose again, and then
|
||||
! smash them back into 4-byte words.
|
||||
:: (shift-rows) ( c0 c1 c2 c3 -- c0' c1' c2' c3' )
|
||||
c3 gb0 c2 gb1 c1 gb2 c0 gb3 >ui32 ! c0'
|
||||
c0 gb0 c3 gb1 c2 gb2 c1 gb3 >ui32 ! c1'
|
||||
|
|
|
|||
|
|
@ -9,13 +9,13 @@ IN: crypto.aes.utils
|
|||
: gb2 ( a -- a2 ) -16 shift gb0 ; inline
|
||||
: gb3 ( a -- a3 ) -24 shift gb0 ; inline
|
||||
|
||||
#! pack 4 bytes into 32-bit unsigned int
|
||||
#! a3 is msb
|
||||
! pack 4 bytes into 32-bit unsigned int
|
||||
! a3 is msb
|
||||
: >ui32 ( a0 a1 a2 a3 -- a )
|
||||
[ 8 shift ] [ 16 shift ] [ 24 shift ] tri*
|
||||
bitor bitor bitor 32 bits ;
|
||||
|
||||
#! inverse of ui32
|
||||
! inverse of ui32
|
||||
: ui32> ( word -- a0 a1 a2 a3 )
|
||||
[ gb0 ] keep [ gb1 ] keep [ gb2 ] keep gb3 ; inline
|
||||
|
||||
|
|
@ -35,8 +35,8 @@ IN: crypto.aes.utils
|
|||
} cleave .h .h .h .h ;
|
||||
|
||||
|
||||
#! given 4 columns, output the first diagonal, i.e.
|
||||
#! C[0,0] C[1,1] C[2,2] C[3,3]
|
||||
! given 4 columns, output the first diagonal, i.e.
|
||||
! C[0,0] C[1,1] C[2,2] C[3,3]
|
||||
: first-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 )
|
||||
{ [ gb3 ] [ gb2 ] [ gb1 ] [ gb0 ] } spread ;
|
||||
|
||||
|
|
@ -45,8 +45,8 @@ IN: crypto.aes.utils
|
|||
: third-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) (4rot) second-diag ;
|
||||
: fourth-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) (4rot) third-diag ;
|
||||
|
||||
#! given 4 columns, output the first reverse diagonal, i.e.
|
||||
#! C[0,0] C[3,1] C[2,2] C[1,3]
|
||||
! given 4 columns, output the first reverse diagonal, i.e.
|
||||
! C[0,0] C[3,1] C[2,2] C[1,3]
|
||||
:: (-rev) ( c0 c1 c2 c3 -- c0 c3 c2 c1 ) c0 c3 c2 c1 ; inline
|
||||
: -first-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) (-rev) first-diag ;
|
||||
: -second-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) (-rev) (4rot) first-diag ;
|
||||
|
|
|
|||
|
|
@ -113,10 +113,7 @@ DEFER: expression-parser
|
|||
|
||||
: comment-parser ( -- parser )
|
||||
[
|
||||
[
|
||||
"#!" token sp ,
|
||||
"!" token sp ,
|
||||
] choice* hide ,
|
||||
"!" token hide ,
|
||||
[
|
||||
dup CHAR: \n = swap CHAR: \r = or not
|
||||
] satisfy repeat0 ,
|
||||
|
|
|
|||
|
|
@ -106,9 +106,9 @@ M: irc-message set-irc-command
|
|||
[ ?define-irc-parameters ] [ ?define-irc-trailing ] 2bi* ;
|
||||
PRIVATE>
|
||||
|
||||
#! SYNTAX: name string parameters ;
|
||||
#! IRC: type "COMMAND" slot1 ...;
|
||||
#! IRC: type "COMMAND" slot1 ... : trailing-slot;
|
||||
! SYNTAX: name string parameters ;
|
||||
! IRC: type "COMMAND" slot1 ...;
|
||||
! IRC: type "COMMAND" slot1 ... : trailing-slot;
|
||||
SYNTAX: IRC:
|
||||
scan-new-class
|
||||
[ scan-object register-irc-message-type ] keep
|
||||
|
|
|
|||
|
|
@ -186,8 +186,8 @@ M: or-parser parse ( input parser1 -- list )
|
|||
|
||||
TUPLE: sp-parser p1 ;
|
||||
|
||||
#! Return a parser that first skips all whitespace before
|
||||
#! calling the original parser.
|
||||
! Return a parser that first skips all whitespace before
|
||||
! calling the original parser.
|
||||
C: sp sp-parser
|
||||
|
||||
M: sp-parser parse ( input parser -- list )
|
||||
|
|
|
|||
|
|
@ -4,20 +4,20 @@ USING: kernel accessors sequences
|
|||
peg peg.ebnf peg.javascript.ast peg.javascript.tokenizer ;
|
||||
IN: peg.javascript.parser
|
||||
|
||||
#! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
#! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
|
||||
#! The interesting thing about this parser is the mixing of
|
||||
#! a default and non-default tokenizer. The JavaScript tokenizer
|
||||
#! removes all newlines. So when operating on tokens there is no
|
||||
#! need for newline and space skipping in the grammar. But JavaScript
|
||||
#! uses the newline in the 'automatic semicolon insertion' rule.
|
||||
#!
|
||||
#! If a statement ends in a newline, sometimes the semicolon can be
|
||||
#! skipped. So we define an 'nl' rule using the default tokenizer.
|
||||
#! This operates a character at a time. Using this 'nl' in the parser
|
||||
#! allows us to detect newlines when we need to for the semicolon
|
||||
#! insertion rule, but ignore it in all other places.
|
||||
! The interesting thing about this parser is the mixing of
|
||||
! a default and non-default tokenizer. The JavaScript tokenizer
|
||||
! removes all newlines. So when operating on tokens there is no
|
||||
! need for newline and space skipping in the grammar. But JavaScript
|
||||
! uses the newline in the 'automatic semicolon insertion' rule.
|
||||
!
|
||||
! If a statement ends in a newline, sometimes the semicolon can be
|
||||
! skipped. So we define an 'nl' rule using the default tokenizer.
|
||||
! This operates a character at a time. Using this 'nl' in the parser
|
||||
! allows us to detect newlines when we need to for the semicolon
|
||||
! insertion rule, but ignore it in all other places.
|
||||
EBNF: javascript
|
||||
tokenizer = default
|
||||
nl = "\r\n" | "\n"
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
USING: kernel sequences strings arrays math.parser peg peg.ebnf peg.javascript.ast ;
|
||||
IN: peg.javascript.tokenizer
|
||||
|
||||
#! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
#! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
|
||||
USE: prettyprint
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: kernel arrays strings math.parser sequences
|
|||
peg peg.ebnf peg.parsers memoize namespaces math ;
|
||||
IN: peg.pl0
|
||||
|
||||
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
|
||||
! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
|
||||
|
||||
EBNF: pl0
|
||||
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ CONSTANT: VALUE_STR { "Straight Flush" "Four of a Kind" "Full House" "Flush"
|
|||
:: (>ckf) ( rank suit -- n )
|
||||
rank rank suit rank card-bitfield ;
|
||||
|
||||
#! Cactus Kev Format
|
||||
! Cactus Kev Format
|
||||
GENERIC: >ckf ( string -- n )
|
||||
|
||||
M: string >ckf >upper 1 cut (>ckf) ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: tools.test redis.command-writer io.streams.string ;
|
||||
IN: redis.command-writer.tests
|
||||
|
||||
#! Connection
|
||||
! Connection
|
||||
{ "*1\r\n$4\r\nQUIT\r\n" }
|
||||
[ [ quit ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -13,7 +13,7 @@ IN: redis.command-writer.tests
|
|||
{ "*2\r\n$4\r\nAUTH\r\n$8\r\npassword\r\n" }
|
||||
[ [ "password" auth ] with-string-writer ] unit-test
|
||||
|
||||
#! String values
|
||||
! String values
|
||||
{ "*3\r\n$3\r\nSET\r\n$3\r\nkey\r\n$3\r\nfoo\r\n" }
|
||||
[ [ "foo" "key" set ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -50,7 +50,7 @@ IN: redis.command-writer.tests
|
|||
{ "*2\r\n$4\r\nTYPE\r\n$3\r\nkey\r\n" }
|
||||
[ [ "key" type ] with-string-writer ] unit-test
|
||||
|
||||
#! Key space
|
||||
! Key space
|
||||
{ "*2\r\n$4\r\nKEYS\r\n$4\r\npat*\r\n" }
|
||||
[ [ "pat*" keys ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -73,7 +73,7 @@ IN: redis.command-writer.tests
|
|||
{ "*3\r\n$6\r\nEXPIRE\r\n$3\r\nkey\r\n$1\r\n7\r\n" }
|
||||
[ [ 7 "key" expire ] with-string-writer ] unit-test
|
||||
|
||||
#! Lists
|
||||
! Lists
|
||||
{ "*3\r\n$5\r\nRPUSH\r\n$3\r\nkey\r\n$3\r\nfoo\r\n" }
|
||||
[ [ "foo" "key" rpush ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -104,7 +104,7 @@ IN: redis.command-writer.tests
|
|||
{ "*2\r\n$4\r\nRPOP\r\n$3\r\nkey\r\n" }
|
||||
[ [ "key" rpop ] with-string-writer ] unit-test
|
||||
|
||||
#! Sets
|
||||
! Sets
|
||||
{ "*3\r\n$4\r\nSADD\r\n$3\r\nkey\r\n$3\r\nfoo\r\n" }
|
||||
[ [ "foo" "key" sadd ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -140,7 +140,7 @@ IN: redis.command-writer.tests
|
|||
{ "*2\r\n$8\r\nSMEMBERS\r\n$3\r\nkey\r\n" }
|
||||
[ [ "key" smembers ] with-string-writer ] unit-test
|
||||
|
||||
#! Hashes
|
||||
! Hashes
|
||||
{ "*3\r\n$4\r\nHDEL\r\n$3\r\nkey\r\n$5\r\nfield\r\n" }
|
||||
[ [ "field" "key" hdel ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -201,7 +201,7 @@ IN: redis.command-writer.tests
|
|||
{ "*2\r\n$5\r\nHVALS\r\n$3\r\nkey\r\n" }
|
||||
[ [ "key" hvals ] with-string-writer ] unit-test
|
||||
|
||||
#! Multiple db
|
||||
! Multiple db
|
||||
{ "*2\r\n$6\r\nSELECT\r\n$1\r\n2\r\n" }
|
||||
[ [ 2 select ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -214,9 +214,9 @@ IN: redis.command-writer.tests
|
|||
{ "*1\r\n$8\r\nFLUSHALL\r\n" }
|
||||
[ [ flushall ] with-string-writer ] unit-test
|
||||
|
||||
#! Sorting
|
||||
! Sorting
|
||||
|
||||
#! Persistence control
|
||||
! Persistence control
|
||||
{ "*1\r\n$4\r\nSAVE\r\n" } [ [ save ] with-string-writer ] unit-test
|
||||
|
||||
{ "*1\r\n$6\r\nBGSAVE\r\n" } [ [ bgsave ] with-string-writer ] unit-test
|
||||
|
|
@ -225,7 +225,7 @@ IN: redis.command-writer.tests
|
|||
|
||||
{ "*1\r\n$8\r\nSHUTDOWN\r\n" } [ [ shutdown ] with-string-writer ] unit-test
|
||||
|
||||
#! Remote server control
|
||||
! Remote server control
|
||||
{ "*1\r\n$4\r\nINFO\r\n" } [ [ info ] with-string-writer ] unit-test
|
||||
|
||||
{ "*1\r\n$7\r\nMONITOR\r\n" } [ [ monitor ] with-string-writer ] unit-test
|
||||
|
|
|
|||
|
|
@ -25,12 +25,12 @@ M: sequence write-resp ( sequence -- )
|
|||
|
||||
PRIVATE>
|
||||
|
||||
#! Connection
|
||||
! Connection
|
||||
: quit ( -- ) { "QUIT" } write-resp ;
|
||||
: ping ( -- ) { "PING" } write-resp ;
|
||||
: auth ( password -- ) 1array "AUTH" write-command ;
|
||||
|
||||
#! String values
|
||||
! String values
|
||||
: set ( value key -- ) 2array "SET" write-command ;
|
||||
: get ( key -- ) 1array "GET" write-command ;
|
||||
: getset ( value key -- ) 2array "GETSET" write-command ;
|
||||
|
|
@ -44,7 +44,7 @@ PRIVATE>
|
|||
: del ( key -- ) 1array "DEL" write-command ;
|
||||
: type ( key -- ) 1array "TYPE" write-command ;
|
||||
|
||||
#! Key space
|
||||
! Key space
|
||||
: keys ( pattern -- ) 1array "KEYS" write-command ;
|
||||
: randomkey ( -- ) { "RANDOMKEY" } write-resp ;
|
||||
: rename ( newkey key -- ) 2array "RENAME" write-command ;
|
||||
|
|
@ -52,7 +52,7 @@ PRIVATE>
|
|||
: dbsize ( -- ) { "DBSIZE" } write-resp ;
|
||||
: expire ( integer key -- ) 2array "EXPIRE" write-command ;
|
||||
|
||||
#! Lists
|
||||
! Lists
|
||||
: rpush ( value key -- ) 2array "RPUSH" write-command ;
|
||||
: lpush ( value key -- ) 2array "LPUSH" write-command ;
|
||||
: llen ( key -- ) 1array "LLEN" write-command ;
|
||||
|
|
@ -66,7 +66,7 @@ PRIVATE>
|
|||
: lpop ( key -- ) 1array "LPOP" write-command ;
|
||||
: rpop ( key -- ) 1array "RPOP" write-command ;
|
||||
|
||||
#! Sets
|
||||
! Sets
|
||||
: sadd ( member key -- ) 2array "SADD" write-command ;
|
||||
: srem ( member key -- ) 2array "SREM" write-command ;
|
||||
: smove ( member newkey key -- )
|
||||
|
|
@ -82,7 +82,7 @@ PRIVATE>
|
|||
[ reverse ] dip suffix "SUNIONSTORE" write-command ;
|
||||
: smembers ( key -- ) 1array "SMEMBERS" write-command ;
|
||||
|
||||
#! Hashes
|
||||
! Hashes
|
||||
: hdel ( field key -- ) 2array "HDEL" write-command ;
|
||||
: hexists ( field key -- ) 2array "HEXISTS" write-command ;
|
||||
: hget ( field key -- ) 2array "HGET" write-command ;
|
||||
|
|
@ -103,21 +103,21 @@ PRIVATE>
|
|||
3array "HSETNX" write-command ;
|
||||
: hvals ( key -- ) 1array "HVALS" write-command ;
|
||||
|
||||
#! Multiple db
|
||||
! Multiple db
|
||||
: select ( integer -- ) 1array "SELECT" write-command ;
|
||||
: move ( integer key -- ) 2array "MOVE" write-command ;
|
||||
: flushdb ( -- ) { "FLUSHDB" } write-resp ;
|
||||
: flushall ( -- ) { "FLUSHALL" } write-resp ;
|
||||
|
||||
#! Sorting
|
||||
! Sorting
|
||||
! sort
|
||||
|
||||
#! Persistence control
|
||||
! Persistence control
|
||||
: save ( -- ) { "SAVE" } write-resp ;
|
||||
: bgsave ( -- ) { "BGSAVE" } write-resp ;
|
||||
: lastsave ( -- ) { "LASTSAVE" } write-resp ;
|
||||
: shutdown ( -- ) { "SHUTDOWN" } write-resp ;
|
||||
|
||||
#! Remote server control
|
||||
! Remote server control
|
||||
: info ( -- ) { "INFO" } write-resp ;
|
||||
: monitor ( -- ) { "MONITOR" } write-resp ;
|
||||
|
|
|
|||
|
|
@ -5,12 +5,12 @@ io.timeouts kernel redis.command-writer redis.response-parser
|
|||
io.encodings.utf8 ;
|
||||
IN: redis
|
||||
|
||||
#! Connection
|
||||
! Connection
|
||||
: redis-quit ( -- ) quit flush ;
|
||||
: redis-ping ( -- response ) ping flush read-response ;
|
||||
: redis-auth ( password -- response ) auth flush read-response ;
|
||||
|
||||
#! String values
|
||||
! String values
|
||||
: redis-set ( value key -- ) set flush check-response ;
|
||||
: redis-get ( key -- response ) get flush read-response ;
|
||||
: redis-getset ( value key -- response ) getset flush read-response ;
|
||||
|
|
@ -24,7 +24,7 @@ IN: redis
|
|||
: redis-del ( key -- response ) del flush read-response ;
|
||||
: redis-type ( key -- response ) type flush read-response ;
|
||||
|
||||
#! Key space
|
||||
! Key space
|
||||
: redis-keys ( pattern -- response ) keys flush read-response ;
|
||||
: redis-randomkey ( -- response ) randomkey flush read-response ;
|
||||
: redis-rename ( newkey key -- response ) rename flush read-response ;
|
||||
|
|
@ -32,7 +32,7 @@ IN: redis
|
|||
: redis-dbsize ( -- response ) dbsize flush read-response ;
|
||||
: redis-expire ( integer key -- response ) expire flush read-response ;
|
||||
|
||||
#! Lists
|
||||
! Lists
|
||||
: redis-rpush ( value key -- response ) rpush flush read-response ;
|
||||
: redis-lpush ( value key -- response ) lpush flush read-response ;
|
||||
: redis-llen ( key -- response ) llen flush read-response ;
|
||||
|
|
@ -44,7 +44,7 @@ IN: redis
|
|||
: redis-lpop ( key -- response ) lpop flush read-response ;
|
||||
: redis-rpop ( key -- response ) rpop flush read-response ;
|
||||
|
||||
#! Sets
|
||||
! Sets
|
||||
: redis-sadd ( member key -- response ) sadd flush read-response ;
|
||||
: redis-srem ( member key -- response ) srem flush read-response ;
|
||||
: redis-smove ( member newkey key -- response ) smove flush read-response ;
|
||||
|
|
@ -56,7 +56,7 @@ IN: redis
|
|||
: redis-sunionstore ( keys destkey -- response ) sunionstore flush read-response ;
|
||||
: redis-smembers ( key -- response ) smembers flush read-response ;
|
||||
|
||||
#! Hashes
|
||||
! Hashes
|
||||
: redis-hdel ( field key -- response ) hdel flush read-response ;
|
||||
: redis-hexists ( field key -- response ) hexists flush read-response ;
|
||||
: redis-hget ( field key -- response ) hget flush read-response ;
|
||||
|
|
@ -71,26 +71,26 @@ IN: redis
|
|||
: redis-hsetnx ( value field key -- response ) hsetnx flush read-response ;
|
||||
: redis-hvals ( key -- response ) hvals flush read-response ;
|
||||
|
||||
#! Multiple db
|
||||
! Multiple db
|
||||
: redis-select ( integer -- ) select flush check-response ;
|
||||
: redis-move ( integer key -- response ) move flush read-response ;
|
||||
: redis-flushdb ( -- ) flushdb flush check-response ;
|
||||
: redis-flushall ( -- ) flushall flush check-response ;
|
||||
|
||||
#! Sorting
|
||||
! Sorting
|
||||
! sort
|
||||
|
||||
#! Persistence control
|
||||
! Persistence control
|
||||
: redis-save ( -- ) save flush check-response ;
|
||||
: redis-bgsave ( -- ) bgsave flush check-response ;
|
||||
: redis-lastsave ( -- response ) lastsave flush read-response ;
|
||||
: redis-shutdown ( -- ) shutdown flush check-response ;
|
||||
|
||||
#! Remote server control
|
||||
! Remote server control
|
||||
: redis-info ( -- response ) info flush read-response ;
|
||||
: redis-monitor ( -- response ) monitor flush read-response ;
|
||||
|
||||
#! Redis object
|
||||
! Redis object
|
||||
TUPLE: redis host port encoding password ;
|
||||
|
||||
CONSTANT: default-redis-port 6379
|
||||
|
|
|
|||
|
|
@ -11,8 +11,8 @@ TUPLE: board { width integer } { height integer } rows ;
|
|||
: <board> ( width height -- board )
|
||||
2dup make-rows board boa ;
|
||||
|
||||
#! A block is simply an array of form { x y } where { 0 0 } is the top-left of
|
||||
#! the tetris board, and { 9 19 } is the bottom right on a 10x20 board.
|
||||
! A block is simply an array of form { x y } where { 0 0 } is the top-left of
|
||||
! the tetris board, and { 9 19 } is the bottom right on a 10x20 board.
|
||||
|
||||
: board@block ( board block -- n row )
|
||||
[ second swap rows>> nth ] keep first swap ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ namespaces opengl opengl.gl sequences tetris.board tetris.game
|
|||
tetris.piece ui.render tetris.tetromino ui.gadgets colors ;
|
||||
IN: tetris.gl
|
||||
|
||||
#! OpenGL rendering for tetris
|
||||
! OpenGL rendering for tetris
|
||||
|
||||
: draw-block ( block -- )
|
||||
{ 1 1 } gl-fill-rect ;
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
USING: accessors arrays kernel math math.vectors sequences tetris.tetromino lists.lazy ;
|
||||
IN: tetris.piece
|
||||
|
||||
#! The rotation is an index into the tetromino's states array, and the
|
||||
#! position is added to the tetromino's blocks to give them their location on the
|
||||
#! tetris board. If the location is f then the piece is not yet on the board.
|
||||
! The rotation is an index into the tetromino's states array, and the
|
||||
! position is added to the tetromino's blocks to give them their location on the
|
||||
! tetris board. If the location is f then the piece is not yet on the board.
|
||||
|
||||
TUPLE: piece
|
||||
{ tetromino tetromino }
|
||||
|
|
|
|||
Loading…
Reference in New Issue