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

factor: random syntax update

modern-harvey2
Doug Coleman 2017-08-26 15:34:23 -05:00
parent 88e772ef17
commit 28ffd303cb
7 changed files with 52 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/memoize/syntax/syntax-docs.factor
View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax memoize.syntax ; USING: help.markup help.syntax memoize.syntax ;
HELP: MEMO[ HELP: \MEMO[
{ $syntax "MEMO[ elements... ]" } { $syntax "MEMO[ elements... ]" }
{ $description "Defines the given literal quotation as one which memoizes its outputs given a particular input." } ; { $description "Defines the given literal quotation as one which memoizes its outputs given a particular input." } ;

2
basis/memoize/syntax/syntax.factor
View File

@ -2,4 +2,4 @@ USING: kernel memoize parser sequences stack-checker ;
IN: memoize.syntax IN: memoize.syntax
SYNTAX: MEMO[ parse-quotation dup infer memoize-quot suffix! ; SYNTAX: \MEMO[ parse-quotation dup infer memoize-quot suffix! ;

10
extra/forestdb/lib/lib.factor
View File

@ -8,10 +8,8 @@ sequences strings ;
QUALIFIED: sets QUALIFIED: sets
IN: forestdb.lib IN: forestdb.lib
/*
! Issues ! Issues
! Get byseq ignores seqnum and uses key instead if key is set ! Get byseq ignores seqnum and uses key instead if key is set
*/
ERROR: fdb-error error ; ERROR: fdb-error error ;
@ -221,7 +219,7 @@ CONSTRUCTOR: <fdb-doc> fdb-doc ( seqnum keylen key metalen meta bodylen body del
TUPLE: fdb-info filename new-filename doc-count space-used file-size ; TUPLE: fdb-info filename new-filename doc-count space-used file-size ;
CONSTRUCTOR: <info> fdb-info ( filename new-filename doc-count space-used file-size -- obj ) ; CONSTRUCTOR: <info> fdb-info ( filename new-filename doc-count space-used file-size -- obj ) ;
/* ![[
! Example fdb_doc and converted doc ! Example fdb_doc and converted doc
S{ fdb_doc S{ fdb_doc
{ keylen 4 } { metalen 0 } { bodylen 4 } { size_ondisk 0 } { keylen 4 } { metalen 0 } { bodylen 4 } { size_ondisk 0 }
@ -234,7 +232,7 @@ T{ doc
{ metalen 0 } { bodylen 4 } { metalen 0 } { bodylen 4 }
{ offset 4256 } { size-ondisk 0 } { offset 4256 } { size-ondisk 0 }
} }
*/ ]]
: alien/length>string ( alien n -- string/f ) : alien/length>string ( alien n -- string/f )
[ drop f ] [ [ drop f ] [
@ -395,7 +393,7 @@ PRIVATE>
_ _ with-kvs-name _ _ with-kvs-name
] with-forestdb-file-handle ; inline ] with-forestdb-file-handle ; inline
/* ![[
! Do not try to commit here, as it will fail with FDB_RESULT_RONLY_VIOLATION ! Do not try to commit here, as it will fail with FDB_RESULT_RONLY_VIOLATION
! fdb-current is weird, it gets replaced if you call fdb-rollback ! fdb-current is weird, it gets replaced if you call fdb-rollback
! Therefore, only clean up fdb-current once, and clean it up at the end ! Therefore, only clean up fdb-current once, and clean it up at the end
@ -443,4 +441,4 @@ PRIVATE>
: with-forestdb-path ( path quot -- ) : with-forestdb-path ( path quot -- )
[ absolute-path fdb-open-default-config ] dip with-forestdb-handles-commit-wal ; inline [ absolute-path fdb-open-default-config ] dip with-forestdb-handles-commit-wal ; inline
! [ absolute-path fdb-open-default-config ] dip with-forestdb-handle-commit-normal ; inline ! [ absolute-path fdb-open-default-config ] dip with-forestdb-handle-commit-normal ; inline
*/ ]]

2
extra/literate/literate.factor
View File

@ -19,7 +19,7 @@ M: literate-lexer skip-blank
] [ drop ] if* ] [ drop ] if*
] [ call-next-method ] if ; ] [ call-next-method ] if ;
SYNTAX: <LITERATE SYNTAX: \<LITERATE
"LITERATE>" parse-multiline-string string-lines [ "LITERATE>" parse-multiline-string string-lines [
<literate-lexer> (parse-lines) append! <literate-lexer> (parse-lines) append!
] with-nested-compilation-unit ; ] with-nested-compilation-unit ;

