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

Fix conflict

db4
Slava Pestov 2008-01-31 00:54:44 -06:00
parent 5bf2cbf4c6 cea24feaa9
commit f77526714f
11 changed files with 107 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
core/classes/classes-tests.factor
View File

@ -207,3 +207,14 @@ DEFER: mixin-forget-test-g
[ { } mixin-forget-test-g ] unit-test-fails
[ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
! Method flattening interfered with mixin update
MIXIN: flat-mx-1
TUPLE: flat-mx-1-1 ; INSTANCE: flat-mx-1-1 flat-mx-1
TUPLE: flat-mx-1-2 ; INSTANCE: flat-mx-1-2 flat-mx-1
TUPLE: flat-mx-1-3 ; INSTANCE: flat-mx-1-3 flat-mx-1
TUPLE: flat-mx-1-4 ; INSTANCE: flat-mx-1-4 flat-mx-1
MIXIN: flat-mx-2 INSTANCE: flat-mx-2 flat-mx-1
TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
[ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test

12
core/compiler/test/redefine.factor
View File

@ -238,3 +238,15 @@ DEFER: flushable-test-2
[ \ bx forget ] with-compilation-unit
[ t ] [ \ ax compiled-usage [ drop interned? ] assoc-all? ] unit-test
DEFER: defer-redefine-test-2
[ ] [ "IN: temporary DEFER: defer-redefine-test-1" eval ] unit-test
[ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test
[ defer-redefine-test-2 ] unit-test-fails
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
[ 1 ] [ defer-redefine-test-2 ] unit-test

8
extra/const/const.factor
View File

@ -14,3 +14,11 @@ IN: const
: ENUM:
";" parse-tokens [ create-in ] map define-enum ; parsing
: define-value ( word -- )
{ f } clone [ first ] curry define ;
: VALUE: CREATE define-value ; parsing
: set-value ( value word -- )
word-def first set-first ;

14
extra/unicode/breaks/breaks.factor
View File

@ -1,7 +1,7 @@
USING: unicode.categories kernel math combinators splitting
sequences math.parser io.files io assocs arrays namespaces
combinators.lib assocs.lib math.ranges unicode.normalize
unicode.syntax unicode.data compiler.units alien.syntax ;
unicode.syntax unicode.data compiler.units alien.syntax const ;
IN: unicode.breaks
C-ENUM: Any L V T Extend Control CR LF graphemes ;
@ -32,7 +32,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
: other-extend-lines ( -- lines )
"extra/unicode/PropList.txt" resource-path file-lines ;
DEFER: other-extend
VALUE: other-extend
CATEGORY: (extend) Me Mn ;
: extend? ( ch -- ? )
@ -77,7 +77,7 @@ SYMBOL: table
T T connect
graphemes Extend connect-after ;
DEFER: grapheme-table
VALUE: grapheme-table
: grapheme-break? ( class1 class2 -- ? )
grapheme-table nth nth not ;
@ -113,10 +113,10 @@ DEFER: grapheme-table
[ grapheme-class dup rot grapheme-break? ] find-last-index
nip -1 or 1+ ;
<<
other-extend-lines process-other-extend \ other-extend define-value
[
other-extend-lines process-other-extend \ other-extend set-value
init-grapheme-table table
[ make-grapheme-table finish-table ] with-variable
\ grapheme-table define-value
>>
\ grapheme-table set-value
] with-compilation-unit

49
extra/unicode/data/data.factor
View File

@ -1,15 +1,12 @@
USING: assocs math kernel sequences io.files hashtables
quotations splitting arrays math.parser combinators.lib hash2
byte-arrays words namespaces words compiler.units ;
byte-arrays words namespaces words compiler.units const ;
IN: unicode.data
! Convenience functions
: 1+* ( n/f _ -- n+1 )
drop [ 1+ ] [ 0 ] if* ;
: define-value ( value word -- )
swap 1quotation define ;
: ?between? ( n/f from to -- ? )
pick [ between? ] [ 3drop f ] if ;
@ -107,16 +104,16 @@ C: <code-point> code-point
4 head [ multihex ] map first4
<code-point> swap first set ;
DEFER: simple-lower
DEFER: simple-upper
DEFER: simple-title
DEFER: canonical-map
DEFER: combine-map
DEFER: class-map
DEFER: compat-map
DEFER: category-map
DEFER: name-map
DEFER: special-casing
VALUE: simple-lower
VALUE: simple-upper
VALUE: simple-title
VALUE: canonical-map
VALUE: combine-map
VALUE: class-map
VALUE: compat-map
VALUE: category-map
VALUE: name-map
VALUE: special-casing
: canonical-entry ( char -- seq ) canonical-map at ;
: combine-chars ( a b -- char/f ) combine-map hash2 ;
@ -132,16 +129,14 @@ DEFER: special-casing
[ length 5 = ] subset
[ [ set-code-point ] each ] H{ } make-assoc ;
[
load-data
dup process-names \ name-map define-value
13 over process-data \ simple-lower define-value
12 over process-data tuck \ simple-upper define-value
14 over process-data swapd union \ simple-title define-value
dup process-combining \ class-map define-value
dup process-canonical \ canonical-map define-value
\ combine-map define-value
dup process-compat \ compat-map define-value
process-category \ category-map define-value
load-special-casing \ special-casing define-value
] with-compilation-unit
load-data
dup process-names \ name-map set-value
13 over process-data \ simple-lower set-value
12 over process-data tuck \ simple-upper set-value
14 over process-data swapd union \ simple-title set-value
dup process-combining \ class-map set-value
dup process-canonical \ canonical-map set-value
\ combine-map set-value
dup process-compat \ compat-map set-value
process-category \ category-map set-value
load-special-casing \ special-casing set-value

6
extra/unicode/normalize/normalize.factor
View File

@ -2,7 +2,7 @@ USING: sequences namespaces unicode.data kernel combinators.lib
math arrays ;
IN: unicode.normalize
! Utility word
! Utility word--probably unnecessary
: make* ( seq quot exemplar -- newseq )
! quot has access to original seq on stack
! this just makes the new-resizable the same length as seq
@ -89,7 +89,7 @@ IN: unicode.normalize
swap [ [
dup hangul? [ hangul>jamo % drop ]
[ dup rot call [ % ] [ , ] ?if ] if
] with each ] "" make*
] with each ] "" make
dup reorder
] if ; inline
@ -167,7 +167,7 @@ SYMBOL: char
0 ind set
SBUF" " clone after set
pass-combining (compose)
] "" make* ;
] "" make ;
: nfc ( string -- nfc )
nfd compose ;

