tools.scaffold: support more types and maybe types.
parent
9f44b1c37a
commit
d89ae96c64
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: tools.test tools.scaffold unicode.case kernel
|
USING: help.markup io.streams.string kernel sequences
|
||||||
tools.scaffold.private io.streams.string ;
|
tools.scaffold tools.scaffold.private tools.test unicode.case ;
|
||||||
IN: tools.scaffold.tests
|
IN: tools.scaffold.tests
|
||||||
|
|
||||||
: undocumented-word ( obj1 obj2 -- obj3 obj4 )
|
: undocumented-word ( obj1 obj2 -- obj3 obj4 )
|
||||||
|
@ -19,3 +19,9 @@ IN: tools.scaffold.tests
|
||||||
[
|
[
|
||||||
[ \ undocumented-word (help.) ] with-string-writer
|
[ \ undocumented-word (help.) ] with-string-writer
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
{ sequence t } [ "seq" lookup-type ] unit-test
|
||||||
|
{ sequence t } [ "seq'" lookup-type ] unit-test
|
||||||
|
{ sequence t } [ "newseq" lookup-type ] unit-test
|
||||||
|
{ { $maybe sequence } t } [ "seq/f" lookup-type ] unit-test
|
||||||
|
{ f f } [ "foo" lookup-type ] unit-test
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien arrays assocs calendar classes
|
USING: accessors alien arrays assocs byte-arrays calendar
|
||||||
combinators combinators.short-circuit fry hashtables interpolate
|
classes combinators combinators.short-circuit fry hashtables
|
||||||
io io.directories io.encodings.utf8 io.files io.pathnames
|
help.markup interpolate io io.directories io.encodings.utf8
|
||||||
io.streams.string kernel math math.parser namespaces prettyprint
|
io.files io.pathnames io.streams.string kernel math math.parser
|
||||||
quotations sequences sets sorting splitting strings system
|
namespaces prettyprint quotations sequences sets sorting
|
||||||
timers unicode.categories urls vocabs vocabs.loader
|
splitting strings system timers unicode.categories urls vocabs
|
||||||
vocabs.metadata words words.symbol ;
|
vocabs.loader vocabs.metadata words words.symbol ;
|
||||||
FROM: sets => members ;
|
FROM: sets => members ;
|
||||||
IN: tools.scaffold
|
IN: tools.scaffold
|
||||||
|
|
||||||
|
@ -115,9 +115,11 @@ ERROR: vocab-name-contains-dot path ;
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
||||||
: lookup-type ( string -- object/string ? )
|
: lookup-type ( string -- object/string ? )
|
||||||
|
"/f" ?tail swap
|
||||||
"new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
|
"new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
|
||||||
H{
|
H{
|
||||||
{ "object" object } { "obj" object }
|
{ "object" object }
|
||||||
|
{ "obj" object }
|
||||||
{ "quot" quotation }
|
{ "quot" quotation }
|
||||||
{ "string" string }
|
{ "string" string }
|
||||||
{ "str" string }
|
{ "str" string }
|
||||||
|
@ -127,12 +129,14 @@ ERROR: vocab-name-contains-dot path ;
|
||||||
{ "ch" "a character" }
|
{ "ch" "a character" }
|
||||||
{ "word" word }
|
{ "word" word }
|
||||||
{ "array" array }
|
{ "array" array }
|
||||||
{ "timers" timer }
|
{ "byte-array" byte-array }
|
||||||
|
{ "timer" timer }
|
||||||
{ "duration" duration }
|
{ "duration" duration }
|
||||||
{ "path" "a pathname string" }
|
{ "path" "a pathname string" }
|
||||||
{ "vocab" "a vocabulary specifier" }
|
{ "vocab" "a vocabulary specifier" }
|
||||||
{ "vocab-root" "a vocabulary root string" }
|
{ "vocab-root" "a vocabulary root string" }
|
||||||
{ "c-ptr" c-ptr }
|
{ "c-ptr" c-ptr }
|
||||||
|
{ "sequence" sequence }
|
||||||
{ "seq" sequence }
|
{ "seq" sequence }
|
||||||
{ "exemplar" object }
|
{ "exemplar" object }
|
||||||
{ "assoc" assoc }
|
{ "assoc" assoc }
|
||||||
|
@ -140,7 +144,7 @@ ERROR: vocab-name-contains-dot path ;
|
||||||
{ "keys" sequence } { "values" sequence }
|
{ "keys" sequence } { "values" sequence }
|
||||||
{ "class" class } { "tuple" tuple }
|
{ "class" class } { "tuple" tuple }
|
||||||
{ "url" url }
|
{ "url" url }
|
||||||
} at* ;
|
} at* [ swap [ \ $maybe swap 2array ] when ] dip ;
|
||||||
|
|
||||||
: add-using ( object -- )
|
: add-using ( object -- )
|
||||||
vocabulary>> using get [ adjoin ] [ drop ] if* ;
|
vocabulary>> using get [ adjoin ] [ drop ] if* ;
|
||||||
|
|
Loading…
Reference in New Issue