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

factor: fixing [[ ]] and some unit tests

modern-harvey2
Doug Coleman 2018-08-02 18:29:04 -04:00
parent 343674189c
commit 0a77f6c679
17 changed files with 127 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/peg/ebnf/ebnf.factor
View File

@ -549,11 +549,11 @@ SYNTAX: \EBNF:
ebnf>quot nip ebnf>quot nip
suffix! \ call suffix! reset-tokenizer ; suffix! \ call suffix! reset-tokenizer ;
SYNTAX: \EBNF[[ "]]" parse-multiline-string define-inline-ebnf ; SYNTAX: \EBNF[[ "]]" parse-multiline-string0 define-inline-ebnf ;
SYNTAX: \EBNF[=[ "]=]" parse-multiline-string define-inline-ebnf ; SYNTAX: \EBNF[=[ "]=]" parse-multiline-string0 define-inline-ebnf ;
SYNTAX: \EBNF[==[ "]==]" parse-multiline-string define-inline-ebnf ; SYNTAX: \EBNF[==[ "]==]" parse-multiline-string0 define-inline-ebnf ;
SYNTAX: \EBNF[===[ "]===]" parse-multiline-string define-inline-ebnf ; SYNTAX: \EBNF[===[ "]===]" parse-multiline-string0 define-inline-ebnf ;
SYNTAX: \EBNF[====[ "]====]" parse-multiline-string define-inline-ebnf ; SYNTAX: \EBNF[====[ "]====]" parse-multiline-string0 define-inline-ebnf ;
SYNTAX: \EBNF-PARSER: SYNTAX: \EBNF-PARSER:
reset-tokenizer reset-tokenizer

2
basis/regexp/regexp.factor
View File

@ -218,7 +218,7 @@ PRIVATE>
PRIVATE> PRIVATE>
: parse-optioned-regexp ( accum string -- accum ) : parse-optioned-regexp ( accum string -- accum )
parse-multiline-string lexer get parse-multiline-string0 lexer get
parse-noblank-token <optioned-regexp> compile-next-match parse-noblank-token <optioned-regexp> compile-next-match
suffix! ; suffix! ;

8
basis/urls/urls.factor
View File

@ -191,4 +191,12 @@ PRIVATE>
! Literal syntax ! Literal syntax
SYNTAX: \url" parse-string >url suffix! ; SYNTAX: \url" parse-string >url suffix! ;
: parse-url-container ( accum string -- accum )
parse-multiline-string0 >url suffix! ;
SYNTAX: \url[[ "]]" parse-url-container ;
SYNTAX: \url[=[ "]=]" parse-url-container ;
SYNTAX: \url[==[ "]==]" parse-url-container ;
SYNTAX: \url[===[ "]===]" parse-url-container ;
{ "urls" "prettyprint" } "urls.prettyprint" require-when { "urls" "prettyprint" } "urls.prettyprint" require-when

22
core/classes/tuple/tuple-tests.factor
View File

@ -112,10 +112,10 @@ TUPLE: yo-momma ;
! Test forget ! Test forget
[ [
[ t ] [ \ yo-momma class? ] unit-test { t } [ \ yo-momma class? ] unit-test
[ ] [ \ yo-momma forget ] unit-test { } [ \ yo-momma forget ] unit-test
[ ] [ \ <yo-momma> forget ] unit-test { } [ \ <yo-momma> forget ] unit-test
[ f ] [ \ yo-momma update-map get values member-eq? ] unit-test { f } [ \ yo-momma update-map get values member-eq? ] unit-test
] with-compilation-unit ] with-compilation-unit
TUPLE: loc-recording ; TUPLE: loc-recording ;
@ -133,9 +133,9 @@ M: forget-robustness forget-robustness-generic ;
M: integer forget-robustness-generic ; M: integer forget-robustness-generic ;
[ [
[ ] [ M\\ forget-robustness-generic forget ] unit-test { } [ \ forget-robustness-generic forget ] unit-test
[ ] [ M\\ forget-robustness forget ] unit-test { } [ \ forget-robustness forget ] unit-test
[ ] [ M\\ forget-robustness forget-robustness-generic forget ] unit-test { } [ M\\ forget-robustness forget-robustness-generic forget ] unit-test
] with-compilation-unit ] with-compilation-unit
! rapido found this one ! rapido found this one
@ -223,10 +223,10 @@ C: <laptop> laptop
{ t } [ "laptop" get tuple? ] unit-test { t } [ "laptop" get tuple? ] unit-test
: test-laptop-slot-values ( -- ) : test-laptop-slot-values ( -- )
[ laptop ] [ "laptop" get class-of ] unit-test { laptop } [ "laptop" get class-of ] unit-test
[ "Pentium" ] [ "laptop" get cpu>> ] unit-test { "Pentium" } [ "laptop" get cpu>> ] unit-test
[ 128 ] [ "laptop" get ram>> ] unit-test { 128 } [ "laptop" get ram>> ] unit-test
[ t ] [ "laptop" get battery>> 3 hours = ] unit-test ; { t } [ "laptop" get battery>> 3 hours = ] unit-test ;
test-laptop-slot-values test-laptop-slot-values

2
core/delegate/delegate-tests.factor
View File

@ -39,7 +39,7 @@ M: hello bing hello-test ;
{ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } } [ baz protocol-consult ] unit-test { H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } } [ baz protocol-consult ] unit-test
{ H{ } } [ bee protocol-consult ] unit-test { H{ } } [ bee protocol-consult ] unit-test
{ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test { "IN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test
GENERIC: one ( a -- b ) GENERIC: one ( a -- b )
M: integer one ; M: integer one ;

16
core/generic/standard/standard-tests.factor
View File

@ -3,9 +3,11 @@ byte-arrays classes.tuple classes.union compiler.crossref
compiler.units definitions eval generic generic.single compiler.units definitions eval generic generic.single
generic.standard io.streams.string kernel make math generic.standard io.streams.string kernel make math
math.constants math.functions namespaces parser quotations math.constants math.functions namespaces parser quotations
sequences specialized-vectors strings tools.test words ; sequences specialized-arrays specialized-vectors strings
tools.test words ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
SPECIALIZED-VECTOR: c:double SPECIALIZED-VECTOR: c:double
SPECIALIZED-ARRAY: c:double
IN: generic.standard.tests IN: generic.standard.tests
GENERIC: class-of ( x -- y ) GENERIC: class-of ( x -- y )
@ -398,7 +400,7 @@ GENERIC: forget-test ( a -- b )
M: integer forget-test 3 + ; M: integer forget-test 3 + ;
{ } [ "IN: generic.standard.tests USE: math FORGET: M\\ integer forget-test" eval( -- ) ] unit-test { } [ "IN: generic.standard.tests USE: math FORGET: M\\\\ integer forget-test" eval( -- ) ] unit-test
{ { } } [ { { } } [
\ + all-dependencies-of keys [ method? ] filter \ + all-dependencies-of keys [ method? ] filter
@ -427,12 +429,12 @@ M: integer foozul ;
M: slice foozul ; M: slice foozul ;
{ } [ reversed \ foozul method-for-class M\\ reversed foozul assert= ] unit-test { } [ reversed \ foozul method-for-class M\\ reversed foozul assert= ] unit-test
{ } [ { 1 2 3 } <reversed> \ foozul method-for-object M\ reversed foozul assert= ] unit-test { } [ { 1 2 3 } <reversed> \ foozul method-for-object M\\ reversed foozul assert= ] unit-test
{ } [ { 1 2 3 } <reversed> \ foozul effective-method M\ reversed foozul assert= drop ] unit-test { } [ { 1 2 3 } <reversed> \ foozul effective-method M\\ reversed foozul assert= drop ] unit-test
{ } [ fixnum \ foozul method-for-class M\ integer foozul assert= ] unit-test { } [ fixnum \ foozul method-for-class M\\ integer foozul assert= ] unit-test
{ } [ 13 \ foozul method-for-object M\ integer foozul assert= ] unit-test { } [ 13 \ foozul method-for-object M\\ integer foozul assert= ] unit-test
{ } [ 13 \ foozul effective-method M\ integer foozul assert= drop ] unit-test { } [ 13 \ foozul effective-method M\\ integer foozul assert= drop ] unit-test
! Ensure dynamic and static dispatch match in ambiguous cases ! Ensure dynamic and static dispatch match in ambiguous cases
UNION: amb-union-1a integer float ; UNION: amb-union-1a integer float ;

2
core/locals/locals-tests.factor
View File

@ -194,7 +194,7 @@ CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals
new-definition = new-definition =
] unit-test ] unit-test
CONSTANT: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" CONSTANT: method-definition "USING: locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n"
GENERIC: method-with-locals ( x -- y ) GENERIC: method-with-locals ( x -- y )

2
core/macros/macros-tests.factor
View File

@ -7,7 +7,7 @@ MACRO: see-test ( a b -- quot ) + ;
{ t } [ \ see-test macro? ] unit-test { t } [ \ see-test macro? ] unit-test
{ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" } { "USING: math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" }
[ [ \ see-test see ] with-string-writer ] [ [ \ see-test see ] with-string-writer ]
unit-test unit-test

2
core/memoize/memoize-tests.factor
View File

@ -22,7 +22,7 @@ MEMO: x ( a b c d e -- f g h i j )
MEMO: see-test ( a -- b ) reverse ; MEMO: see-test ( a -- b ) reverse ;
{ "USING: memoize sequences ;\nIN: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" } { "USING: sequences ;\nIN: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" }
[ [ \ see-test see ] with-string-writer ] [ [ \ see-test see ] with-string-writer ]
unit-test unit-test

2
core/multiline/multiline-tests.factor
View File

@ -1,7 +1,7 @@
USING: eval multiline sequences tools.test ; USING: eval multiline sequences tools.test ;
IN: multiline.tests IN: multiline.tests
CONSTANT: test-it [[ foo CONSTANT: test-it [[foo
bar bar
]] ]]

31
core/multiline/multiline.factor
View File

@ -29,18 +29,21 @@ PRIVATE>
: parse-multiline-string ( end-text -- str ) : parse-multiline-string ( end-text -- str )
lexer get 1 (parse-multiline-string) ; lexer get 1 (parse-multiline-string) ;
! SYNTAX: \[[ "]]" parse-multiline-string suffix! ; : parse-multiline-string0 ( end-text -- str )
! SYNTAX: \[=[ "]=]" parse-multiline-string suffix! ; lexer get 0 (parse-multiline-string) ;
! SYNTAX: \[==[ "]==]" parse-multiline-string suffix! ;
! SYNTAX: \[===[ "]===]" parse-multiline-string suffix! ;
! SYNTAX: \[====[ "]====]" parse-multiline-string suffix! ;
! SYNTAX: \[=====[ "]=====]" parse-multiline-string suffix! ;
! SYNTAX: \[======[ "]======]" parse-multiline-string suffix! ;
! SYNTAX: \![[ "]]" parse-multiline-string drop ; ! SYNTAX: \[[ "]]" parse-multiline-string0 suffix! ;
! SYNTAX: \![=[ "]=]" parse-multiline-string drop ; ! SYNTAX: \[=[ "]=]" parse-multiline-string0 suffix! ;
! SYNTAX: \![==[ "]==]" parse-multiline-string drop ; ! SYNTAX: \[==[ "]==]" parse-multiline-string0 suffix! ;
! SYNTAX: \![===[ "]===]" parse-multiline-string drop ; ! SYNTAX: \[===[ "]===]" parse-multiline-string0 suffix! ;
! SYNTAX: \![====[ "]====]" parse-multiline-string drop ; ! SYNTAX: \[====[ "]====]" parse-multiline-string0 suffix! ;
! SYNTAX: \![=====[ "]=====]" parse-multiline-string drop ; ! SYNTAX: \[=====[ "]=====]" parse-multiline-string0 suffix! ;
! SYNTAX: \![======[ "]======]" parse-multiline-string drop ; ! SYNTAX: \[======[ "]======]" parse-multiline-string0 suffix! ;
! SYNTAX: \![[ "]]" parse-multiline-string0 drop ;
! SYNTAX: \![=[ "]=]" parse-multiline-string0 drop ;
! SYNTAX: \![==[ "]==]" parse-multiline-string0 drop ;
! SYNTAX: \![===[ "]===]" parse-multiline-string0 drop ;
! SYNTAX: \![====[ "]====]" parse-multiline-string0 drop ;
! SYNTAX: \![=====[ "]=====]" parse-multiline-string0 drop ;
! SYNTAX: \![======[ "]======]" parse-multiline-string0 drop ;

6
core/parser/parser-tests.factor
View File

@ -625,9 +625,9 @@ EXCLUDE: qualified.tests.bar => x ;
[ [
[ "vocabs.loader.test.l" use-vocab ] must-fail [ "vocabs.loader.test.l" use-vocab ] must-fail
[ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test { f } [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test
[ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test { } [ "vocabs.loader.test.l" unuse-vocab ] unit-test
[ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test { f } [ "vocabs.loader.test.l" manifest get search-vocab-names>> in? ] unit-test
] with-file-vocabs ] with-file-vocabs
! Test cases for #183 ! Test cases for #183

28
core/syntax/syntax.factor
View File

@ -374,21 +374,21 @@ IN: bootstrap.syntax
{ "_" "@" } define-fry-specifiers { "_" "@" } define-fry-specifiers
"[[" [ "]]" parse-multiline-string suffix! ] define-core-syntax "[[" [ "]]" parse-multiline-string0 suffix! ] define-core-syntax
"[=[" [ "]=]" parse-multiline-string suffix! ] define-core-syntax "[=[" [ "]=]" parse-multiline-string0 suffix! ] define-core-syntax
"[==[" [ "]==]" parse-multiline-string suffix! ] define-core-syntax "[==[" [ "]==]" parse-multiline-string0 suffix! ] define-core-syntax
"[===[" [ "]===]" parse-multiline-string suffix! ] define-core-syntax "[===[" [ "]===]" parse-multiline-string0 suffix! ] define-core-syntax
"[====[" [ "]====]" parse-multiline-string suffix! ] define-core-syntax "[====[" [ "]====]" parse-multiline-string0 suffix! ] define-core-syntax
"[=====[" [ "]=====]" parse-multiline-string suffix! ] define-core-syntax "[=====[" [ "]=====]" parse-multiline-string0 suffix! ] define-core-syntax
"[======[" [ "]======]" parse-multiline-string suffix! ] define-core-syntax "[======[" [ "]======]" parse-multiline-string0 suffix! ] define-core-syntax
"![[" [ "]]" parse-multiline-string drop ] define-core-syntax "![[" [ "]]" parse-multiline-string0 drop ] define-core-syntax
"![=[" [ "]=]" parse-multiline-string drop ] define-core-syntax "![=[" [ "]=]" parse-multiline-string0 drop ] define-core-syntax
"![==[" [ "]==]" parse-multiline-string drop ] define-core-syntax "![==[" [ "]==]" parse-multiline-string0 drop ] define-core-syntax
"![===[" [ "]===]" parse-multiline-string drop ] define-core-syntax "![===[" [ "]===]" parse-multiline-string0 drop ] define-core-syntax
"![====[" [ "]====]" parse-multiline-string drop ] define-core-syntax "![====[" [ "]====]" parse-multiline-string0 drop ] define-core-syntax
"![=====[" [ "]=====]" parse-multiline-string drop ] define-core-syntax "![=====[" [ "]=====]" parse-multiline-string0 drop ] define-core-syntax
"![======[" [ "]======]" parse-multiline-string drop ] define-core-syntax "![======[" [ "]======]" parse-multiline-string0 drop ] define-core-syntax
"I[[" [ "]]" define-interpolate-syntax ] define-core-syntax "I[[" [ "]]" define-interpolate-syntax ] define-core-syntax
"I[=[" [ "]=]" define-interpolate-syntax ] define-core-syntax "I[=[" [ "]=]" define-interpolate-syntax ] define-core-syntax

6
core/vocabs/vocabs-tests.factor
View File

@ -9,21 +9,21 @@ USING: tools.test vocabs ;
[ "foo/bar" create-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo/bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo\\bar" create-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo\\bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo:bar" create-vocab ] [ bad-vocab-name? ] must-fail-with ! [ "foo:bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
[ 3 create-vocab ] [ bad-vocab-name? ] must-fail-with [ 3 create-vocab ] [ bad-vocab-name? ] must-fail-with
[ f create-vocab ] [ bad-vocab-name? ] must-fail-with [ f create-vocab ] [ bad-vocab-name? ] must-fail-with
[ "a b" create-vocab ] [ bad-vocab-name? ] must-fail-with [ "a b" create-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo/bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo/bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo\\bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo\\bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo:bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with ! [ "foo:bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ 3 lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ 3 lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ f lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ f lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "a b" lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "a b" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo/bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo/bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo\\bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "foo\\bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo:bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with ! [ "foo:bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ 3 >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ 3 >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ f >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ f >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
[ "a b" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with [ "a b" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with

68
extra/metar/metar.factor
View File

@ -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 ;

26
extra/yaml/conversion/conversion.factor
View File

@ -15,16 +15,16 @@ CONSTANT: YAML_VALUE_TAG "tag:yaml.org,2002:value"
! http://www.yaml.org/spec/1.2/spec.html ! http://www.yaml.org/spec/1.2/spec.html
! 10.3. Core Schema ! 10.3. Core Schema
CONSTANT: re-null R[[ null|Null|NULL|~]] CONSTANT: re-null R[[null|Null|NULL|~]]
CONSTANT: re-empty R[[ ]] CONSTANT: re-empty R[[]]
CONSTANT: re-bool R[[ true|True|TRUE|false|False|FALSE]] CONSTANT: re-bool R[[true|True|TRUE|false|False|FALSE]]
CONSTANT: re-int10 R[[ [-+]?[0-9]+]] CONSTANT: re-int10 R[[[-+]?[0-9]+]]
CONSTANT: re-int8 R[[ 0o[0-7]+]] CONSTANT: re-int8 R[[0o[0-7]+]]
CONSTANT: re-int16 R[[ 0x[0-9a-fA-F]+]] CONSTANT: re-int16 R[[0x[0-9a-fA-F]+]]
CONSTANT: re-number R[[ [-+]?(\.[0-9]+|[0-9]+(\.[0-9]*)?)([eE][-+]?[0-9]+)?]] CONSTANT: re-number R[[[-+]?(\.[0-9]+|[0-9]+(\.[0-9]*)?)([eE][-+]?[0-9]+)?]]
CONSTANT: re-infinity R[[ [-+]?\.(inf|Inf|INF)]] CONSTANT: re-infinity R[[[-+]?\.(inf|Inf|INF)]]
CONSTANT: re-nan R[[ \.(nan|NaN|NAN)]] CONSTANT: re-nan R[[\.(nan|NaN|NAN)]]
CONSTANT: re-timestamp R[[ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]|[0-9][0-9][0-9][0-9]-[0-9][0-9]?-[0-9][0-9]?([Tt]|[ \t]+)[0-9][0-9]?:[0-9][0-9]:[0-9][0-9](\.[0-9]*)?([ \t]*(Z|[-+][0-9][0-9]?(:[0-9][0-9])?))?]] CONSTANT: re-timestamp R[[[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]|[0-9][0-9][0-9][0-9]-[0-9][0-9]?-[0-9][0-9]?([Tt]|[ \t]+)[0-9][0-9]?:[0-9][0-9]:[0-9][0-9](\.[0-9]*)?([ \t]*(Z|[-+][0-9][0-9]?(:[0-9][0-9])?))?]]
: resolve-normal-plain-scalar ( str -- tag ) : resolve-normal-plain-scalar ( str -- tag )
{ {
@ -41,8 +41,8 @@ CONSTANT: re-timestamp R[[ [0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]|[0-9][0-9]
[ drop YAML_STR_TAG ] [ drop YAML_STR_TAG ]
} cond-case ; } cond-case ;
CONSTANT: re-merge R[[ <<]] CONSTANT: re-merge R[[<<]]
CONSTANT: re-value R[[ =]] CONSTANT: re-value R[[=]]
: (resolve-mapping-key-plain-scalar) ( str -- tag ) : (resolve-mapping-key-plain-scalar) ( str -- tag )
{ {
{ [ re-merge matches? ] [ YAML_MERGE_TAG ] } { [ re-merge matches? ] [ YAML_MERGE_TAG ] }
@ -87,7 +87,7 @@ CONSTANT: YAML_OMAP_TAG "tag:yaml.org,2002:omap"
CONSTANT: YAML_PAIRS_TAG "tag:yaml.org,2002:pairs" CONSTANT: YAML_PAIRS_TAG "tag:yaml.org,2002:pairs"
CONSTANT: YAML_SET_TAG "tag:yaml.org,2002:set" CONSTANT: YAML_SET_TAG "tag:yaml.org,2002:set"
: construct-bool ( str -- ? ) R[[ true|True|TRUE]] matches? ; : construct-bool ( str -- ? ) R[[true|True|TRUE]] matches? ;
: construct-int ( str -- n ) string>number ; : construct-int ( str -- n ) string>number ;

7
extra/yaml/ffi/ffi.factor
View File

@ -2,9 +2,10 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! adapted from "yaml.h" libYAML 0.1.4 ! adapted from "yaml.h" libYAML 0.1.4
! http://pyyaml.org/wiki/LibYAML ! http://pyyaml.org/wiki/LibYAML
USING: alien alien.c-types alien.destructors alien.libraries USING: accessors alien alien.c-types alien.destructors
alien.syntax classes.struct combinators literals system alien.libraries alien.libraries.finder alien.syntax
alien.libraries.finder ; classes.struct destructors effects generalizations kernel
literals sequences ;
IN: yaml.ffi IN: yaml.ffi
<< <<