4
extra/unicode/syntax/syntax.factor
View File

@ -1,5 +1,5 @@
USING: unicode.data kernel math sequences parser bit-arrays namespaces
sequences.private arrays quotations classes.predicate ;
sequences.private arrays quotations classes.predicate assocs ;
IN: unicode.syntax
! Character classes (categories)
@ -48,5 +48,5 @@ IN: unicode.syntax
categories swap seq-minus define-category ; parsing
: UNICHAR:
! This should be part of CHAR:
! This should be part of CHAR:. Also, name-map at ==> name>char
scan name>char [ parsed ] [ "Invalid character" throw ] if* ; parsing

26
extra/xml/entities/entities.factor
View File

@ -1,8 +1,32 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel ;
USING: namespaces kernel assocs sequences ;
IN: xml.entities
: entities-out
H{
{ CHAR: < "&lt;" }
{ CHAR: > "&gt;" }
{ CHAR: & "&amp;" }
} ;
: quoted-entities-out
H{
{ CHAR: & "&amp;" }
{ CHAR: ' "&apos;" }
{ CHAR: " "&quot;" }
} ;
: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
[ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
: escape-string ( str -- newstr )
entities-out escape-string-by ;
: escape-quoted-string ( str -- newstr )
quoted-entities-out escape-string-by ;
: entities
H{
{ "lt" CHAR: < }

7
extra/xml/test/templating.factor
View File

@ -1,4 +1,3 @@
IN: templating
USING: kernel xml sequences assocs tools.test io arrays namespaces
xml.data xml.utilities xml.writer generic sequences.deep ;
@ -9,10 +8,10 @@ SYMBOL: ref-table
GENERIC: (r-ref) ( xml -- )
M: tag (r-ref)
sub-tag over at [
sub-tag over at* [
ref-table get at
swap set-tag-children
] [ drop ] if* ;
] [ 2drop ] if ;
M: object (r-ref) drop ;
: template ( xml -- )
@ -40,4 +39,4 @@ M: object (r-ref) drop ;
sample-doc string>xml dup template xml>string
] with-scope ;
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test

4
extra/xml/test/test.factor
View File

@ -26,7 +26,7 @@ SYMBOL: xml-file
] unit-test
[ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test
[ "that" ] [ xml-file get "this" swap at ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<a b=\"c\"/>" ]
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><a b=\"c\"/>" ]
[ "<a b='c'/>" string>xml xml>string ] unit-test
[ "abcd" ] [
"<main>a<sub>bc</sub>d<nothing/></main>" string>xml
@ -44,7 +44,7 @@ SYMBOL: xml-file
at swap "z" >r tuck r> swap set-at
T{ name f "blah" "z" f } swap at ] unit-test
[ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>bar baz</foo>" ]
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><foo>bar baz</foo>" ]
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>\n bar\n</foo>" ]
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test

44
extra/xml/writer/writer.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: hashtables kernel math namespaces sequences strings
io io.streams.string xml.data assocs ;
io io.streams.string xml.data assocs wrap xml.entities ;
IN: xml.writer
SYMBOL: xml-pprint?
@ -13,10 +13,13 @@ SYMBOL: indenter
: sensitive? ( tag -- ? )
sensitive-tags get swap [ names-match? ] curry contains? ;
: indent-string ( -- string )
xml-pprint? get
[ indentation get indenter get <repetition> concat ]
[ "" ] if ;
: ?indent ( -- )
xml-pprint? get [
nl indentation get indenter get <repetition> [ write ] each
] when ;
xml-pprint? get [ nl indent-string write ] when ;
: indent ( -- )
xml-pprint? get [ 1 indentation +@ ] when ;
@ -35,30 +38,6 @@ SYMBOL: indenter
[ dup empty? swap string? and not ] subset
] when ;
: entities-out
H{
{ CHAR: < "&lt;" }
{ CHAR: > "&gt;" }
{ CHAR: & "&amp;" }
} ;
: quoted-entities-out
H{
{ CHAR: & "&amp;" }
{ CHAR: ' "&apos;" }
{ CHAR: " "&quot;" }
} ;
: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
[ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
: escape-string ( str -- newstr )
entities-out escape-string-by ;
: escape-quoted-string ( str -- newstr )
quoted-entities-out escape-string-by ;
: print-name ( name -- )
dup name-space f like
[ write CHAR: : write1 ] when*
@ -76,10 +55,11 @@ SYMBOL: indenter
GENERIC: write-item ( object -- )
M: string write-item
escape-string write ;
escape-string dup empty? not xml-pprint? get and
[ nl 80 indent-string indented-break ] when write ;
: write-tag ( tag -- )
CHAR: < write1
?indent CHAR: < write1
dup print-name tag-attrs print-attrs ;
M: contained-tag write-item
@ -87,7 +67,7 @@ M: contained-tag write-item
: write-children ( tag -- )
indent tag-children ?filter-children
[ ?indent write-item ] each unindent ;
[ write-item ] each unindent ;
: write-end-tag ( tag -- )
?indent "</" write print-name CHAR: > write1 ;
@ -112,7 +92,7 @@ M: instruction write-item
"<?xml version=\"" write dup prolog-version write
"\" encoding=\"" write dup prolog-encoding write
prolog-standalone [ "\" standalone=\"yes" write ] when
"\"?>\n" write ;
"\"?>" write ;
: write-chunk ( seq -- )
[ write-item ] each ;