combinators.short-circuit definitions effects eval fry grouping
help help.markup help.topics io.streams.string kernel macros
namespaces sequences sequences.deep sets sorting splitting
-strings unicode.categories values vocabs vocabs.loader words
+strings unicode.categories vocabs vocabs.loader words
words.symbol summary debugger io ;
FROM: sets => members ;
IN: help.lint.checks
{
[ macro? ]
[ symbol? ]
- [ value-word? ]
[ parsing-word? ]
[ "declared-effect" word-prop not ]
} 1|| ;
! See http://factorcode.org/license.txt for BSD license.
USING: xml xml.data kernel io io.encodings interval-maps splitting fry
math.parser sequences combinators assocs locals accessors math arrays
-byte-arrays values ascii io.files biassocs math.order
+byte-arrays ascii io.files biassocs math.order namespaces
combinators.short-circuit io.binary io.encodings.iana ;
FROM: io.encodings.ascii => ascii ;
IN: io.encodings.gb18030
: ranges-gb>u ( ranges -- interval-map )
[ bfirst>> ] [ blast>> ] [ ] >interval-map-by ;
-VALUE: gb>u
-VALUE: u>gb
-VALUE: mapping
+SYMBOL: gb>u
+SYMBOL: u>gb
+SYMBOL: mapping
"vocab:io/encodings/gb18030/gb-18030-2000.xml"
ascii <file-reader> xml>gb-data
-[ ranges-u>gb \ u>gb set-value ] [ ranges-gb>u \ gb>u set-value ] bi
->biassoc \ mapping set-value
+[ ranges-u>gb u>gb set-global ] [ ranges-gb>u gb>u set-global ] bi
+>biassoc mapping set-global
: lookup-range ( char -- byte-array )
- dup u>gb interval-at [
+ dup u>gb get-global interval-at [
[ ufirst>> - ] [ bfirst>> ] bi + unlinear
] [ encode-error ] if* ;
M: gb18030 encode-char ( char stream encoding -- )
drop [
- dup mapping at
+ dup mapping get-global at
[ ] [ lookup-range ] ?if
] dip stream-write ;
{ [ length 2 = ] [ first quad-1/3? ] [ second quad-2/4? ] } 1&& ;
: decode-quad ( byte-array -- char )
- dup mapping value-at [ ] [
- linear dup gb>u interval-at [
+ dup mapping get-global value-at [ ] [
+ linear dup gb>u get-global interval-at [
[ bfirst>> - ] [ ufirst>> ] bi +
] [ drop replacement-char ] if*
] ?if ;
: two-byte ( stream byte -- char )
over stream-read1 {
{ [ dup not ] [ 3drop replacement-char ] }
- { [ dup second-byte? ] [ 2byte-array mapping value-at nip ] }
+ { [ dup second-byte? ] [ 2byte-array mapping get-global value-at nip ] }
{ [ dup quad-2/4? ] [ four-byte ] }
[ 3drop replacement-char ]
} cond ;
M: gb18030 decode-char ( stream encoding -- char )
drop dup stream-read1 {
{ [ dup not ] [ 2drop f ] }
- { [ dup ascii? ] [ nip 1byte-array mapping value-at ] }
+ { [ dup ascii? ] [ nip 1byte-array mapping get-global value-at ] }
{ [ dup quad-1/3? ] [ two-byte ] }
[ 2drop replacement-char ]
} cond ;
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings kernel sequences io simple-flat-file sets math
-combinators.short-circuit io.binary values arrays assocs
+combinators.short-circuit io.binary arrays assocs namespaces
locals accessors combinators biassocs byte-arrays parser ;
IN: io.encodings.iso2022
<PRIVATE
-VALUE: jis201
-VALUE: jis208
-VALUE: jis212
+SYMBOL: jis201
+SYMBOL: jis208
+SYMBOL: jis212
-"vocab:io/encodings/iso2022/201.txt" flat-file>biassoc \ jis201 set-value
-"vocab:io/encodings/iso2022/208.txt" flat-file>biassoc \ jis208 set-value
-"vocab:io/encodings/iso2022/212.txt" flat-file>biassoc \ jis212 set-value
+"vocab:io/encodings/iso2022/201.txt" flat-file>biassoc jis201 set-global
+"vocab:io/encodings/iso2022/208.txt" flat-file>biassoc jis208 set-global
+"vocab:io/encodings/iso2022/212.txt" flat-file>biassoc jis212 set-global
-VALUE: ascii
-128 iota unique >biassoc \ ascii set-value
+SYMBOL: ascii
+128 iota unique >biassoc ascii set-global
TUPLE: iso2022-state type ;
: make-iso-coder ( encoding -- state )
- drop ascii iso2022-state boa ;
+ drop ascii get-global iso2022-state boa ;
M: iso2022 <encoder>
make-iso-coder <encoder> ;
: find-type ( char -- code type )
{
- { [ dup ascii value? ] [ drop switch-ascii ascii ] }
- { [ dup jis201 value? ] [ drop switch-jis201 jis201 ] }
- { [ dup jis208 value? ] [ drop switch-jis208 jis208 ] }
- { [ dup jis212 value? ] [ drop switch-jis212 jis212 ] }
+ { [ dup ascii get-global value? ] [ drop switch-ascii ascii get-global ] }
+ { [ dup jis201 get-global value? ] [ drop switch-jis201 jis201 get-global ] }
+ { [ dup jis208 get-global value? ] [ drop switch-jis208 jis208 get-global ] }
+ { [ dup jis212 get-global value? ] [ drop switch-jis212 jis212 get-global ] }
[ encode-error ]
} cond ;
dup stream-read1 {
{ CHAR: ( [
stream-read1 {
- { CHAR: B [ ascii ] }
- { CHAR: J [ jis201 ] }
+ { CHAR: B [ ascii get-global ] }
+ { CHAR: J [ jis201 get-global ] }
[ drop f ]
} case
] }
{ CHAR: $ [
dup stream-read1 {
- { CHAR: @ [ drop jis208 ] } ! want: JIS X 0208-1978
- { CHAR: B [ drop jis208 ] }
+ { CHAR: @ [ drop jis208 get-global ] } ! want: JIS X 0208-1978
+ { CHAR: B [ drop jis208 get-global ] }
{ CHAR: ( [
- stream-read1 CHAR: D = jis212 f ?
+ stream-read1 CHAR: D = jis212 get-global f ?
] }
[ 2drop f ]
} case
} case ;
: double-width? ( type -- ? )
- { [ jis208 eq? ] [ jis212 eq? ] } 1|| ;
+ { [ jis208 get-global eq? ] [ jis212 get-global eq? ] } 1|| ;
: finish-decode ( num encoding -- char )
type>> at replacement-char or ;
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel io io.files combinators.short-circuit
-math.order values assocs io.encodings io.binary fry strings math
+math.order assocs io.encodings io.binary fry strings math
io.encodings.ascii arrays byte-arrays accessors splitting
-math.parser biassocs io.encodings.iana
+math.parser biassocs io.encodings.iana namespaces
locals multiline combinators simple-flat-file ;
IN: io.encodings.shift-jis
<PRIVATE
-VALUE: shift-jis-table
+SYMBOL: shift-jis-table
-M: shift-jis <encoder> drop shift-jis-table <encoder> ;
-M: shift-jis <decoder> drop shift-jis-table <decoder> ;
+M: shift-jis <encoder> drop shift-jis-table get-global <encoder> ;
+M: shift-jis <decoder> drop shift-jis-table get-global <decoder> ;
-VALUE: windows-31j-table
+SYMBOL: windows-31j-table
-M: windows-31j <encoder> drop windows-31j-table <encoder> ;
-M: windows-31j <decoder> drop windows-31j-table <decoder> ;
+M: windows-31j <encoder> drop windows-31j-table get-global <encoder> ;
+M: windows-31j <decoder> drop windows-31j-table get-global <decoder> ;
TUPLE: jis assoc ;
flat-file>biassoc [ nip ] assoc-filter jis boa ;
"vocab:io/encodings/shift-jis/CP932.txt"
-make-jis \ windows-31j-table set-value
+make-jis windows-31j-table set-global
"vocab:io/encodings/shift-jis/sjis-0208-1997-std.txt"
-make-jis \ shift-jis-table set-value
+make-jis shift-jis-table set-global
: small? ( char -- ? )
! ASCII range or single-byte halfwidth katakana
USING: accessors assocs fry io kernel math prettyprint
quotations sequences sequences.deep splitting strings
tools.annotations vocabs words arrays words.symbol
-combinators.short-circuit values tools.test
+combinators.short-circuit namespaces tools.test
combinators continuations classes ;
IN: tools.coverage
C: <coverage> coverage
-VALUE: covered
+SYMBOL: covered
: flag-covered ( coverage -- )
- covered [ t >>executed? ] when drop ;
+ covered get-global [ t >>executed? ] when drop ;
-: coverage-on ( -- ) t \ covered set-value ;
+: coverage-on ( -- ) t covered set-global ;
-: coverage-off ( -- ) f \ covered set-value ;
+: coverage-off ( -- ) f covered set-global ;
GENERIC: add-coverage ( object -- )
IN: tools.deploy.test.6
-USING: values math kernel ;
+USING: namespaces math kernel ;
-VALUE: x
+SYMBOL: x
-VALUE: y
+SYMBOL: y
: deploy-test-6 ( -- )
- 1 \ x set-value
- 2 \ y set-value
- x y + 3 assert= ;
+ 1 x set-global
+ 2 y set-global
+ x get-global y get-global + 3 assert= ;
MAIN: deploy-test-6
math.parser math.ranges memoize namespaces sequences
sets simple-flat-file splitting unicode.categories
unicode.categories.syntax unicode.data unicode.normalize
-unicode.normalize.private values words ;
+unicode.normalize.private words ;
FROM: sequences => change-nth ;
IN: unicode.breaks
graphemes iota { SpacingMark } connect
{ Prepend } graphemes iota connect ;
-VALUE: grapheme-table
+SYMBOL: grapheme-table
: grapheme-break? ( class1 class2 -- ? )
- grapheme-table nth nth not ;
+ grapheme-table get-global nth nth not ;
PRIVATE>
graphemes init-table table
[ make-grapheme-table finish-table ] with-variable
-\ grapheme-table set-value
+grapheme-table set-global
! Word breaks
-VALUE: word-break-table
+SYMBOL: word-break-table
"vocab:unicode/data/WordBreakProperty.txt" load-interval-file
-\ word-break-table set-value
+word-break-table set-global
CONSTANT: wOther 0
CONSTANT: wCR 1
} ;
: word-break-prop ( char -- word-break-prop )
- word-break-table interval-at
+ word-break-table get-global interval-at
word-break-classes at [ wOther ] unless* ;
SYMBOL: check-letter-before
{ wALetter wNumeric wKatakana wExtendNumLet } { wExtendNumLet }
[ connect ] [ swap connect ] 2bi ;
-VALUE: word-table
+SYMBOL: word-table
: finish-word-table ( -- table )
table get [
words init-table table
[ make-word-table finish-word-table ] with-variable
-\ word-table set-value
+word-table set-global
: word-table-nth ( class1 class2 -- ? )
- word-table nth nth ;
+ word-table get-global nth nth ;
:: property-not= ( str i property -- ? )
i [
! Copyright (C) 2008 Daniel Ehrenberg.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: sequences io.files io.encodings.ascii kernel values splitting\r
+USING: sequences io.files io.encodings.ascii kernel splitting\r
accessors math.parser ascii io assocs strings math namespaces make\r
sorting combinators math.order arrays unicode.normalize unicode.data\r
locals macros sequences.deep words unicode.breaks quotations\r
IN: unicode.collation\r
\r
<PRIVATE\r
-VALUE: ducet\r
+SYMBOL: ducet\r
\r
TUPLE: weight primary secondary tertiary ignorable? ;\r
\r
: parse-ducet ( file -- ducet )\r
data [ [ parse-keys ] [ parse-weight ] bi* ] H{ } assoc-map-as ;\r
\r
-"vocab:unicode/collation/allkeys.txt" parse-ducet \ ducet set-value\r
+"vocab:unicode/collation/allkeys.txt" parse-ducet ducet set-global\r
\r
! Fix up table for long contractions\r
: help-one ( assoc key -- )\r
dup keys [ length 3 >= ] filter\r
[ help-one ] with each ;\r
\r
-ducet insert-helpers\r
+ducet get-global insert-helpers\r
\r
: base ( char -- base )\r
{\r
\r
:: ?combine ( char slice i -- ? )\r
i slice nth char suffix :> str\r
- str ducet key? dup\r
+ str ducet get-global key? dup\r
[ str i slice set-nth ] when ;\r
\r
: add ( char -- )\r
: graphemes>weights ( graphemes -- weights )\r
[\r
dup weight? [ 1array ] ! From tailoring\r
- [ dup ducet at [ ] [ derive-weight ] ?if ] if\r
+ [ dup ducet get-global at [ ] [ derive-weight ] ?if ] if\r
] { } map-as concat ;\r
\r
: append-weights ( weights quot -- )\r
USING: combinators.short-circuit assocs math kernel sequences
io.files hashtables quotations splitting grouping arrays io
math.parser math.order byte-arrays namespaces math.bitwise
-compiler.units parser io.encodings.ascii values interval-maps
+compiler.units parser io.encodings.ascii interval-maps
ascii sets combinators locals math.ranges sorting make
strings.parser io.encodings.utf8 memoize simple-flat-file ;
FROM: namespaces => set ;
<PRIVATE
-VALUE: simple-lower
-VALUE: simple-upper
-VALUE: simple-title
-VALUE: canonical-map
-VALUE: combine-map
-VALUE: class-map
-VALUE: compatibility-map
-VALUE: category-map
-VALUE: special-casing
-VALUE: properties
+SYMBOL: simple-lower
+SYMBOL: simple-upper
+SYMBOL: simple-title
+SYMBOL: canonical-map
+SYMBOL: combine-map
+SYMBOL: class-map
+SYMBOL: compatibility-map
+SYMBOL: category-map
+SYMBOL: special-casing
+SYMBOL: properties
: >2ch ( a b -- c ) [ 21 shift ] dip + ;
: 2ch> ( c -- a b ) [ -21 shift ] [ 21 on-bits mask ] bi ;
PRIVATE>
-VALUE: name-map
+SYMBOL: name-map
-: canonical-entry ( char -- seq ) canonical-map at ; inline
-: combine-chars ( a b -- char/f ) >2ch combine-map at ; inline
-: compatibility-entry ( char -- seq ) compatibility-map at ; inline
-: combining-class ( char -- n ) class-map at ; inline
+: canonical-entry ( char -- seq ) canonical-map get-global at ; inline
+: combine-chars ( a b -- char/f ) >2ch combine-map get-global at ; inline
+: compatibility-entry ( char -- seq ) compatibility-map get-global at ; inline
+: combining-class ( char -- n ) class-map get-global at ; inline
: non-starter? ( char -- ? ) combining-class { 0 f } member? not ; inline
-: name>char ( name -- char ) name-map at ; inline
-: char>name ( char -- name ) name-map value-at ; inline
-: property? ( char property -- ? ) properties at interval-key? ; inline
-: ch>lower ( ch -- lower ) simple-lower ?at drop ; inline
-: ch>upper ( ch -- upper ) simple-upper ?at drop ; inline
-: ch>title ( ch -- title ) simple-title ?at drop ; inline
-: special-case ( ch -- casing-tuple ) special-casing at ; inline
+: name>char ( name -- char ) name-map get-global at ; inline
+: char>name ( char -- name ) name-map get-global value-at ; inline
+: property? ( char property -- ? ) properties get-global at interval-key? ; inline
+: ch>lower ( ch -- lower ) simple-lower get-global ?at drop ; inline
+: ch>upper ( ch -- upper ) simple-upper get-global ?at drop ; inline
+: ch>title ( ch -- title ) simple-title get-global ?at drop ; inline
+: special-case ( ch -- casing-tuple ) special-casing get-global at ; inline
! For non-existent characters, use Cn
CONSTANT: categories
! that this gives Cf or Mn
! Cf = 26; Mn = 5; Cn = 29
! Use a compressed array instead?
- dup category-map ?nth [ ] [
+ dup category-map get-global ?nth [ ] [
dup 0xE0001 0xE007F between?
[ drop 26 ] [
0xE0100 0xE01EF between? 5 29 ?
2dup bounds-check? [ set-nth ] [ 3drop ] if ;
:: fill-ranges ( table -- table )
- name-map sort-values keys
+ name-map get-global sort-values keys
[ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
2 group [
[ name>char ] bi@ [ [a,b] ] [ table ?nth ] bi
[ [ set-code-point ] each ] H{ } make-assoc ;
load-data {
- [ process-names \ name-map set-value ]
- [ 13 swap process-data \ simple-lower set-value ]
- [ 12 swap process-data \ simple-upper set-value ]
- [ 14 swap process-data simple-upper assoc-union \ simple-title set-value ]
- [ process-combining \ class-map set-value ]
- [ process-canonical \ canonical-map set-value \ combine-map set-value ]
- [ process-compatibility \ compatibility-map set-value ]
- [ process-category \ category-map set-value ]
+ [ process-names name-map set-global ]
+ [ 13 swap process-data simple-lower set-global ]
+ [ 12 swap process-data simple-upper set-global ]
+ [ 14 swap process-data simple-upper get-global assoc-union simple-title set-global ]
+ [ process-combining class-map set-global ]
+ [ process-canonical canonical-map set-global combine-map set-global ]
+ [ process-compatibility compatibility-map set-global ]
+ [ process-category category-map set-global ]
} cleave
: postprocess-class ( -- )
- combine-map keys [ 2ch> nip ] map
+ combine-map get-global keys [ 2ch> nip ] map
[ combining-class not ] filter
- [ 0 swap class-map set-at ] each ;
+ [ 0 swap class-map get-global set-at ] each ;
postprocess-class
-load-special-casing \ special-casing set-value
+load-special-casing special-casing set-global
-load-properties \ properties set-value
+load-properties properties set-global
[ name>char [ "Invalid character" throw ] unless* ]
name>char-hook set-global
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: values interval-maps simple-flat-file ;
+USING: interval-maps namespaces simple-flat-file ;
IN: unicode.script
<PRIVATE
-VALUE: script-table
+SYMBOL: script-table
"vocab:unicode/script/Scripts.txt" load-interval-file
-\ script-table set-value
+script-table set-global
PRIVATE>
: script-of ( char -- script )
- script-table interval-at ;
+ script-table get-global interval-at ;
+++ /dev/null
-Daniel Ehrenberg\r
+++ /dev/null
-Global variables in the Forth value style\r
+++ /dev/null
-extensions\r
+++ /dev/null
-USING: help.markup help.syntax ;\r
-IN: values\r
-\r
-ARTICLE: "values" "Global values"\r
-"Usually, dynamically-scoped variables subsume global variables and are sufficient for holding global data. But occasionally, for global information that's calculated just once and must be accessed more rapidly than a dynamic variable lookup can provide, it's useful to use the word mechanism instead, and set a word to the appropriate value just once. The " { $vocab-link "values" } " vocabulary implements " { $emphasis "values" } ", which abstract over this concept. To create a new word as a value, use the following syntax:"\r
-{ $subsections POSTPONE: VALUE: }\r
-"To get the value, just call the word. The following words manipulate values:"\r
-{ $subsections\r
- get-value\r
- set-value\r
- change-value\r
-} ;\r
-\r
-ABOUT: "values"\r
-\r
-HELP: VALUE:\r
-{ $syntax "VALUE: word" }\r
-{ $values { "word" "a word to be created" } }\r
-{ $description "Creates a value on the given word, initializing it to hold " { $snippet "f" } ". To get the value, just run the word. To set it, use " { $link set-value } "." }\r
-{ $examples\r
- { $example\r
- "USING: values math prettyprint ;"\r
- "IN: scratchpad"\r
- "VALUE: x"\r
- "2 2 + \\ x set-value"\r
- "x ."\r
- "4"\r
- }\r
-} ;\r
-\r
-HELP: get-value\r
-{ $values { "word" "a value word" } { "value" "the contents" } }\r
-{ $description "Gets a value. This should not normally be used, unless the word is not known until runtime." } ;\r
-\r
-HELP: set-value\r
-{ $values { "value" "a new value" } { "word" "a value word" } }\r
-{ $description "Sets a value word." } ;\r
-\r
-HELP: change-value\r
-{ $values { "word" "a value word" } { "quot" { $quotation "( oldvalue -- newvalue )" } } }\r
-{ $description "Changes the value using the given quotation." } ;\r
+++ /dev/null
-USING: tools.test values math ;\r
-IN: values.tests\r
-\r
-VALUE: foo\r
-[ f ] [ foo ] unit-test\r
-[ ] [ 3 \ foo set-value ] unit-test\r
-[ 3 ] [ foo ] unit-test\r
-[ ] [ \ foo [ 1 + ] change-value ] unit-test\r
-[ 4 ] [ foo ] unit-test\r
+++ /dev/null
-! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel parser words sequences quotations
-combinators.short-circuit definitions ;
-IN: values
-
-! Mutating literals in word definitions is not really allowed,
-! and the deploy tool takes advantage of this fact to perform
-! some aggressive stripping and compression. However, this
-! breaks a naive implementation of values. We need to do two
-! things:
-! 1) Store the value in a subclass of identity-tuple, so that
-! two quotations from different value words are never equal.
-! This avoids bogus merging of values.
-! 2) Set the "no-def-strip" word-prop, so that the shaker leaves
-! the def>> slot alone, allowing us to introspect it. Otherwise,
-! it will get set to [ ] and we would lose access to the
-! value-holder.
-
-<PRIVATE
-
-TUPLE: value-holder < identity-tuple obj ;
-
-PRIVATE>
-
-PREDICATE: value-word < word
- def>> {
- [ length 2 = ]
- [ first value-holder? ]
- [ second \ obj>> = ]
- } 1&& ;
-
-SYNTAX: VALUE:
- scan-new-word
- dup t "no-def-strip" set-word-prop
- T{ value-holder } clone [ obj>> ] curry
- ( -- value ) define-declared ;
-
-M: value-word definer drop \ VALUE: f ;
-
-M: value-word definition drop f ;
-
-: set-value ( value word -- )
- def>> first obj<< ;
-
-: get-value ( word -- value )
- def>> first obj>> ;
-
-: change-value ( word quot -- )
- [ [ get-value ] dip call ] [ drop ] 2bi set-value ; inline
! Copyright (C) 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs io.encodings.binary io.files kernel namespaces sequences
-values xml xml.entities accessors xml.state ;
+xml xml.entities accessors xml.state ;
IN: xml.entities.html
-VALUE: html-entities
+SYMBOL: html-entities
: read-entities-file ( file -- table )
file>dtd entities>> ;
read-entities-file
] map first3 assoc-union assoc-union ;
-get-html \ html-entities set-value
+get-html html-entities set-global
: with-html-entities ( quot -- )
- html-entities swap with-entities ; inline
+ html-entities get-global swap with-entities ; inline
projects / factor.git / commitdiff