72
extra/metar/metar.factor
View File

@ -26,14 +26,14 @@ ERROR: bad-location str ;
} case ; } case ;
: string>longitude ( str -- lon/f ) : string>longitude ( str -- lon/f )
dup R/ \d+-\d+(-\d+(\.\d+)?)?[WE]/ matches? [ dup R{{ \d+-\d+(-\d+(\.\d+)?)?[WE]}} matches? [
unclip-last unclip-last
[ parse-location ] [ parse-location ]
[ char: W = [ neg ] when ] bi* [ char: W = [ neg ] when ] bi*
] [ drop f ] if ; ] [ drop f ] if ;
: string>latitude ( str -- lat/f ) : string>latitude ( str -- lat/f )
dup R/ \d+-\d+(-\d+(\.\d+)?)?[NS]/ matches? [ dup R{{ \d+-\d+(-\d+(\.\d+)?)?[NS]}} matches? [
unclip-last unclip-last
[ parse-location ] [ parse-location ]
[ char: S = [ neg ] when ] bi* [ char: S = [ neg ] when ] bi*
@ -277,16 +277,16 @@ CONSTANT: sky H{
unclip [ string>number ] [ char: A = ] bi* unclip [ string>number ] [ char: A = ] bi*
[ 100 /f "%.2f Hg" sprintf ] [ "%s hPa" sprintf ] if ; [ 100 /f "%.2f Hg" sprintf ] [ "%s hPa" sprintf ] if ;
CONSTANT: re-timestamp R/ \d{6}Z/ CONSTANT: re-timestamp R[[ \d{6}Z]]
CONSTANT: re-station R/ \w{4}/ CONSTANT: re-station R[[ \w{4}]]
CONSTANT: re-temperature R/ [M]?\d{2}\\/([M]?\d{2})?/ CONSTANT: re-temperature R[[ [M]?\d{2}\\/([M]?\d{2})?]]
CONSTANT: re-wind R/ (VRB|\d{3})\d{2,3}(G\d{2,3})?KT/ CONSTANT: re-wind R[[ (VRB|\d{3})\d{2,3}(G\d{2,3})?KT]]
CONSTANT: re-wind-variable R/ \d{3}V\d{3}/ CONSTANT: re-wind-variable R[[ \d{3}V\d{3}]]
CONSTANT: re-visibility R/ [MP]?\d+(\\/\d+)?SM/ CONSTANT: re-visibility R[[ [MP]?\d+(\\/\d+)?SM]]
CONSTANT: re-rvr R/ R\d{2}[RLC]?\\/\d{4}(V\d{4})?FT/ CONSTANT: re-rvr R[[ R\d{2}[RLC]?\\/\d{4}(V\d{4})?FT]]
CONSTANT: re-weather R/ [+-]?(VC)?(\w{2}|\w{4})/ CONSTANT: re-weather R[[ [+-]?(VC)?(\w{2}|\w{4})]]
CONSTANT: re-sky-condition R/ (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)/ CONSTANT: re-sky-condition R[[ (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)]]
CONSTANT: re-altimeter R/ [AQ]\d{4}/ CONSTANT: re-altimeter R[[ [AQ]\d{4}]]
: find-one ( seq quot: ( elt -- ? ) -- seq elt/f ) : find-one ( seq quot: ( elt -- ? ) -- seq elt/f )
dupd find drop [ tail unclip ] [ f ] if* ; inline dupd find drop [ tail unclip ] [ f ] if* ; inline
@ -462,7 +462,7 @@ CONSTANT: high-clouds H{
: parse-lightning ( str -- str' ) : parse-lightning ( str -- str' )
"LTG" ?head drop 2 group [ lightning at ] map " " join ; "LTG" ?head drop 2 group [ lightning at ] map " " join ;
CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/ CONSTANT: re-recent-weather R[[ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+]]
: parse-began/ended ( str -- str' ) : parse-began/ended ( str -- str' )
unclip swap unclip swap
@ -512,27 +512,27 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
: parse-remark ( str -- str' ) : parse-remark ( str -- str' )
{ {
{ [ dup glossary key? ] [ glossary at ] } { [ dup glossary key? ] [ glossary at ] }
{ [ dup R/ 1\d{4}/ matches? ] [ parse-6hr-max-temp ] } { [ dup R[[ 1\d{4}]] matches? ] [ parse-6hr-max-temp ] }
{ [ dup R/ 2\d{4}/ matches? ] [ parse-6hr-min-temp ] } { [ dup R[[ 2\d{4}]] matches? ] [ parse-6hr-min-temp ] }
{ [ dup R/ 4\d{8}/ matches? ] [ parse-24hr-temp ] } { [ dup R[[ 4\d{8}]] matches? ] [ parse-24hr-temp ] }
{ [ dup R/ 4\\/\d{3}/ matches? ] [ parse-snow-depth ] } { [ dup R[[ 4\\/\d{3}]] matches? ] [ parse-snow-depth ] }
{ [ dup R/ 5\d{4}/ matches? ] [ parse-1hr-pressure ] } { [ dup R[[ 5\d{4}]] matches? ] [ parse-1hr-pressure ] }
{ [ dup R/ 6[\d\\/]{4}/ matches? ] [ parse-6hr-precipitation ] } { [ dup R[[ 6[\d\\/]{4}]] matches? ] [ parse-6hr-precipitation ] }
{ [ dup R/ 7\d{4}/ matches? ] [ parse-24hr-precipitation ] } { [ dup R[[ 7\d{4}]] matches? ] [ parse-24hr-precipitation ] }
{ [ dup R/ 8\\/\d{3}/ matches? ] [ parse-cloud-cover ] } { [ dup R[[ 8\\/\d{3}]] matches? ] [ parse-cloud-cover ] }
{ [ dup R/ 931\d{3}/ matches? ] [ parse-6hr-snowfall ] } { [ dup R[[ 931\d{3}]] matches? ] [ parse-6hr-snowfall ] }
{ [ dup R/ 933\d{3}/ matches? ] [ parse-water-equivalent-snow ] } { [ dup R[[ 933\d{3}]] matches? ] [ parse-water-equivalent-snow ] }
{ [ dup R/ 98\d{3}/ matches? ] [ parse-duration-of-sunshine ] } { [ dup R[[ 98\d{3}]] matches? ] [ parse-duration-of-sunshine ] }
{ [ dup R/ T\d{4,8}/ matches? ] [ parse-1hr-temp ] } { [ dup R[[ T\d{4,8}]] matches? ] [ parse-1hr-temp ] }
{ [ dup R/ \d{3}\d{2,3}\\/\d{2,4}/ matches? ] [ parse-peak-wind ] } { [ dup R[[ \d{3}\d{2,3}\\/\d{2,4}]] matches? ] [ parse-peak-wind ] }
{ [ dup R/ P\d{4}/ matches? ] [ parse-1hr-precipitation ] } { [ dup R[[ P\d{4}]] matches? ] [ parse-1hr-precipitation ] }
{ [ dup R/ SLP\d{3}/ matches? ] [ parse-sea-level-pressure ] } { [ dup R[[ SLP\d{3}]] matches? ] [ parse-sea-level-pressure ] }
{ [ dup R/ LTG\w+/ matches? ] [ parse-lightning ] } { [ dup R[[ LTG\w+]] matches? ] [ parse-lightning ] }
{ [ dup R/ PROB\d+/ matches? ] [ parse-probability ] } { [ dup R[[ PROB\d+]] matches? ] [ parse-probability ] }
{ [ dup R/ \d{3}V\d{3}/ matches? ] [ parse-varying ] } { [ dup R[[ \d{3}V\d{3}]] matches? ] [ parse-varying ] }
{ [ dup R/ [^-]+(-[^-]+)+/ matches? ] [ parse-from-to ] } { [ dup R[[ [^-]+(-[^-]+)+]] matches? ] [ parse-from-to ] }
{ [ dup R/ [^\\/]+(\\/[^\\/]+)+/ matches? ] [ ] } { [ dup R[[ [^\\/]+(\\/[^\\/]+)+]] matches? ] [ ] }
{ [ dup R/ \d+.\d+/ matches? ] [ ] } { [ dup R[[ \d+.\d+]] matches? ] [ ] }
{ [ dup re-recent-weather matches? ] [ parse-recent-weather ] } { [ dup re-recent-weather matches? ] [ parse-recent-weather ] }
{ [ dup re-weather matches? ] [ parse-weather ] } { [ dup re-weather matches? ] [ parse-weather ] }
{ [ dup re-sky-condition matches? ] [ parse-sky-condition ] } { [ dup re-sky-condition matches? ] [ parse-sky-condition ] }
@ -596,12 +596,12 @@ M: string metar.
[ parse-altitude ] [ parse-wind ] bi* prepend [ parse-altitude ] [ parse-wind ] bi* prepend
"wind shear " prepend ; "wind shear " prepend ;
CONSTANT: re-from-timestamp R/ FM\d{6}/ CONSTANT: re-from-timestamp R[[ FM\d{6}]]
: parse-from-timestamp ( str -- str' ) : parse-from-timestamp ( str -- str' )
"FM" ?head drop parse-timestamp ; "FM" ?head drop parse-timestamp ;
CONSTANT: re-valid-timestamp R/ \d{4}\/\d{4}/ CONSTANT: re-valid-timestamp R[[ \d{4}\/\d{4}]]
: parse-valid-timestamp ( str -- str' ) : parse-valid-timestamp ( str -- str' )
"/" split1 [ "00" append parse-timestamp ] bi@ " to " glue ; "/" split1 [ "00" append parse-timestamp ] bi@ " to " glue ;

16
extra/morse/morse-tests.factor
View File

@ -15,30 +15,30 @@ IN: morse.tests
{ "abc" } [ ".- -... -.-." morse> ] unit-test { "abc" } [ ".- -... -.-." morse> ] unit-test
{ "morse code" } [ { "morse code" } [
[MORSE MORSE[[
-- --- .-. ... . / -- --- .-. ... . /
-.-. --- -.. . -.-. --- -.. .
MORSE] >morse morse> ] unit-test ]] >morse morse> ] unit-test
{ "morse code 123" } [ { "morse code 123" } [
[MORSE MORSE[[
__ ___ ._. ... . / __ ___ ._. ... . /
_._. ___ _.. . / _._. ___ _.. . /
.____ ..___ ...__ .____ ..___ ...__
MORSE] ] unit-test ]] ] unit-test
{ [MORSE { MORSE[[
-- --- .-. ... . / -- --- .-. ... . /
-.-. --- -.. . -.-. --- -.. .
MORSE] } [ ]] } [
"morse code" >morse morse> "morse code" >morse morse>
] unit-test ] unit-test
{ "factor rocks!" } [ { "factor rocks!" } [
[MORSE MORSE[[
..-. .- -.-. - --- .-. / ..-. .- -.-. - --- .-. /
.-. --- -.-. -.- ... -.-.-- .-. --- -.-. -.- ... -.-.--
MORSE] ] unit-test ]] ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test ! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
! [ ] [ "Factor rocks!" play-as-morse ] unit-test ! [ ] [ "Factor rocks!" play-as-morse ] unit-test
! [ ] [ "\n" play-as-morse ] unit-test ! [ ] [ "\n" play-as-morse ] unit-test

2
extra/morse/morse.factor
View File

@ -112,7 +112,7 @@ PRIVATE>
: morse> ( morse -- plain ) : morse> ( morse -- plain )
replace-underscores morse>sentence ; replace-underscores morse>sentence ;
SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> suffix! ; SYNTAX: \MORSE[[ "]]" parse-multiline-string morse> suffix! ;
<PRIVATE <PRIVATE