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

remove values vocab

db4
Joe Groff 2011-11-28 21:26:06 -08:00
parent cde3c043bf
commit 1ef6fc03e6
17 changed files with 115 additions and 219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/help/lint/checks/checks.factor
View File

@ -4,7 +4,7 @@ USING: accessors arrays assocs classes combinators
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
@ -72,7 +72,6 @@ SYMBOL: vocab-articles
{
[ macro? ]
[ symbol? ]
[ value-word? ]
[ parsing-word? ]
[ "declared-effect" word-prop not ]
} 1|| ;

24
basis/io/encodings/gb18030/gb18030.factor
View File

@ -2,7 +2,7 @@
! 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
@ -78,23 +78,23 @@ TUPLE: range ufirst ulast bfirst blast ;
: 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 ;
@ -109,8 +109,8 @@ M: gb18030 encode-char ( char stream encoding -- )
{ [ 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 ;
@ -123,7 +123,7 @@ M: gb18030 encode-char ( char stream encoding -- )
: 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 ;
@ -131,7 +131,7 @@ M: gb18030 encode-char ( char stream encoding -- )
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 ;

40
basis/io/encodings/iso2022/iso2022.factor
View File

@ -1,7 +1,7 @@
! 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
@ -9,21 +9,21 @@ SINGLETON: 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> ;
@ -40,10 +40,10 @@ CONSTANT: switch-jis212 B{ ESC CHAR: $ CHAR: ( CHAR: D }
: 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 ;
@ -64,17 +64,17 @@ M:: iso2022-state encode-char ( char stream encoding -- )
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
@ -83,7 +83,7 @@ M:: iso2022-state encode-char ( char stream encoding -- )
} 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 ;

20
basis/io/encodings/shift-jis/shift-jis.factor
View File

@ -1,9 +1,9 @@
! 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
@ -17,15 +17,15 @@ windows-31j "Windows-31J" register-encoding
<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 ;
@ -36,10 +36,10 @@ 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

10
basis/tools/coverage/coverage.factor
View File

@ -3,7 +3,7 @@
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
@ -11,14 +11,14 @@ TUPLE: coverage < identity-tuple executed? ;
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 -- )

12
basis/tools/deploy/test/6/6.factor
View File

@ -1,13 +1,13 @@
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

20
basis/unicode/breaks/breaks.factor
View File

@ -6,7 +6,7 @@ io.encodings.ascii io.files kernel literals locals make math
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
@ -95,10 +95,10 @@ SYMBOL: table
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>
@ -134,14 +134,14 @@ 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
@ -168,7 +168,7 @@ CONSTANT: words 13
} ;
: 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
@ -189,7 +189,7 @@ SYMBOL: check-number-after
{ wALetter wNumeric wKatakana wExtendNumLet } { wExtendNumLet }
[ connect ] [ swap connect ] 2bi ;
VALUE: word-table
SYMBOL: word-table
: finish-word-table ( -- table )
table get [
@ -198,10 +198,10 @@ VALUE: word-table
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 [

12
basis/unicode/collation/collation.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences io.files io.encodings.ascii kernel values splitting
USING: sequences io.files io.encodings.ascii kernel splitting
accessors math.parser ascii io assocs strings math namespaces make
sorting combinators math.order arrays unicode.normalize unicode.data
locals macros sequences.deep words unicode.breaks quotations
@ -8,7 +8,7 @@ combinators.short-circuit simple-flat-file ;
IN: unicode.collation
<PRIVATE
VALUE: ducet
SYMBOL: ducet
TUPLE: weight primary secondary tertiary ignorable? ;
@ -25,7 +25,7 @@ TUPLE: weight primary secondary tertiary ignorable? ;
: parse-ducet ( file -- ducet )
data [ [ parse-keys ] [ parse-weight ] bi* ] H{ } assoc-map-as ;
"vocab:unicode/collation/allkeys.txt" parse-ducet \ ducet set-value
"vocab:unicode/collation/allkeys.txt" parse-ducet ducet set-global
! Fix up table for long contractions
: help-one ( assoc key -- )
@ -39,7 +39,7 @@ TUPLE: weight primary secondary tertiary ignorable? ;
dup keys [ length 3 >= ] filter
[ help-one ] with each ;
ducet insert-helpers
ducet get-global insert-helpers
: base ( char -- base )
{
@ -77,7 +77,7 @@ ducet insert-helpers
:: ?combine ( char slice i -- ? )
i slice nth char suffix :> str
str ducet key? dup
str ducet get-global key? dup
[ str i slice set-nth ] when ;
: add ( char -- )
@ -93,7 +93,7 @@ ducet insert-helpers
: graphemes>weights ( graphemes -- weights )
[
dup weight? [ 1array ] ! From tailoring
[ dup ducet at [ ] [ derive-weight ] ?if ] if
[ dup ducet get-global at [ ] [ derive-weight ] ?if ] if
] { } map-as concat ;
: append-weights ( weights quot -- )

74
basis/unicode/data/data.factor
View File

@ -3,7 +3,7 @@
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 ;
@ -11,36 +11,36 @@ IN: unicode.data
<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
@ -67,7 +67,7 @@ PRIVATE>
! 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 ?
@ -143,7 +143,7 @@ PRIVATE>
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
@ -200,26 +200,26 @@ C: <code-point> code-point
[ [ 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

8
basis/unicode/script/script.factor
View File

@ -1,16 +1,16 @@
! 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 ;

1
basis/values/authors.txt
View File

@ -1 +0,0 @@
Daniel Ehrenberg

1
basis/values/summary.txt
View File

@ -1 +0,0 @@
Global variables in the Forth value style

1
basis/values/tags.txt
View File

@ -1 +0,0 @@
extensions

41
basis/values/values-docs.factor
View File

@ -1,41 +0,0 @@
USING: help.markup help.syntax ;
IN: values
ARTICLE: "values" "Global values"
"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:"
{ $subsections POSTPONE: VALUE: }
"To get the value, just call the word. The following words manipulate values:"
{ $subsections
get-value
set-value
change-value
} ;
ABOUT: "values"
HELP: VALUE:
{ $syntax "VALUE: word" }
{ $values { "word" "a word to be created" } }
{ $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 } "." }
{ $examples
{ $example
"USING: values math prettyprint ;"
"IN: scratchpad"
"VALUE: x"
"2 2 + \\ x set-value"
"x ."
"4"
}
} ;
HELP: get-value
{ $values { "word" "a value word" } { "value" "the contents" } }
{ $description "Gets a value. This should not normally be used, unless the word is not known until runtime." } ;
HELP: set-value
{ $values { "value" "a new value" } { "word" "a value word" } }
{ $description "Sets a value word." } ;
HELP: change-value
{ $values { "word" "a value word" } { "quot" { $quotation "( oldvalue -- newvalue )" } } }
{ $description "Changes the value using the given quotation." } ;

9
basis/values/values-tests.factor
View File

@ -1,9 +0,0 @@
USING: tools.test values math ;
IN: values.tests
VALUE: foo
[ f ] [ foo ] unit-test
[ ] [ 3 \ foo set-value ] unit-test
[ 3 ] [ foo ] unit-test
[ ] [ \ foo [ 1 + ] change-value ] unit-test
[ 4 ] [ foo ] unit-test

50
basis/values/values.factor
View File

@ -1,50 +0,0 @@
! 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

8
basis/xml/entities/html/html.factor
View File

@ -1,10 +1,10 @@
! 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>> ;
@ -15,7 +15,7 @@ VALUE: html-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