Merge branch 'master' into fortran
Joe Groff
commit
da05150686
21
Makefile
21
Makefile
|
|
@ -17,11 +17,12 @@ else
|
||||||
CFLAGS += -O3 $(SITE_CFLAGS)
|
CFLAGS += -O3 $(SITE_CFLAGS)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
CONFIG = $(shell ./build-support/factor.sh config-target)
|
|
||||||
include $(CONFIG)
|
|
||||||
|
|
||||||
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
||||||
|
|
||||||
|
ifdef CONFIG
|
||||||
|
include $(CONFIG)
|
||||||
|
endif
|
||||||
|
|
||||||
DLL_OBJS = $(PLAF_DLL_OBJS) \
|
DLL_OBJS = $(PLAF_DLL_OBJS) \
|
||||||
vm/alien.o \
|
vm/alien.o \
|
||||||
vm/bignum.o \
|
vm/bignum.o \
|
||||||
|
|
@ -128,21 +129,11 @@ solaris-x86-32:
|
||||||
solaris-x86-64:
|
solaris-x86-64:
|
||||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
|
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
|
||||||
|
|
||||||
freetype6.dll:
|
winnt-x86-32:
|
||||||
wget $(DLL_PATH)/freetype6.dll
|
|
||||||
chmod 755 freetype6.dll
|
|
||||||
|
|
||||||
zlib1.dll:
|
|
||||||
wget $(DLL_PATH)/zlib1.dll
|
|
||||||
chmod 755 zlib1.dll
|
|
||||||
|
|
||||||
windows-dlls: freetype6.dll zlib1.dll
|
|
||||||
|
|
||||||
winnt-x86-32: windows-dlls
|
|
||||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
||||||
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
||||||
|
|
||||||
winnt-x86-64: windows-dlls
|
winnt-x86-64:
|
||||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
|
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
|
||||||
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
|
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien arrays alien.c-types alien.structs
|
USING: alien arrays alien.c-types alien.structs
|
||||||
sequences math kernel namespaces make libc cpu.architecture ;
|
sequences math kernel namespaces fry libc cpu.architecture ;
|
||||||
IN: alien.arrays
|
IN: alien.arrays
|
||||||
|
|
||||||
UNION: value-type array struct-type ;
|
UNION: value-type array struct-type ;
|
||||||
|
|
@ -10,7 +10,7 @@ M: array c-type ;
|
||||||
|
|
||||||
M: array c-type-class drop object ;
|
M: array c-type-class drop object ;
|
||||||
|
|
||||||
M: array heap-size unclip heap-size [ * ] reduce ;
|
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
|
||||||
|
|
||||||
M: array c-type-align first c-type-align ;
|
M: array c-type-align first c-type-align ;
|
||||||
|
|
||||||
|
|
@ -26,16 +26,15 @@ M: array box-return drop "void*" box-return ;
|
||||||
|
|
||||||
M: array stack-size drop "void*" stack-size ;
|
M: array stack-size drop "void*" stack-size ;
|
||||||
|
|
||||||
|
M: array c-type-boxer-quot drop f ;
|
||||||
|
|
||||||
|
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
||||||
|
|
||||||
M: value-type c-type-reg-class drop int-regs ;
|
M: value-type c-type-reg-class drop int-regs ;
|
||||||
|
|
||||||
M: value-type c-type-boxer-quot drop f ;
|
|
||||||
|
|
||||||
M: value-type c-type-unboxer-quot drop f ;
|
|
||||||
|
|
||||||
M: value-type c-type-getter
|
M: value-type c-type-getter
|
||||||
drop [ swap <displaced-alien> ] ;
|
drop [ swap <displaced-alien> ] ;
|
||||||
|
|
||||||
M: value-type c-type-setter ( type -- quot )
|
M: value-type c-type-setter ( type -- quot )
|
||||||
[
|
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
|
||||||
dup c-type-getter % \ swap , heap-size , \ memcpy ,
|
'[ @ swap @ _ memcpy ] ;
|
||||||
] [ ] make ;
|
|
||||||
|
|
|
||||||
|
|
@ -178,6 +178,8 @@ $nl
|
||||||
{ { $snippet "ulonglong" } { } }
|
{ { $snippet "ulonglong" } { } }
|
||||||
{ { $snippet "float" } { } }
|
{ { $snippet "float" } { } }
|
||||||
{ { $snippet "double" } { "same format as " { $link float } " objects" } }
|
{ { $snippet "double" } { "same format as " { $link float } " objects" } }
|
||||||
|
{ { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
|
||||||
|
{ { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
|
||||||
}
|
}
|
||||||
"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
|
"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
|
||||||
$nl
|
$nl
|
||||||
|
|
|
||||||
|
|
@ -201,13 +201,13 @@ M: byte-array byte-length length ;
|
||||||
1 swap malloc-array ; inline
|
1 swap malloc-array ; inline
|
||||||
|
|
||||||
: malloc-byte-array ( byte-array -- alien )
|
: malloc-byte-array ( byte-array -- alien )
|
||||||
dup length [ nip malloc dup ] 2keep memcpy ;
|
dup byte-length [ nip malloc dup ] 2keep memcpy ;
|
||||||
|
|
||||||
: memory>byte-array ( alien len -- byte-array )
|
: memory>byte-array ( alien len -- byte-array )
|
||||||
[ nip (byte-array) dup ] 2keep memcpy ;
|
[ nip (byte-array) dup ] 2keep memcpy ;
|
||||||
|
|
||||||
: byte-array>memory ( byte-array base -- )
|
: byte-array>memory ( byte-array base -- )
|
||||||
swap dup length memcpy ;
|
swap dup byte-length memcpy ;
|
||||||
|
|
||||||
: array-accessor ( type quot -- def )
|
: array-accessor ( type quot -- def )
|
||||||
[
|
[
|
||||||
|
|
@ -263,7 +263,7 @@ M: long-long-type box-return ( type -- )
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: malloc-file-contents ( path -- alien len )
|
: malloc-file-contents ( path -- alien len )
|
||||||
binary file-contents dup malloc-byte-array swap length ;
|
binary file-contents [ malloc-byte-array ] [ length ] bi ;
|
||||||
|
|
||||||
: if-void ( type true false -- )
|
: if-void ( type true false -- )
|
||||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||||
|
|
@ -283,9 +283,10 @@ M: long-long-type box-return ( type -- )
|
||||||
<c-type>
|
<c-type>
|
||||||
c-ptr >>class
|
c-ptr >>class
|
||||||
[ alien-cell ] >>getter
|
[ alien-cell ] >>getter
|
||||||
[ set-alien-cell ] >>setter
|
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
|
||||||
bootstrap-cell >>size
|
bootstrap-cell >>size
|
||||||
bootstrap-cell >>align
|
bootstrap-cell >>align
|
||||||
|
[ >c-ptr ] >>unboxer-quot
|
||||||
"box_alien" >>boxer
|
"box_alien" >>boxer
|
||||||
"alien_offset" >>unboxer
|
"alien_offset" >>unboxer
|
||||||
"void*" define-primitive-type
|
"void*" define-primitive-type
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
||||||
|
|
@ -0,0 +1,18 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test alien.complex kernel alien.c-types alien.syntax
|
||||||
|
namespaces ;
|
||||||
|
IN: alien.complex.tests
|
||||||
|
|
||||||
|
C-STRUCT: complex-holder
|
||||||
|
{ "complex-float" "z" } ;
|
||||||
|
|
||||||
|
: <complex-holder> ( z -- alien )
|
||||||
|
"complex-holder" <c-object>
|
||||||
|
[ set-complex-holder-z ] keep ;
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
C{ 1.0 2.0 } <complex-holder> "h" set
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
|
||||||
|
|
@ -0,0 +1,6 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien.complex.functor sequences kernel ;
|
||||||
|
IN: alien.complex
|
||||||
|
|
||||||
|
<< { "float" "double" } [ dup "complex-" prepend define-complex-type ] each >>
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
||||||
|
|
@ -0,0 +1,4 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test alien.complex.functor ;
|
||||||
|
IN: alien.complex.functor.tests
|
||||||
|
|
@ -0,0 +1,35 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien.structs alien.c-types math math.functions sequences
|
||||||
|
arrays kernel functors vocabs.parser namespaces accessors
|
||||||
|
quotations ;
|
||||||
|
IN: alien.complex.functor
|
||||||
|
|
||||||
|
FUNCTOR: define-complex-type ( N T -- )
|
||||||
|
|
||||||
|
T-real DEFINES ${T}-real
|
||||||
|
T-imaginary DEFINES ${T}-imaginary
|
||||||
|
set-T-real DEFINES set-${T}-real
|
||||||
|
set-T-imaginary DEFINES set-${T}-imaginary
|
||||||
|
|
||||||
|
>T DEFINES >${T}
|
||||||
|
T> DEFINES ${T}>
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
: >T ( z -- alien )
|
||||||
|
>rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
|
||||||
|
|
||||||
|
: T> ( alien -- z )
|
||||||
|
[ T-real ] [ T-imaginary ] bi rect> ; inline
|
||||||
|
|
||||||
|
T in get
|
||||||
|
{ { N "real" } { N "imaginary" } }
|
||||||
|
define-struct
|
||||||
|
|
||||||
|
T c-type
|
||||||
|
T> 1quotation >>boxer-quot
|
||||||
|
>T 1quotation >>unboxer-quot
|
||||||
|
drop
|
||||||
|
|
||||||
|
;FUNCTOR
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Implementation details for C99 complex float and complex double types
|
||||||
|
|
@ -5,7 +5,7 @@ math namespaces parser sequences strings words libc fry
|
||||||
alien.c-types alien.structs.fields cpu.architecture math.order ;
|
alien.c-types alien.structs.fields cpu.architecture math.order ;
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type size align fields ;
|
TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
|
||||||
|
|
||||||
M: struct-type heap-size size>> ;
|
M: struct-type heap-size size>> ;
|
||||||
|
|
||||||
|
|
@ -15,6 +15,10 @@ M: struct-type c-type-align align>> ;
|
||||||
|
|
||||||
M: struct-type c-type-stack-align? drop f ;
|
M: struct-type c-type-stack-align? drop f ;
|
||||||
|
|
||||||
|
M: struct-type c-type-boxer-quot boxer-quot>> ;
|
||||||
|
|
||||||
|
M: struct-type c-type-unboxer-quot unboxer-quot>> ;
|
||||||
|
|
||||||
: if-value-struct ( ctype true false -- )
|
: if-value-struct ( ctype true false -- )
|
||||||
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||||
|
|
||||||
|
|
@ -40,7 +44,10 @@ M: struct-type stack-size
|
||||||
|
|
||||||
: (define-struct) ( name size align fields -- )
|
: (define-struct) ( name size align fields -- )
|
||||||
[ [ align ] keep ] dip
|
[ [ align ] keep ] dip
|
||||||
struct-type boa
|
struct-type new
|
||||||
|
swap >>fields
|
||||||
|
swap >>align
|
||||||
|
swap >>size
|
||||||
swap typedef ;
|
swap typedef ;
|
||||||
|
|
||||||
: make-fields ( name vocab fields -- fields )
|
: make-fields ( name vocab fields -- fields )
|
||||||
|
|
|
||||||
|
|
@ -202,7 +202,7 @@ assoc-union alien>objc-types set-global
|
||||||
[ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
|
[ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
|
||||||
over 0 = [ 3drop ] [
|
over 0 = [ 3drop ] [
|
||||||
[ <direct-void*-array> ] dip
|
[ <direct-void*-array> ] dip
|
||||||
[ each ] [ drop underlying>> (free) ] 2bi
|
[ each ] [ drop (free) ] 2bi
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
: register-objc-methods ( class -- )
|
: register-objc-methods ( class -- )
|
||||||
|
|
|
||||||
|
|
@ -68,7 +68,7 @@ PRIVATE>
|
||||||
NSOpenGLPFASamples , 8 ,
|
NSOpenGLPFASamples , 8 ,
|
||||||
] when
|
] when
|
||||||
0 ,
|
0 ,
|
||||||
] int-array{ } make underlying>>
|
] int-array{ } make
|
||||||
-> initWithAttributes:
|
-> initWithAttributes:
|
||||||
-> autorelease ;
|
-> autorelease ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
||||||
|
|
@ -0,0 +1,6 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test colors.constants colors ;
|
||||||
|
IN: colors.constants.tests
|
||||||
|
|
||||||
|
[ t ] [ COLOR: light-green rgba? ] unit-test
|
||||||
|
|
@ -0,0 +1,31 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel assocs math math.parser memoize
|
||||||
|
io.encodings.ascii io.files lexer parser
|
||||||
|
colors sequences splitting combinators.smart ascii ;
|
||||||
|
IN: colors.constants
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: parse-color ( line -- name color )
|
||||||
|
[
|
||||||
|
[ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
|
||||||
|
[ blank? ] trim-head { { CHAR: \s CHAR: - } } substitute swap
|
||||||
|
] input<sequence ;
|
||||||
|
|
||||||
|
: parse-rgb.txt ( lines -- assoc )
|
||||||
|
[ "!" head? not ] filter
|
||||||
|
[ 11 cut [ " \t" split harvest ] dip suffix ] map
|
||||||
|
[ parse-color ] H{ } map>assoc ;
|
||||||
|
|
||||||
|
MEMO: rgb.txt ( -- assoc )
|
||||||
|
"resource:basis/colors/constants/rgb.txt" ascii file-lines parse-rgb.txt ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
ERROR: no-such-color name ;
|
||||||
|
|
||||||
|
: named-color ( name -- rgb )
|
||||||
|
dup rgb.txt at [ ] [ no-such-color ] ?if ;
|
||||||
|
|
||||||
|
: COLOR: scan named-color parsed ; parsing
|
||||||
|
|
@ -0,0 +1,753 @@
|
||||||
|
! $Xorg: rgb.txt,v 1.3 2000/08/17 19:54:00 cpqbld Exp $
|
||||||
|
255 250 250 snow
|
||||||
|
248 248 255 ghost white
|
||||||
|
248 248 255 GhostWhite
|
||||||
|
245 245 245 white smoke
|
||||||
|
245 245 245 WhiteSmoke
|
||||||
|
220 220 220 gainsboro
|
||||||
|
255 250 240 floral white
|
||||||
|
255 250 240 FloralWhite
|
||||||
|
253 245 230 old lace
|
||||||
|
253 245 230 OldLace
|
||||||
|
250 240 230 linen
|
||||||
|
250 235 215 antique white
|
||||||
|
250 235 215 AntiqueWhite
|
||||||
|
255 239 213 papaya whip
|
||||||
|
255 239 213 PapayaWhip
|
||||||
|
255 235 205 blanched almond
|
||||||
|
255 235 205 BlanchedAlmond
|
||||||
|
255 228 196 bisque
|
||||||
|
255 218 185 peach puff
|
||||||
|
255 218 185 PeachPuff
|
||||||
|
255 222 173 navajo white
|
||||||
|
255 222 173 NavajoWhite
|
||||||
|
255 228 181 moccasin
|
||||||
|
255 248 220 cornsilk
|
||||||
|
255 255 240 ivory
|
||||||
|
255 250 205 lemon chiffon
|
||||||
|
255 250 205 LemonChiffon
|
||||||
|
255 245 238 seashell
|
||||||
|
240 255 240 honeydew
|
||||||
|
245 255 250 mint cream
|
||||||
|
245 255 250 MintCream
|
||||||
|
240 255 255 azure
|
||||||
|
240 248 255 alice blue
|
||||||
|
240 248 255 AliceBlue
|
||||||
|
230 230 250 lavender
|
||||||
|
255 240 245 lavender blush
|
||||||
|
255 240 245 LavenderBlush
|
||||||
|
255 228 225 misty rose
|
||||||
|
255 228 225 MistyRose
|
||||||
|
255 255 255 white
|
||||||
|
0 0 0 black
|
||||||
|
47 79 79 dark slate gray
|
||||||
|
47 79 79 DarkSlateGray
|
||||||
|
47 79 79 dark slate grey
|
||||||
|
47 79 79 DarkSlateGrey
|
||||||
|
105 105 105 dim gray
|
||||||
|
105 105 105 DimGray
|
||||||
|
105 105 105 dim grey
|
||||||
|
105 105 105 DimGrey
|
||||||
|
112 128 144 slate gray
|
||||||
|
112 128 144 SlateGray
|
||||||
|
112 128 144 slate grey
|
||||||
|
112 128 144 SlateGrey
|
||||||
|
119 136 153 light slate gray
|
||||||
|
119 136 153 LightSlateGray
|
||||||
|
119 136 153 light slate grey
|
||||||
|
119 136 153 LightSlateGrey
|
||||||
|
190 190 190 gray
|
||||||
|
190 190 190 grey
|
||||||
|
211 211 211 light grey
|
||||||
|
211 211 211 LightGrey
|
||||||
|
211 211 211 light gray
|
||||||
|
211 211 211 LightGray
|
||||||
|
25 25 112 midnight blue
|
||||||
|
25 25 112 MidnightBlue
|
||||||
|
0 0 128 navy
|
||||||
|
0 0 128 navy blue
|
||||||
|
0 0 128 NavyBlue
|
||||||
|
100 149 237 cornflower blue
|
||||||
|
100 149 237 CornflowerBlue
|
||||||
|
72 61 139 dark slate blue
|
||||||
|
72 61 139 DarkSlateBlue
|
||||||
|
106 90 205 slate blue
|
||||||
|
106 90 205 SlateBlue
|
||||||
|
123 104 238 medium slate blue
|
||||||
|
123 104 238 MediumSlateBlue
|
||||||
|
132 112 255 light slate blue
|
||||||
|
132 112 255 LightSlateBlue
|
||||||
|
0 0 205 medium blue
|
||||||
|
0 0 205 MediumBlue
|
||||||
|
65 105 225 royal blue
|
||||||
|
65 105 225 RoyalBlue
|
||||||
|
0 0 255 blue
|
||||||
|
30 144 255 dodger blue
|
||||||
|
30 144 255 DodgerBlue
|
||||||
|
0 191 255 deep sky blue
|
||||||
|
0 191 255 DeepSkyBlue
|
||||||
|
135 206 235 sky blue
|
||||||
|
135 206 235 SkyBlue
|
||||||
|
135 206 250 light sky blue
|
||||||
|
135 206 250 LightSkyBlue
|
||||||
|
70 130 180 steel blue
|
||||||
|
70 130 180 SteelBlue
|
||||||
|
176 196 222 light steel blue
|
||||||
|
176 196 222 LightSteelBlue
|
||||||
|
173 216 230 light blue
|
||||||
|
173 216 230 LightBlue
|
||||||
|
176 224 230 powder blue
|
||||||
|
176 224 230 PowderBlue
|
||||||
|
175 238 238 pale turquoise
|
||||||
|
175 238 238 PaleTurquoise
|
||||||
|
0 206 209 dark turquoise
|
||||||
|
0 206 209 DarkTurquoise
|
||||||
|
72 209 204 medium turquoise
|
||||||
|
72 209 204 MediumTurquoise
|
||||||
|
64 224 208 turquoise
|
||||||
|
0 255 255 cyan
|
||||||
|
224 255 255 light cyan
|
||||||
|
224 255 255 LightCyan
|
||||||
|
95 158 160 cadet blue
|
||||||
|
95 158 160 CadetBlue
|
||||||
|
102 205 170 medium aquamarine
|
||||||
|
102 205 170 MediumAquamarine
|
||||||
|
127 255 212 aquamarine
|
||||||
|
0 100 0 dark green
|
||||||
|
0 100 0 DarkGreen
|
||||||
|
85 107 47 dark olive green
|
||||||
|
85 107 47 DarkOliveGreen
|
||||||
|
143 188 143 dark sea green
|
||||||
|
143 188 143 DarkSeaGreen
|
||||||
|
46 139 87 sea green
|
||||||
|
46 139 87 SeaGreen
|
||||||
|
60 179 113 medium sea green
|
||||||
|
60 179 113 MediumSeaGreen
|
||||||
|
32 178 170 light sea green
|
||||||
|
32 178 170 LightSeaGreen
|
||||||
|
152 251 152 pale green
|
||||||
|
152 251 152 PaleGreen
|
||||||
|
0 255 127 spring green
|
||||||
|
0 255 127 SpringGreen
|
||||||
|
124 252 0 lawn green
|
||||||
|
124 252 0 LawnGreen
|
||||||
|
0 255 0 green
|
||||||
|
127 255 0 chartreuse
|
||||||
|
0 250 154 medium spring green
|
||||||
|
0 250 154 MediumSpringGreen
|
||||||
|
173 255 47 green yellow
|
||||||
|
173 255 47 GreenYellow
|
||||||
|
50 205 50 lime green
|
||||||
|
50 205 50 LimeGreen
|
||||||
|
154 205 50 yellow green
|
||||||
|
154 205 50 YellowGreen
|
||||||
|
34 139 34 forest green
|
||||||
|
34 139 34 ForestGreen
|
||||||
|
107 142 35 olive drab
|
||||||
|
107 142 35 OliveDrab
|
||||||
|
189 183 107 dark khaki
|
||||||
|
189 183 107 DarkKhaki
|
||||||
|
240 230 140 khaki
|
||||||
|
238 232 170 pale goldenrod
|
||||||
|
238 232 170 PaleGoldenrod
|
||||||
|
250 250 210 light goldenrod yellow
|
||||||
|
250 250 210 LightGoldenrodYellow
|
||||||
|
255 255 224 light yellow
|
||||||
|
255 255 224 LightYellow
|
||||||
|
255 255 0 yellow
|
||||||
|
255 215 0 gold
|
||||||
|
238 221 130 light goldenrod
|
||||||
|
238 221 130 LightGoldenrod
|
||||||
|
218 165 32 goldenrod
|
||||||
|
184 134 11 dark goldenrod
|
||||||
|
184 134 11 DarkGoldenrod
|
||||||
|
188 143 143 rosy brown
|
||||||
|
188 143 143 RosyBrown
|
||||||
|
205 92 92 indian red
|
||||||
|
205 92 92 IndianRed
|
||||||
|
139 69 19 saddle brown
|
||||||
|
139 69 19 SaddleBrown
|
||||||
|
160 82 45 sienna
|
||||||
|
205 133 63 peru
|
||||||
|
222 184 135 burlywood
|
||||||
|
245 245 220 beige
|
||||||
|
245 222 179 wheat
|
||||||
|
244 164 96 sandy brown
|
||||||
|
244 164 96 SandyBrown
|
||||||
|
210 180 140 tan
|
||||||
|
210 105 30 chocolate
|
||||||
|
178 34 34 firebrick
|
||||||
|
165 42 42 brown
|
||||||
|
233 150 122 dark salmon
|
||||||
|
233 150 122 DarkSalmon
|
||||||
|
250 128 114 salmon
|
||||||
|
255 160 122 light salmon
|
||||||
|
255 160 122 LightSalmon
|
||||||
|
255 165 0 orange
|
||||||
|
255 140 0 dark orange
|
||||||
|
255 140 0 DarkOrange
|
||||||
|
255 127 80 coral
|
||||||
|
240 128 128 light coral
|
||||||
|
240 128 128 LightCoral
|
||||||
|
255 99 71 tomato
|
||||||
|
255 69 0 orange red
|
||||||
|
255 69 0 OrangeRed
|
||||||
|
255 0 0 red
|
||||||
|
255 105 180 hot pink
|
||||||
|
255 105 180 HotPink
|
||||||
|
255 20 147 deep pink
|
||||||
|
255 20 147 DeepPink
|
||||||
|
255 192 203 pink
|
||||||
|
255 182 193 light pink
|
||||||
|
255 182 193 LightPink
|
||||||
|
219 112 147 pale violet red
|
||||||
|
219 112 147 PaleVioletRed
|
||||||
|
176 48 96 maroon
|
||||||
|
199 21 133 medium violet red
|
||||||
|
199 21 133 MediumVioletRed
|
||||||
|
208 32 144 violet red
|
||||||
|
208 32 144 VioletRed
|
||||||
|
255 0 255 magenta
|
||||||
|
238 130 238 violet
|
||||||
|
221 160 221 plum
|
||||||
|
218 112 214 orchid
|
||||||
|
186 85 211 medium orchid
|
||||||
|
186 85 211 MediumOrchid
|
||||||
|
153 50 204 dark orchid
|
||||||
|
153 50 204 DarkOrchid
|
||||||
|
148 0 211 dark violet
|
||||||
|
148 0 211 DarkViolet
|
||||||
|
138 43 226 blue violet
|
||||||
|
138 43 226 BlueViolet
|
||||||
|
160 32 240 purple
|
||||||
|
147 112 219 medium purple
|
||||||
|
147 112 219 MediumPurple
|
||||||
|
216 191 216 thistle
|
||||||
|
255 250 250 snow1
|
||||||
|
238 233 233 snow2
|
||||||
|
205 201 201 snow3
|
||||||
|
139 137 137 snow4
|
||||||
|
255 245 238 seashell1
|
||||||
|
238 229 222 seashell2
|
||||||
|
205 197 191 seashell3
|
||||||
|
139 134 130 seashell4
|
||||||
|
255 239 219 AntiqueWhite1
|
||||||
|
238 223 204 AntiqueWhite2
|
||||||
|
205 192 176 AntiqueWhite3
|
||||||
|
139 131 120 AntiqueWhite4
|
||||||
|
255 228 196 bisque1
|
||||||
|
238 213 183 bisque2
|
||||||
|
205 183 158 bisque3
|
||||||
|
139 125 107 bisque4
|
||||||
|
255 218 185 PeachPuff1
|
||||||
|
238 203 173 PeachPuff2
|
||||||
|
205 175 149 PeachPuff3
|
||||||
|
139 119 101 PeachPuff4
|
||||||
|
255 222 173 NavajoWhite1
|
||||||
|
238 207 161 NavajoWhite2
|
||||||
|
205 179 139 NavajoWhite3
|
||||||
|
139 121 94 NavajoWhite4
|
||||||
|
255 250 205 LemonChiffon1
|
||||||
|
238 233 191 LemonChiffon2
|
||||||
|
205 201 165 LemonChiffon3
|
||||||
|
139 137 112 LemonChiffon4
|
||||||
|
255 248 220 cornsilk1
|
||||||
|
238 232 205 cornsilk2
|
||||||
|
205 200 177 cornsilk3
|
||||||
|
139 136 120 cornsilk4
|
||||||
|
255 255 240 ivory1
|
||||||
|
238 238 224 ivory2
|
||||||
|
205 205 193 ivory3
|
||||||
|
139 139 131 ivory4
|
||||||
|
240 255 240 honeydew1
|
||||||
|
224 238 224 honeydew2
|
||||||
|
193 205 193 honeydew3
|
||||||
|
131 139 131 honeydew4
|
||||||
|
255 240 245 LavenderBlush1
|
||||||
|
238 224 229 LavenderBlush2
|
||||||
|
205 193 197 LavenderBlush3
|
||||||
|
139 131 134 LavenderBlush4
|
||||||
|
255 228 225 MistyRose1
|
||||||
|
238 213 210 MistyRose2
|
||||||
|
205 183 181 MistyRose3
|
||||||
|
139 125 123 MistyRose4
|
||||||
|
240 255 255 azure1
|
||||||
|
224 238 238 azure2
|
||||||
|
193 205 205 azure3
|
||||||
|
131 139 139 azure4
|
||||||
|
131 111 255 SlateBlue1
|
||||||
|
122 103 238 SlateBlue2
|
||||||
|
105 89 205 SlateBlue3
|
||||||
|
71 60 139 SlateBlue4
|
||||||
|
72 118 255 RoyalBlue1
|
||||||
|
67 110 238 RoyalBlue2
|
||||||
|
58 95 205 RoyalBlue3
|
||||||
|
39 64 139 RoyalBlue4
|
||||||
|
0 0 255 blue1
|
||||||
|
0 0 238 blue2
|
||||||
|
0 0 205 blue3
|
||||||
|
0 0 139 blue4
|
||||||
|
30 144 255 DodgerBlue1
|
||||||
|
28 134 238 DodgerBlue2
|
||||||
|
24 116 205 DodgerBlue3
|
||||||
|
16 78 139 DodgerBlue4
|
||||||
|
99 184 255 SteelBlue1
|
||||||
|
92 172 238 SteelBlue2
|
||||||
|
79 148 205 SteelBlue3
|
||||||
|
54 100 139 SteelBlue4
|
||||||
|
0 191 255 DeepSkyBlue1
|
||||||
|
0 178 238 DeepSkyBlue2
|
||||||
|
0 154 205 DeepSkyBlue3
|
||||||
|
0 104 139 DeepSkyBlue4
|
||||||
|
135 206 255 SkyBlue1
|
||||||
|
126 192 238 SkyBlue2
|
||||||
|
108 166 205 SkyBlue3
|
||||||
|
74 112 139 SkyBlue4
|
||||||
|
176 226 255 LightSkyBlue1
|
||||||
|
164 211 238 LightSkyBlue2
|
||||||
|
141 182 205 LightSkyBlue3
|
||||||
|
96 123 139 LightSkyBlue4
|
||||||
|
198 226 255 SlateGray1
|
||||||
|
185 211 238 SlateGray2
|
||||||
|
159 182 205 SlateGray3
|
||||||
|
108 123 139 SlateGray4
|
||||||
|
202 225 255 LightSteelBlue1
|
||||||
|
188 210 238 LightSteelBlue2
|
||||||
|
162 181 205 LightSteelBlue3
|
||||||
|
110 123 139 LightSteelBlue4
|
||||||
|
191 239 255 LightBlue1
|
||||||
|
178 223 238 LightBlue2
|
||||||
|
154 192 205 LightBlue3
|
||||||
|
104 131 139 LightBlue4
|
||||||
|
224 255 255 LightCyan1
|
||||||
|
209 238 238 LightCyan2
|
||||||
|
180 205 205 LightCyan3
|
||||||
|
122 139 139 LightCyan4
|
||||||
|
187 255 255 PaleTurquoise1
|
||||||
|
174 238 238 PaleTurquoise2
|
||||||
|
150 205 205 PaleTurquoise3
|
||||||
|
102 139 139 PaleTurquoise4
|
||||||
|
152 245 255 CadetBlue1
|
||||||
|
142 229 238 CadetBlue2
|
||||||
|
122 197 205 CadetBlue3
|
||||||
|
83 134 139 CadetBlue4
|
||||||
|
0 245 255 turquoise1
|
||||||
|
0 229 238 turquoise2
|
||||||
|
0 197 205 turquoise3
|
||||||
|
0 134 139 turquoise4
|
||||||
|
0 255 255 cyan1
|
||||||
|
0 238 238 cyan2
|
||||||
|
0 205 205 cyan3
|
||||||
|
0 139 139 cyan4
|
||||||
|
151 255 255 DarkSlateGray1
|
||||||
|
141 238 238 DarkSlateGray2
|
||||||
|
121 205 205 DarkSlateGray3
|
||||||
|
82 139 139 DarkSlateGray4
|
||||||
|
127 255 212 aquamarine1
|
||||||
|
118 238 198 aquamarine2
|
||||||
|
102 205 170 aquamarine3
|
||||||
|
69 139 116 aquamarine4
|
||||||
|
193 255 193 DarkSeaGreen1
|
||||||
|
180 238 180 DarkSeaGreen2
|
||||||
|
155 205 155 DarkSeaGreen3
|
||||||
|
105 139 105 DarkSeaGreen4
|
||||||
|
84 255 159 SeaGreen1
|
||||||
|
78 238 148 SeaGreen2
|
||||||
|
67 205 128 SeaGreen3
|
||||||
|
46 139 87 SeaGreen4
|
||||||
|
154 255 154 PaleGreen1
|
||||||
|
144 238 144 PaleGreen2
|
||||||
|
124 205 124 PaleGreen3
|
||||||
|
84 139 84 PaleGreen4
|
||||||
|
0 255 127 SpringGreen1
|
||||||
|
0 238 118 SpringGreen2
|
||||||
|
0 205 102 SpringGreen3
|
||||||
|
0 139 69 SpringGreen4
|
||||||
|
0 255 0 green1
|
||||||
|
0 238 0 green2
|
||||||
|
0 205 0 green3
|
||||||
|
0 139 0 green4
|
||||||
|
127 255 0 chartreuse1
|
||||||
|
118 238 0 chartreuse2
|
||||||
|
102 205 0 chartreuse3
|
||||||
|
69 139 0 chartreuse4
|
||||||
|
192 255 62 OliveDrab1
|
||||||
|
179 238 58 OliveDrab2
|
||||||
|
154 205 50 OliveDrab3
|
||||||
|
105 139 34 OliveDrab4
|
||||||
|
202 255 112 DarkOliveGreen1
|
||||||
|
188 238 104 DarkOliveGreen2
|
||||||
|
162 205 90 DarkOliveGreen3
|
||||||
|
110 139 61 DarkOliveGreen4
|
||||||
|
255 246 143 khaki1
|
||||||
|
238 230 133 khaki2
|
||||||
|
205 198 115 khaki3
|
||||||
|
139 134 78 khaki4
|
||||||
|
255 236 139 LightGoldenrod1
|
||||||
|
238 220 130 LightGoldenrod2
|
||||||
|
205 190 112 LightGoldenrod3
|
||||||
|
139 129 76 LightGoldenrod4
|
||||||
|
255 255 224 LightYellow1
|
||||||
|
238 238 209 LightYellow2
|
||||||
|
205 205 180 LightYellow3
|
||||||
|
139 139 122 LightYellow4
|
||||||
|
255 255 0 yellow1
|
||||||
|
238 238 0 yellow2
|
||||||
|
205 205 0 yellow3
|
||||||
|
139 139 0 yellow4
|
||||||
|
255 215 0 gold1
|
||||||
|
238 201 0 gold2
|
||||||
|
205 173 0 gold3
|
||||||
|
139 117 0 gold4
|
||||||
|
255 193 37 goldenrod1
|
||||||
|
238 180 34 goldenrod2
|
||||||
|
205 155 29 goldenrod3
|
||||||
|
139 105 20 goldenrod4
|
||||||
|
255 185 15 DarkGoldenrod1
|
||||||
|
238 173 14 DarkGoldenrod2
|
||||||
|
205 149 12 DarkGoldenrod3
|
||||||
|
139 101 8 DarkGoldenrod4
|
||||||
|
255 193 193 RosyBrown1
|
||||||
|
238 180 180 RosyBrown2
|
||||||
|
205 155 155 RosyBrown3
|
||||||
|
139 105 105 RosyBrown4
|
||||||
|
255 106 106 IndianRed1
|
||||||
|
238 99 99 IndianRed2
|
||||||
|
205 85 85 IndianRed3
|
||||||
|
139 58 58 IndianRed4
|
||||||
|
255 130 71 sienna1
|
||||||
|
238 121 66 sienna2
|
||||||
|
205 104 57 sienna3
|
||||||
|
139 71 38 sienna4
|
||||||
|
255 211 155 burlywood1
|
||||||
|
238 197 145 burlywood2
|
||||||
|
205 170 125 burlywood3
|
||||||
|
139 115 85 burlywood4
|
||||||
|
255 231 186 wheat1
|
||||||
|
238 216 174 wheat2
|
||||||
|
205 186 150 wheat3
|
||||||
|
139 126 102 wheat4
|
||||||
|
255 165 79 tan1
|
||||||
|
238 154 73 tan2
|
||||||
|
205 133 63 tan3
|
||||||
|
139 90 43 tan4
|
||||||
|
255 127 36 chocolate1
|
||||||
|
238 118 33 chocolate2
|
||||||
|
205 102 29 chocolate3
|
||||||
|
139 69 19 chocolate4
|
||||||
|
255 48 48 firebrick1
|
||||||
|
238 44 44 firebrick2
|
||||||
|
205 38 38 firebrick3
|
||||||
|
139 26 26 firebrick4
|
||||||
|
255 64 64 brown1
|
||||||
|
238 59 59 brown2
|
||||||
|
205 51 51 brown3
|
||||||
|
139 35 35 brown4
|
||||||
|
255 140 105 salmon1
|
||||||
|
238 130 98 salmon2
|
||||||
|
205 112 84 salmon3
|
||||||
|
139 76 57 salmon4
|
||||||
|
255 160 122 LightSalmon1
|
||||||
|
238 149 114 LightSalmon2
|
||||||
|
205 129 98 LightSalmon3
|
||||||
|
139 87 66 LightSalmon4
|
||||||
|
255 165 0 orange1
|
||||||
|
238 154 0 orange2
|
||||||
|
205 133 0 orange3
|
||||||
|
139 90 0 orange4
|
||||||
|
255 127 0 DarkOrange1
|
||||||
|
238 118 0 DarkOrange2
|
||||||
|
205 102 0 DarkOrange3
|
||||||
|
139 69 0 DarkOrange4
|
||||||
|
255 114 86 coral1
|
||||||
|
238 106 80 coral2
|
||||||
|
205 91 69 coral3
|
||||||
|
139 62 47 coral4
|
||||||
|
255 99 71 tomato1
|
||||||
|
238 92 66 tomato2
|
||||||
|
205 79 57 tomato3
|
||||||
|
139 54 38 tomato4
|
||||||
|
255 69 0 OrangeRed1
|
||||||
|
238 64 0 OrangeRed2
|
||||||
|
205 55 0 OrangeRed3
|
||||||
|
139 37 0 OrangeRed4
|
||||||
|
255 0 0 red1
|
||||||
|
238 0 0 red2
|
||||||
|
205 0 0 red3
|
||||||
|
139 0 0 red4
|
||||||
|
255 20 147 DeepPink1
|
||||||
|
238 18 137 DeepPink2
|
||||||
|
205 16 118 DeepPink3
|
||||||
|
139 10 80 DeepPink4
|
||||||
|
255 110 180 HotPink1
|
||||||
|
238 106 167 HotPink2
|
||||||
|
205 96 144 HotPink3
|
||||||
|
139 58 98 HotPink4
|
||||||
|
255 181 197 pink1
|
||||||
|
238 169 184 pink2
|
||||||
|
205 145 158 pink3
|
||||||
|
139 99 108 pink4
|
||||||
|
255 174 185 LightPink1
|
||||||
|
238 162 173 LightPink2
|
||||||
|
205 140 149 LightPink3
|
||||||
|
139 95 101 LightPink4
|
||||||
|
255 130 171 PaleVioletRed1
|
||||||
|
238 121 159 PaleVioletRed2
|
||||||
|
205 104 137 PaleVioletRed3
|
||||||
|
139 71 93 PaleVioletRed4
|
||||||
|
255 52 179 maroon1
|
||||||
|
238 48 167 maroon2
|
||||||
|
205 41 144 maroon3
|
||||||
|
139 28 98 maroon4
|
||||||
|
255 62 150 VioletRed1
|
||||||
|
238 58 140 VioletRed2
|
||||||
|
205 50 120 VioletRed3
|
||||||
|
139 34 82 VioletRed4
|
||||||
|
255 0 255 magenta1
|
||||||
|
238 0 238 magenta2
|
||||||
|
205 0 205 magenta3
|
||||||
|
139 0 139 magenta4
|
||||||
|
255 131 250 orchid1
|
||||||
|
238 122 233 orchid2
|
||||||
|
205 105 201 orchid3
|
||||||
|
139 71 137 orchid4
|
||||||
|
255 187 255 plum1
|
||||||
|
238 174 238 plum2
|
||||||
|
205 150 205 plum3
|
||||||
|
139 102 139 plum4
|
||||||
|
224 102 255 MediumOrchid1
|
||||||
|
209 95 238 MediumOrchid2
|
||||||
|
180 82 205 MediumOrchid3
|
||||||
|
122 55 139 MediumOrchid4
|
||||||
|
191 62 255 DarkOrchid1
|
||||||
|
178 58 238 DarkOrchid2
|
||||||
|
154 50 205 DarkOrchid3
|
||||||
|
104 34 139 DarkOrchid4
|
||||||
|
155 48 255 purple1
|
||||||
|
145 44 238 purple2
|
||||||
|
125 38 205 purple3
|
||||||
|
85 26 139 purple4
|
||||||
|
171 130 255 MediumPurple1
|
||||||
|
159 121 238 MediumPurple2
|
||||||
|
137 104 205 MediumPurple3
|
||||||
|
93 71 139 MediumPurple4
|
||||||
|
255 225 255 thistle1
|
||||||
|
238 210 238 thistle2
|
||||||
|
205 181 205 thistle3
|
||||||
|
139 123 139 thistle4
|
||||||
|
0 0 0 gray0
|
||||||
|
0 0 0 grey0
|
||||||
|
3 3 3 gray1
|
||||||
|
3 3 3 grey1
|
||||||
|
5 5 5 gray2
|
||||||
|
5 5 5 grey2
|
||||||
|
8 8 8 gray3
|
||||||
|
8 8 8 grey3
|
||||||
|
10 10 10 gray4
|
||||||
|
10 10 10 grey4
|
||||||
|
13 13 13 gray5
|
||||||
|
13 13 13 grey5
|
||||||
|
15 15 15 gray6
|
||||||
|
15 15 15 grey6
|
||||||
|
18 18 18 gray7
|
||||||
|
18 18 18 grey7
|
||||||
|
20 20 20 gray8
|
||||||
|
20 20 20 grey8
|
||||||
|
23 23 23 gray9
|
||||||
|
23 23 23 grey9
|
||||||
|
26 26 26 gray10
|
||||||
|
26 26 26 grey10
|
||||||
|
28 28 28 gray11
|
||||||
|
28 28 28 grey11
|
||||||
|
31 31 31 gray12
|
||||||
|
31 31 31 grey12
|
||||||
|
33 33 33 gray13
|
||||||
|
33 33 33 grey13
|
||||||
|
36 36 36 gray14
|
||||||
|
36 36 36 grey14
|
||||||
|
38 38 38 gray15
|
||||||
|
38 38 38 grey15
|
||||||
|
41 41 41 gray16
|
||||||
|
41 41 41 grey16
|
||||||
|
43 43 43 gray17
|
||||||
|
43 43 43 grey17
|
||||||
|
46 46 46 gray18
|
||||||
|
46 46 46 grey18
|
||||||
|
48 48 48 gray19
|
||||||
|
48 48 48 grey19
|
||||||
|
51 51 51 gray20
|
||||||
|
51 51 51 grey20
|
||||||
|
54 54 54 gray21
|
||||||
|
54 54 54 grey21
|
||||||
|
56 56 56 gray22
|
||||||
|
56 56 56 grey22
|
||||||
|
59 59 59 gray23
|
||||||
|
59 59 59 grey23
|
||||||
|
61 61 61 gray24
|
||||||
|
61 61 61 grey24
|
||||||
|
64 64 64 gray25
|
||||||
|
64 64 64 grey25
|
||||||
|
66 66 66 gray26
|
||||||
|
66 66 66 grey26
|
||||||
|
69 69 69 gray27
|
||||||
|
69 69 69 grey27
|
||||||
|
71 71 71 gray28
|
||||||
|
71 71 71 grey28
|
||||||
|
74 74 74 gray29
|
||||||
|
74 74 74 grey29
|
||||||
|
77 77 77 gray30
|
||||||
|
77 77 77 grey30
|
||||||
|
79 79 79 gray31
|
||||||
|
79 79 79 grey31
|
||||||
|
82 82 82 gray32
|
||||||
|
82 82 82 grey32
|
||||||
|
84 84 84 gray33
|
||||||
|
84 84 84 grey33
|
||||||
|
87 87 87 gray34
|
||||||
|
87 87 87 grey34
|
||||||
|
89 89 89 gray35
|
||||||
|
89 89 89 grey35
|
||||||
|
92 92 92 gray36
|
||||||
|
92 92 92 grey36
|
||||||
|
94 94 94 gray37
|
||||||
|
94 94 94 grey37
|
||||||
|
97 97 97 gray38
|
||||||
|
97 97 97 grey38
|
||||||
|
99 99 99 gray39
|
||||||
|
99 99 99 grey39
|
||||||
|
102 102 102 gray40
|
||||||
|
102 102 102 grey40
|
||||||
|
105 105 105 gray41
|
||||||
|
105 105 105 grey41
|
||||||
|
107 107 107 gray42
|
||||||
|
107 107 107 grey42
|
||||||
|
110 110 110 gray43
|
||||||
|
110 110 110 grey43
|
||||||
|
112 112 112 gray44
|
||||||
|
112 112 112 grey44
|
||||||
|
115 115 115 gray45
|
||||||
|
115 115 115 grey45
|
||||||
|
117 117 117 gray46
|
||||||
|
117 117 117 grey46
|
||||||
|
120 120 120 gray47
|
||||||
|
120 120 120 grey47
|
||||||
|
122 122 122 gray48
|
||||||
|
122 122 122 grey48
|
||||||
|
125 125 125 gray49
|
||||||
|
125 125 125 grey49
|
||||||
|
127 127 127 gray50
|
||||||
|
127 127 127 grey50
|
||||||
|
130 130 130 gray51
|
||||||
|
130 130 130 grey51
|
||||||
|
133 133 133 gray52
|
||||||
|
133 133 133 grey52
|
||||||
|
135 135 135 gray53
|
||||||
|
135 135 135 grey53
|
||||||
|
138 138 138 gray54
|
||||||
|
138 138 138 grey54
|
||||||
|
140 140 140 gray55
|
||||||
|
140 140 140 grey55
|
||||||
|
143 143 143 gray56
|
||||||
|
143 143 143 grey56
|
||||||
|
145 145 145 gray57
|
||||||
|
145 145 145 grey57
|
||||||
|
148 148 148 gray58
|
||||||
|
148 148 148 grey58
|
||||||
|
150 150 150 gray59
|
||||||
|
150 150 150 grey59
|
||||||
|
153 153 153 gray60
|
||||||
|
153 153 153 grey60
|
||||||
|
156 156 156 gray61
|
||||||
|
156 156 156 grey61
|
||||||
|
158 158 158 gray62
|
||||||
|
158 158 158 grey62
|
||||||
|
161 161 161 gray63
|
||||||
|
161 161 161 grey63
|
||||||
|
163 163 163 gray64
|
||||||
|
163 163 163 grey64
|
||||||
|
166 166 166 gray65
|
||||||
|
166 166 166 grey65
|
||||||
|
168 168 168 gray66
|
||||||
|
168 168 168 grey66
|
||||||
|
171 171 171 gray67
|
||||||
|
171 171 171 grey67
|
||||||
|
173 173 173 gray68
|
||||||
|
173 173 173 grey68
|
||||||
|
176 176 176 gray69
|
||||||
|
176 176 176 grey69
|
||||||
|
179 179 179 gray70
|
||||||
|
179 179 179 grey70
|
||||||
|
181 181 181 gray71
|
||||||
|
181 181 181 grey71
|
||||||
|
184 184 184 gray72
|
||||||
|
184 184 184 grey72
|
||||||
|
186 186 186 gray73
|
||||||
|
186 186 186 grey73
|
||||||
|
189 189 189 gray74
|
||||||
|
189 189 189 grey74
|
||||||
|
191 191 191 gray75
|
||||||
|
191 191 191 grey75
|
||||||
|
194 194 194 gray76
|
||||||
|
194 194 194 grey76
|
||||||
|
196 196 196 gray77
|
||||||
|
196 196 196 grey77
|
||||||
|
199 199 199 gray78
|
||||||
|
199 199 199 grey78
|
||||||
|
201 201 201 gray79
|
||||||
|
201 201 201 grey79
|
||||||
|
204 204 204 gray80
|
||||||
|
204 204 204 grey80
|
||||||
|
207 207 207 gray81
|
||||||
|
207 207 207 grey81
|
||||||
|
209 209 209 gray82
|
||||||
|
209 209 209 grey82
|
||||||
|
212 212 212 gray83
|
||||||
|
212 212 212 grey83
|
||||||
|
214 214 214 gray84
|
||||||
|
214 214 214 grey84
|
||||||
|
217 217 217 gray85
|
||||||
|
217 217 217 grey85
|
||||||
|
219 219 219 gray86
|
||||||
|
219 219 219 grey86
|
||||||
|
222 222 222 gray87
|
||||||
|
222 222 222 grey87
|
||||||
|
224 224 224 gray88
|
||||||
|
224 224 224 grey88
|
||||||
|
227 227 227 gray89
|
||||||
|
227 227 227 grey89
|
||||||
|
229 229 229 gray90
|
||||||
|
229 229 229 grey90
|
||||||
|
232 232 232 gray91
|
||||||
|
232 232 232 grey91
|
||||||
|
235 235 235 gray92
|
||||||
|
235 235 235 grey92
|
||||||
|
237 237 237 gray93
|
||||||
|
237 237 237 grey93
|
||||||
|
240 240 240 gray94
|
||||||
|
240 240 240 grey94
|
||||||
|
242 242 242 gray95
|
||||||
|
242 242 242 grey95
|
||||||
|
245 245 245 gray96
|
||||||
|
245 245 245 grey96
|
||||||
|
247 247 247 gray97
|
||||||
|
247 247 247 grey97
|
||||||
|
250 250 250 gray98
|
||||||
|
250 250 250 grey98
|
||||||
|
252 252 252 gray99
|
||||||
|
252 252 252 grey99
|
||||||
|
255 255 255 gray100
|
||||||
|
255 255 255 grey100
|
||||||
|
169 169 169 dark grey
|
||||||
|
169 169 169 DarkGrey
|
||||||
|
169 169 169 dark gray
|
||||||
|
169 169 169 DarkGray
|
||||||
|
0 0 139 dark blue
|
||||||
|
0 0 139 DarkBlue
|
||||||
|
0 139 139 dark cyan
|
||||||
|
0 139 139 DarkCyan
|
||||||
|
139 0 139 dark magenta
|
||||||
|
139 0 139 DarkMagenta
|
||||||
|
139 0 0 dark red
|
||||||
|
139 0 0 DarkRed
|
||||||
|
144 238 144 light green
|
||||||
|
144 238 144 LightGreen
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
A utility to look up colors in the X11 rgb.txt color database
|
||||||
|
|
@ -37,3 +37,11 @@ IN: combinators.smart.tests
|
||||||
[
|
[
|
||||||
[ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
|
[ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Test nesting
|
||||||
|
: nested-smart-combo-test ( -- array )
|
||||||
|
[ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
|
||||||
|
|
||||||
|
\ nested-smart-combo-test must-infer
|
||||||
|
|
||||||
|
[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
|
||||||
|
|
@ -3,8 +3,8 @@
|
||||||
USING: namespaces make math math.order math.parser sequences accessors
|
USING: namespaces make math math.order math.parser sequences accessors
|
||||||
kernel kernel.private layouts assocs words summary arrays
|
kernel kernel.private layouts assocs words summary arrays
|
||||||
combinators classes.algebra alien alien.c-types alien.structs
|
combinators classes.algebra alien alien.c-types alien.structs
|
||||||
alien.strings alien.arrays sets libc continuations.private
|
alien.strings alien.arrays alien.complex sets libc
|
||||||
fry cpu.architecture
|
continuations.private fry cpu.architecture
|
||||||
compiler.errors
|
compiler.errors
|
||||||
compiler.alien
|
compiler.alien
|
||||||
compiler.cfg
|
compiler.cfg
|
||||||
|
|
|
||||||
|
|
@ -198,8 +198,8 @@ FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ;
|
||||||
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
|
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
|
||||||
|
|
||||||
[ 32.0 ] [
|
[ 32.0 ] [
|
||||||
{ 1.0 2.0 3.0 } >float-array underlying>>
|
{ 1.0 2.0 3.0 } >float-array
|
||||||
{ 4.0 5.0 6.0 } >float-array underlying>>
|
{ 4.0 5.0 6.0 } >float-array
|
||||||
ffi_test_23
|
ffi_test_23
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
@ -558,3 +558,10 @@ FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
|
||||||
: stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
|
: stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
|
||||||
|
|
||||||
[ ] [ stack-frame-bustage 2drop ] unit-test
|
[ ] [ stack-frame-bustage 2drop ] unit-test
|
||||||
|
|
||||||
|
FUNCTION: complex-float ffi_test_45 ( complex-float x, complex-double y ) ;
|
||||||
|
|
||||||
|
[ C{ 4.0 4.0 } ] [
|
||||||
|
C{ 1.0 2.0 }
|
||||||
|
C{ 1.5 1.0 } ffi_test_45
|
||||||
|
] unit-test
|
||||||
|
|
@ -65,7 +65,7 @@ M: postgresql-result-null summary ( obj -- str )
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: param-types ( statement -- seq )
|
: param-types ( statement -- seq )
|
||||||
in-params>> [ type>> type>oid ] uint-array{ } map-as underlying>> ;
|
in-params>> [ type>> type>oid ] uint-array{ } map-as ;
|
||||||
|
|
||||||
: malloc-byte-array/length ( byte-array -- alien length )
|
: malloc-byte-array/length ( byte-array -- alien length )
|
||||||
[ malloc-byte-array &free ] [ length ] bi ;
|
[ malloc-byte-array &free ] [ length ] bi ;
|
||||||
|
|
@ -91,11 +91,11 @@ M: postgresql-result-null summary ( obj -- str )
|
||||||
] 2map flip [
|
] 2map flip [
|
||||||
f f
|
f f
|
||||||
] [
|
] [
|
||||||
first2 [ >void*-array underlying>> ] [ >uint-array underlying>> ] bi*
|
first2 [ >void*-array ] [ >uint-array ] bi*
|
||||||
] if-empty ;
|
] if-empty ;
|
||||||
|
|
||||||
: param-formats ( statement -- seq )
|
: param-formats ( statement -- seq )
|
||||||
in-params>> [ type>> type>param-format ] uint-array{ } map-as underlying>> ;
|
in-params>> [ type>> type>param-format ] uint-array{ } map-as ;
|
||||||
|
|
||||||
: do-postgresql-bound-statement ( statement -- res )
|
: do-postgresql-bound-statement ( statement -- res )
|
||||||
[
|
[
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
! 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: farkup kernel peg peg.ebnf tools.test namespaces xml
|
USING: farkup kernel peg peg.ebnf tools.test namespaces xml
|
||||||
urls.encoding assocs xml.utilities xml.data ;
|
urls.encoding assocs xml.traversal xml.data ;
|
||||||
IN: farkup.tests
|
IN: farkup.tests
|
||||||
|
|
||||||
relative-link-prefix off
|
relative-link-prefix off
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays combinators io
|
USING: accessors arrays combinators io
|
||||||
io.streams.string kernel math namespaces peg peg.ebnf
|
io.streams.string kernel math namespaces peg peg.ebnf
|
||||||
sequences sequences.deep strings xml.entities xml.literals
|
sequences sequences.deep strings xml.entities xml.syntax
|
||||||
vectors splitting xmode.code2html urls.encoding xml.data
|
vectors splitting xmode.code2html urls.encoding xml.data
|
||||||
xml.writer ;
|
xml.writer ;
|
||||||
IN: farkup
|
IN: farkup
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,12 @@
|
||||||
IN: functors.tests
|
IN: functors.tests
|
||||||
USING: functors tools.test math words kernel ;
|
USING: functors tools.test math words kernel multiline parser
|
||||||
|
io.streams.string generic ;
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
||||||
FUNCTOR: define-box ( T -- )
|
FUNCTOR: define-box ( T -- )
|
||||||
|
|
||||||
B DEFINES ${T}-box
|
B DEFINES-CLASS ${T}-box
|
||||||
<B> DEFINES <${B}>
|
<B> DEFINES <${B}>
|
||||||
|
|
||||||
WHERE
|
WHERE
|
||||||
|
|
@ -63,3 +64,47 @@ WHERE
|
||||||
>>
|
>>
|
||||||
|
|
||||||
[ 4 ] [ 1 3 blah ] unit-test
|
[ 4 ] [ 1 3 blah ] unit-test
|
||||||
|
|
||||||
|
GENERIC: some-generic ( a -- b )
|
||||||
|
|
||||||
|
! Does replacing an ordinary word with a functor-generated one work?
|
||||||
|
[ [ ] ] [
|
||||||
|
<" IN: functors.tests
|
||||||
|
|
||||||
|
TUPLE: some-tuple ;
|
||||||
|
: some-word ( -- ) ;
|
||||||
|
M: some-tuple some-generic ;
|
||||||
|
"> <string-reader> "functors-test" parse-stream
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
: test-redefinition ( -- )
|
||||||
|
[ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
|
||||||
|
[ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
|
||||||
|
[ t ] [
|
||||||
|
"some-tuple" "functors.tests" lookup
|
||||||
|
"some-generic" "functors.tests" lookup method >boolean
|
||||||
|
] unit-test ;
|
||||||
|
|
||||||
|
test-redefinition
|
||||||
|
|
||||||
|
FUNCTOR: redefine-test ( W -- )
|
||||||
|
|
||||||
|
W-word DEFINES ${W}-word
|
||||||
|
W-tuple DEFINES-CLASS ${W}-tuple
|
||||||
|
W-generic IS ${W}-generic
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
TUPLE: W-tuple ;
|
||||||
|
: W-word ( -- ) ;
|
||||||
|
M: W-tuple W-generic ;
|
||||||
|
|
||||||
|
;FUNCTOR
|
||||||
|
|
||||||
|
[ [ ] ] [
|
||||||
|
<" IN: functors.tests
|
||||||
|
<< "some" redefine-test >>
|
||||||
|
"> <string-reader> "functors-test" parse-stream
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
test-redefinition
|
||||||
|
|
@ -3,8 +3,9 @@
|
||||||
USING: kernel quotations classes.tuple make combinators generic
|
USING: kernel quotations classes.tuple make combinators generic
|
||||||
words interpolate namespaces sequences io.streams.string fry
|
words interpolate namespaces sequences io.streams.string fry
|
||||||
classes.mixin effects lexer parser classes.tuple.parser
|
classes.mixin effects lexer parser classes.tuple.parser
|
||||||
effects.parser locals.types locals.parser
|
effects.parser locals.types locals.parser generic.parser
|
||||||
locals.rewrite.closures vocabs.parser arrays accessors ;
|
locals.rewrite.closures vocabs.parser classes.parser
|
||||||
|
arrays accessors ;
|
||||||
IN: functors
|
IN: functors
|
||||||
|
|
||||||
! This is a hack
|
! This is a hack
|
||||||
|
|
@ -29,7 +30,7 @@ M: object >fake-quotations ;
|
||||||
GENERIC: fake-quotations> ( fake -- quot )
|
GENERIC: fake-quotations> ( fake -- quot )
|
||||||
|
|
||||||
M: fake-quotation fake-quotations>
|
M: fake-quotation fake-quotations>
|
||||||
seq>> [ fake-quotations> ] map >quotation ;
|
seq>> [ fake-quotations> ] [ ] map-as ;
|
||||||
|
|
||||||
M: array fake-quotations> [ fake-quotations> ] map ;
|
M: array fake-quotations> [ fake-quotations> ] map ;
|
||||||
|
|
||||||
|
|
@ -57,7 +58,7 @@ M: object fake-quotations> ;
|
||||||
effect off
|
effect off
|
||||||
scan-param parsed
|
scan-param parsed
|
||||||
scan-param parsed
|
scan-param parsed
|
||||||
\ create-method parsed
|
\ create-method-in parsed
|
||||||
parse-definition*
|
parse-definition*
|
||||||
DEFINE* ; parsing
|
DEFINE* ; parsing
|
||||||
|
|
||||||
|
|
@ -96,6 +97,8 @@ PRIVATE>
|
||||||
|
|
||||||
: DEFINES [ create-in ] (INTERPOLATE) ; parsing
|
: DEFINES [ create-in ] (INTERPOLATE) ; parsing
|
||||||
|
|
||||||
|
: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; parsing
|
||||||
|
|
||||||
DEFER: ;FUNCTOR delimiter
|
DEFER: ;FUNCTOR delimiter
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
||||||
|
|
@ -7,8 +7,8 @@ xml
|
||||||
xml.data
|
xml.data
|
||||||
xml.entities
|
xml.entities
|
||||||
xml.writer
|
xml.writer
|
||||||
xml.utilities
|
xml.traversal
|
||||||
xml.literals
|
xml.syntax
|
||||||
html.components
|
html.components
|
||||||
html.elements
|
html.elements
|
||||||
html.forms
|
html.forms
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ io.files io.files.temp io.directories html.streams help kernel
|
||||||
assocs sequences make words accessors arrays help.topics vocabs
|
assocs sequences make words accessors arrays help.topics vocabs
|
||||||
tools.vocabs tools.vocabs.browser namespaces prettyprint io
|
tools.vocabs tools.vocabs.browser namespaces prettyprint io
|
||||||
vocabs.loader serialize fry memoize unicode.case math.order
|
vocabs.loader serialize fry memoize unicode.case math.order
|
||||||
sorting debugger html xml.literals xml.writer ;
|
sorting debugger html xml.syntax xml.writer ;
|
||||||
IN: help.html
|
IN: help.html
|
||||||
|
|
||||||
: escape-char ( ch -- )
|
: escape-char ( ch -- )
|
||||||
|
|
|
||||||
|
|
@ -100,6 +100,6 @@ $nl
|
||||||
{ $subsection farkup }
|
{ $subsection farkup }
|
||||||
"Creating custom components:"
|
"Creating custom components:"
|
||||||
{ $subsection render* }
|
{ $subsection render* }
|
||||||
"Custom components can emit HTML using the " { $vocab-link "xml.literals" } " vocabulary." ;
|
"Custom components can emit HTML using the " { $vocab-link "xml.syntax" } " vocabulary." ;
|
||||||
|
|
||||||
ABOUT: "html.components"
|
ABOUT: "html.components"
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ USING: accessors kernel namespaces io math.parser assocs classes
|
||||||
classes.tuple words arrays sequences splitting mirrors
|
classes.tuple words arrays sequences splitting mirrors
|
||||||
hashtables combinators continuations math strings inspector
|
hashtables combinators continuations math strings inspector
|
||||||
fry locals calendar calendar.format xml.entities xml.data
|
fry locals calendar calendar.format xml.entities xml.data
|
||||||
validators urls present xml.writer xml.literals xml
|
validators urls present xml.writer xml.syntax xml
|
||||||
xmode.code2html lcs.diff2html farkup io.streams.string
|
xmode.code2html lcs.diff2html farkup io.streams.string
|
||||||
html html.streams html.forms ;
|
html html.streams html.forms ;
|
||||||
IN: html.components
|
IN: html.components
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io io.styles kernel namespaces prettyprint quotations
|
USING: io io.styles kernel namespaces prettyprint quotations
|
||||||
sequences strings words xml.entities compiler.units effects
|
sequences strings words xml.entities compiler.units effects
|
||||||
xml.data xml.literals urls math math.parser combinators
|
xml.data urls math math.parser combinators
|
||||||
present fry io.streams.string xml.writer html ;
|
present fry io.streams.string xml.writer html ;
|
||||||
IN: html.elements
|
IN: html.elements
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel accessors strings namespaces assocs hashtables io
|
USING: kernel accessors strings namespaces assocs hashtables io
|
||||||
mirrors math fry sequences words continuations
|
mirrors math fry sequences words continuations
|
||||||
xml.entities xml.writer xml.literals ;
|
xml.entities xml.writer xml.syntax ;
|
||||||
IN: html.forms
|
IN: html.forms
|
||||||
|
|
||||||
TUPLE: form errors values validation-failed ;
|
TUPLE: form errors values validation-failed ;
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
|
! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
|
||||||
! Slava Pestov.
|
! Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel xml.data xml.writer xml.literals urls.encoding ;
|
USING: kernel xml.data xml.writer xml.syntax urls.encoding ;
|
||||||
IN: html
|
IN: html
|
||||||
|
|
||||||
: simple-page ( title head body -- xml )
|
: simple-page ( title head body -- xml )
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel assocs io io.styles math math.order math.parser
|
USING: accessors kernel assocs io io.styles math math.order math.parser
|
||||||
sequences strings make words combinators macros xml.literals html fry
|
sequences strings make words combinators macros xml.syntax html fry
|
||||||
destructors ;
|
destructors ;
|
||||||
IN: html.streams
|
IN: html.streams
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ namespaces make classes.tuple assocs splitting words arrays io
|
||||||
io.files io.files.info io.encodings.utf8 io.streams.string
|
io.files io.files.info io.encodings.utf8 io.streams.string
|
||||||
unicode.case mirrors math urls present multiline quotations xml
|
unicode.case mirrors math urls present multiline quotations xml
|
||||||
logging continuations
|
logging continuations
|
||||||
xml.data xml.writer xml.literals strings
|
xml.data xml.writer xml.syntax strings
|
||||||
html.forms
|
html.forms
|
||||||
html
|
html
|
||||||
html.elements
|
html.elements
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ USING: accessors kernel sequences combinators kernel namespaces
|
||||||
classes.tuple assocs splitting words arrays memoize parser lexer
|
classes.tuple assocs splitting words arrays memoize parser lexer
|
||||||
io io.files io.encodings.utf8 io.streams.string
|
io io.files io.encodings.utf8 io.streams.string
|
||||||
unicode.case mirrors fry math urls
|
unicode.case mirrors fry math urls
|
||||||
multiline xml xml.data xml.writer xml.utilities
|
multiline xml xml.data xml.writer xml.syntax
|
||||||
html.components
|
html.components
|
||||||
html.templates ;
|
html.templates ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors kernel fry io io.encodings.utf8 io.files
|
USING: accessors kernel fry io io.encodings.utf8 io.files
|
||||||
debugger prettyprint continuations namespaces boxes sequences
|
debugger prettyprint continuations namespaces boxes sequences
|
||||||
arrays strings html io.streams.string
|
arrays strings html io.streams.string
|
||||||
quotations xml.data xml.writer xml.literals ;
|
quotations xml.data xml.writer xml.syntax ;
|
||||||
IN: html.templates
|
IN: html.templates
|
||||||
|
|
||||||
MIXIN: template
|
MIXIN: template
|
||||||
|
|
|
||||||
|
|
@ -299,7 +299,7 @@ test-db [
|
||||||
[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
|
[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
|
||||||
|
|
||||||
USING: html.components html.forms
|
USING: html.components html.forms
|
||||||
xml xml.utilities validators
|
xml xml.traversal validators
|
||||||
furnace furnace.conversations ;
|
furnace furnace.conversations ;
|
||||||
|
|
||||||
SYMBOL: a
|
SYMBOL: a
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: math.parser http accessors kernel xml.literals xml.writer
|
USING: math.parser http accessors kernel xml.syntax xml.writer
|
||||||
io io.streams.string io.encodings.utf8 ;
|
io io.streams.string io.encodings.utf8 ;
|
||||||
IN: http.server.responses
|
IN: http.server.responses
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ USING: calendar kernel math math.order math.parser namespaces
|
||||||
parser sequences strings assocs hashtables debugger mime.types
|
parser sequences strings assocs hashtables debugger mime.types
|
||||||
sorting logging calendar.format accessors splitting io io.files
|
sorting logging calendar.format accessors splitting io io.files
|
||||||
io.files.info io.directories io.pathnames io.encodings.binary
|
io.files.info io.directories io.pathnames io.encodings.binary
|
||||||
fry xml.entities destructors urls html xml.literals
|
fry xml.entities destructors urls html xml.syntax
|
||||||
html.templates.fhtml http http.server http.server.responses
|
html.templates.fhtml http http.server http.server.responses
|
||||||
http.server.redirection xml.writer ;
|
http.server.redirection xml.writer ;
|
||||||
IN: http.server.static
|
IN: http.server.static
|
||||||
|
|
|
||||||
|
|
@ -71,6 +71,9 @@ C: <nil> nil
|
||||||
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
|
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
|
||||||
[ ] [ 3 [ _ ] undo ] unit-test
|
[ ] [ 3 [ _ ] undo ] unit-test
|
||||||
|
|
||||||
|
[ 2.0 ] [ 2 3 ^ [ 3 ^ ] undo ] unit-test
|
||||||
|
[ 3.0 ] [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
|
||||||
|
|
||||||
[ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
|
[ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
|
||||||
[ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
|
[ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
|
||||||
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
|
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
|
||||||
|
|
@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
|
||||||
continuations debugger classes.tuple namespaces make vectors
|
continuations debugger classes.tuple namespaces make vectors
|
||||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||||
sequences.private combinators mirrors splitting
|
sequences.private combinators mirrors splitting
|
||||||
combinators.short-circuit fry words.symbol ;
|
combinators.short-circuit fry words.symbol generalizations ;
|
||||||
RENAME: _ fry => __
|
RENAME: _ fry => __
|
||||||
IN: inverse
|
IN: inverse
|
||||||
|
|
||||||
|
|
@ -163,7 +163,7 @@ ERROR: missing-literal ;
|
||||||
\ - [ + ] [ - ] define-math-inverse
|
\ - [ + ] [ - ] define-math-inverse
|
||||||
\ * [ / ] [ / ] define-math-inverse
|
\ * [ / ] [ / ] define-math-inverse
|
||||||
\ / [ * ] [ / ] define-math-inverse
|
\ / [ * ] [ / ] define-math-inverse
|
||||||
\ ^ [ recip ^ ] [ [ log ] bi@ / ] define-math-inverse
|
\ ^ [ recip ^ ] [ swap [ log ] bi@ / ] define-math-inverse
|
||||||
|
|
||||||
\ ? 2 [
|
\ ? 2 [
|
||||||
[ assert-literal ] bi@
|
[ assert-literal ] bi@
|
||||||
|
|
@ -199,6 +199,7 @@ DEFER: _
|
||||||
\ 2array [ 2 assure-length first2 ] define-inverse
|
\ 2array [ 2 assure-length first2 ] define-inverse
|
||||||
\ 3array [ 3 assure-length first3 ] define-inverse
|
\ 3array [ 3 assure-length first3 ] define-inverse
|
||||||
\ 4array [ 4 assure-length first4 ] define-inverse
|
\ 4array [ 4 assure-length first4 ] define-inverse
|
||||||
|
\ narray 1 [ [ firstn ] curry ] define-pop-inverse
|
||||||
|
|
||||||
\ first [ 1array ] define-inverse
|
\ first [ 1array ] define-inverse
|
||||||
\ first2 [ 2array ] define-inverse
|
\ first2 [ 2array ] define-inverse
|
||||||
|
|
@ -51,7 +51,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
|
||||||
] [ 2drop f ] if ;
|
] [ 2drop f ] if ;
|
||||||
|
|
||||||
: wait-event ( mx us -- n )
|
: wait-event ( mx us -- n )
|
||||||
[ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
|
[ [ fd>> ] [ events>> ] bi dup length ] [ 1000 /i ] bi*
|
||||||
epoll_wait multiplexer-error ;
|
epoll_wait multiplexer-error ;
|
||||||
|
|
||||||
: handle-event ( event mx -- )
|
: handle-event ( event mx -- )
|
||||||
|
|
|
||||||
|
|
@ -59,7 +59,7 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
|
||||||
: wait-kevent ( mx timespec -- n )
|
: wait-kevent ( mx timespec -- n )
|
||||||
[
|
[
|
||||||
[ fd>> f 0 ]
|
[ fd>> f 0 ]
|
||||||
[ events>> [ underlying>> ] [ length ] bi ] bi
|
[ events>> dup length ] bi
|
||||||
] dip kevent multiplexer-error ;
|
] dip kevent multiplexer-error ;
|
||||||
|
|
||||||
: handle-kevent ( mx kevent -- )
|
: handle-kevent ( mx kevent -- )
|
||||||
|
|
|
||||||
|
|
@ -44,8 +44,8 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
|
||||||
|
|
||||||
: init-fdsets ( mx -- nfds read write except )
|
: init-fdsets ( mx -- nfds read write except )
|
||||||
[ num-fds ]
|
[ num-fds ]
|
||||||
[ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ]
|
[ read-fdset/tasks [ init-fdset ] keep ]
|
||||||
[ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
|
[ write-fdset/tasks [ init-fdset ] keep ] tri
|
||||||
f ;
|
f ;
|
||||||
|
|
||||||
M:: select-mx wait-for-events ( us mx -- )
|
M:: select-mx wait-for-events ( us mx -- )
|
||||||
|
|
|
||||||
|
|
@ -103,7 +103,7 @@ TUPLE: CreateProcess-args
|
||||||
over get-environment
|
over get-environment
|
||||||
[ swap % "=" % % "\0" % ] assoc-each
|
[ swap % "=" % % "\0" % ] assoc-each
|
||||||
"\0" %
|
"\0" %
|
||||||
] ushort-array{ } make underlying>>
|
] ushort-array{ } make
|
||||||
>>lpEnvironment
|
>>lpEnvironment
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
|
|
@ -158,7 +158,7 @@ M: windows kill-process* ( handle -- )
|
||||||
M: windows wait-for-processes ( -- ? )
|
M: windows wait-for-processes ( -- ? )
|
||||||
processes get keys dup
|
processes get keys dup
|
||||||
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
|
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
|
||||||
[ length ] [ underlying>> ] bi 0 0
|
[ length ] keep 0 0
|
||||||
WaitForMultipleObjects
|
WaitForMultipleObjects
|
||||||
dup HEX: ffffffff = [ win32-error ] when
|
dup HEX: ffffffff = [ win32-error ] when
|
||||||
dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;
|
dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;
|
||||||
|
|
|
||||||
|
|
@ -7,5 +7,5 @@ QUALIFIED: io.pipes
|
||||||
|
|
||||||
M: unix io.pipes:(pipe) ( -- pair )
|
M: unix io.pipes:(pipe) ( -- pair )
|
||||||
2 <int-array>
|
2 <int-array>
|
||||||
[ underlying>> pipe io-error ]
|
[ pipe io-error ]
|
||||||
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;
|
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov
|
! Copyright (C) 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: lcs xml.literals xml.writer kernel strings ;
|
USING: lcs xml.syntax xml.writer kernel strings ;
|
||||||
FROM: accessors => item>> ;
|
FROM: accessors => item>> ;
|
||||||
FROM: io => write ;
|
FROM: io => write ;
|
||||||
FROM: sequences => each if-empty when-empty map ;
|
FROM: sequences => each if-empty when-empty map ;
|
||||||
|
|
|
||||||
|
|
@ -75,14 +75,14 @@ PRIVATE>
|
||||||
dup add-malloc ;
|
dup add-malloc ;
|
||||||
|
|
||||||
: realloc ( alien size -- newalien )
|
: realloc ( alien size -- newalien )
|
||||||
|
[ >c-ptr ] dip
|
||||||
over malloc-exists? [ realloc-error ] unless
|
over malloc-exists? [ realloc-error ] unless
|
||||||
dupd (realloc) check-ptr
|
dupd (realloc) check-ptr
|
||||||
swap delete-malloc
|
swap delete-malloc
|
||||||
dup add-malloc ;
|
dup add-malloc ;
|
||||||
|
|
||||||
: free ( alien -- )
|
: free ( alien -- )
|
||||||
dup delete-malloc
|
>c-ptr [ delete-malloc ] [ (free) ] bi ;
|
||||||
(free) ;
|
|
||||||
|
|
||||||
: memcpy ( dst src size -- )
|
: memcpy ( dst src size -- )
|
||||||
"void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
|
"void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
|
||||||
|
|
|
||||||
|
|
@ -256,7 +256,7 @@ XGEMM IS cblas_${T}gemm
|
||||||
XGERU IS cblas_${T}ger${U}
|
XGERU IS cblas_${T}ger${U}
|
||||||
XGERC IS cblas_${T}ger${C}
|
XGERC IS cblas_${T}ger${C}
|
||||||
|
|
||||||
MATRIX DEFINES ${TYPE}-blas-matrix
|
MATRIX DEFINES-CLASS ${TYPE}-blas-matrix
|
||||||
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
<MATRIX> DEFINES <${TYPE}-blas-matrix>
|
||||||
>MATRIX DEFINES >${TYPE}-blas-matrix
|
>MATRIX DEFINES >${TYPE}-blas-matrix
|
||||||
XMATRIX{ DEFINES ${T}matrix{
|
XMATRIX{ DEFINES ${T}matrix{
|
||||||
|
|
|
||||||
|
|
@ -134,7 +134,7 @@ XCOPY IS cblas_${T}copy
|
||||||
XSWAP IS cblas_${T}swap
|
XSWAP IS cblas_${T}swap
|
||||||
IXAMAX IS cblas_i${T}amax
|
IXAMAX IS cblas_i${T}amax
|
||||||
|
|
||||||
VECTOR DEFINES ${TYPE}-blas-vector
|
VECTOR DEFINES-CLASS ${TYPE}-blas-vector
|
||||||
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
<VECTOR> DEFINES <${TYPE}-blas-vector>
|
||||||
>VECTOR DEFINES >${TYPE}-blas-vector
|
>VECTOR DEFINES >${TYPE}-blas-vector
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -99,7 +99,7 @@ ERROR: end-of-stream multipart ;
|
||||||
dup name>> empty-name? [
|
dup name>> empty-name? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
[ [ header>> ] [ name>> unquote ] [ name-content>> ] tri mime-variable boa ]
|
[ name-content>> ]
|
||||||
[ name>> unquote ]
|
[ name>> unquote ]
|
||||||
[ mime-parts>> set-at ] tri
|
[ mime-parts>> set-at ] tri
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
||||||
|
|
@ -53,16 +53,16 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
||||||
glMatrixMode glPopMatrix ; inline
|
glMatrixMode glPopMatrix ; inline
|
||||||
|
|
||||||
: gl-material ( face pname params -- )
|
: gl-material ( face pname params -- )
|
||||||
float-array{ } like underlying>> glMaterialfv ;
|
float-array{ } like glMaterialfv ;
|
||||||
|
|
||||||
: gl-vertex-pointer ( seq -- )
|
: gl-vertex-pointer ( seq -- )
|
||||||
[ 2 GL_FLOAT 0 ] dip underlying>> glVertexPointer ; inline
|
[ 2 GL_FLOAT 0 ] dip glVertexPointer ; inline
|
||||||
|
|
||||||
: gl-color-pointer ( seq -- )
|
: gl-color-pointer ( seq -- )
|
||||||
[ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
|
[ 4 GL_FLOAT 0 ] dip glColorPointer ; inline
|
||||||
|
|
||||||
: gl-texture-coord-pointer ( seq -- )
|
: gl-texture-coord-pointer ( seq -- )
|
||||||
[ 2 GL_FLOAT 0 ] dip underlying>> glTexCoordPointer ; inline
|
[ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
|
||||||
|
|
||||||
: line-vertices ( a b -- )
|
: line-vertices ( a b -- )
|
||||||
[ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
|
[ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
|
||||||
|
|
@ -177,7 +177,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
||||||
glActiveTexture swap glBindTexture gl-error ;
|
glActiveTexture swap glBindTexture gl-error ;
|
||||||
|
|
||||||
: (set-draw-buffers) ( buffers -- )
|
: (set-draw-buffers) ( buffers -- )
|
||||||
[ length ] [ >uint-array underlying>> ] bi glDrawBuffers ;
|
[ length ] [ >uint-array ] bi glDrawBuffers ;
|
||||||
|
|
||||||
MACRO: set-draw-buffers ( buffers -- )
|
MACRO: set-draw-buffers ( buffers -- )
|
||||||
words>values [ (set-draw-buffers) ] curry ;
|
words>values [ (set-draw-buffers) ] curry ;
|
||||||
|
|
|
||||||
|
|
@ -96,7 +96,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
|
||||||
dup gl-program-shaders-length
|
dup gl-program-shaders-length
|
||||||
0 <int>
|
0 <int>
|
||||||
over <uint-array>
|
over <uint-array>
|
||||||
[ underlying>> glGetAttachedShaders ] keep ;
|
[ glGetAttachedShaders ] keep ;
|
||||||
|
|
||||||
: delete-gl-program-only ( program -- )
|
: delete-gl-program-only ( program -- )
|
||||||
glDeleteProgram ; inline
|
glDeleteProgram ; inline
|
||||||
|
|
|
||||||
|
|
@ -31,7 +31,7 @@ ERROR: roman-range-error n ;
|
||||||
] 2each drop ;
|
] 2each drop ;
|
||||||
|
|
||||||
: (roman>) ( seq -- n )
|
: (roman>) ( seq -- n )
|
||||||
dup [ roman>n ] map swap all-eq? [
|
[ [ roman>n ] map ] [ all-eq? ] bi [
|
||||||
sum
|
sum
|
||||||
] [
|
] [
|
||||||
first2 swap -
|
first2 swap -
|
||||||
|
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
USING: sequences.next tools.test arrays kernel math sequences ;
|
|
||||||
|
|
||||||
[ { { 1 0 } { 2 1 } { f 2 } } ] [ 3 [ 2array ] map-next ] unit-test
|
|
||||||
|
|
||||||
[ 8 ] [ 3 [ 1+ ] map 0 swap [ swap [ + + ] [ drop ] if* ] each-next ] unit-test
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
USING: kernel sequences sequences.private math ;
|
|
||||||
IN: sequences.next
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: iterate-seq ( seq quot -- i seq quot )
|
|
||||||
[ [ length ] keep ] dip ; inline
|
|
||||||
|
|
||||||
: (map-next) ( i seq quot -- )
|
|
||||||
! this uses O(n) more bounds checks than is really necessary
|
|
||||||
[ [ [ 1+ ] dip ?nth ] 2keep nth-unsafe ] dip call ; inline
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: each-next ( seq quot: ( next-elt elt -- ) -- )
|
|
||||||
iterate-seq [ (map-next) ] 2curry each-integer ; inline
|
|
||||||
|
|
||||||
: map-next ( seq quot: ( next-elt elt -- newelt ) -- newseq )
|
|
||||||
over dup length swap new-sequence [
|
|
||||||
iterate-seq [ (map-next) ] 2curry
|
|
||||||
] dip [ collect ] keep ; inline
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Iteration with access to next element
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
collections
|
|
||||||
|
|
@ -11,7 +11,7 @@ A' IS ${T}-array
|
||||||
>A' IS >${T}-array
|
>A' IS >${T}-array
|
||||||
<A'> IS <${A'}>
|
<A'> IS <${A'}>
|
||||||
|
|
||||||
A DEFINES direct-${T}-array
|
A DEFINES-CLASS direct-${T}-array
|
||||||
<A> DEFINES <${A}>
|
<A> DEFINES <${A}>
|
||||||
|
|
||||||
NTH [ T dup c-getter array-accessor ]
|
NTH [ T dup c-getter array-accessor ]
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,7 @@ M: bad-byte-array-length summary
|
||||||
|
|
||||||
FUNCTOR: define-array ( T -- )
|
FUNCTOR: define-array ( T -- )
|
||||||
|
|
||||||
A DEFINES ${T}-array
|
A DEFINES-CLASS ${T}-array
|
||||||
<A> DEFINES <${A}>
|
<A> DEFINES <${A}>
|
||||||
(A) DEFINES (${A})
|
(A) DEFINES (${A})
|
||||||
>A DEFINES >${A}
|
>A DEFINES >${A}
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,8 @@
|
||||||
IN: specialized-arrays.tests
|
IN: specialized-arrays.tests
|
||||||
USING: tools.test specialized-arrays sequences
|
USING: tools.test specialized-arrays sequences
|
||||||
specialized-arrays.int specialized-arrays.bool
|
specialized-arrays.int specialized-arrays.bool
|
||||||
specialized-arrays.ushort alien.c-types accessors kernel ;
|
specialized-arrays.ushort alien.c-types accessors kernel
|
||||||
|
specialized-arrays.direct.int arrays ;
|
||||||
|
|
||||||
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
||||||
|
|
||||||
|
|
@ -16,3 +17,7 @@ specialized-arrays.ushort alien.c-types accessors kernel ;
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ B{ 210 4 1 } byte-array>ushort-array ] must-fail
|
[ B{ 210 4 1 } byte-array>ushort-array ] must-fail
|
||||||
|
|
||||||
|
[ { 3 1 3 3 7 } ] [
|
||||||
|
int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
|
||||||
|
] unit-test
|
||||||
|
|
@ -9,7 +9,7 @@ FUNCTOR: define-vector ( T -- )
|
||||||
A IS ${T}-array
|
A IS ${T}-array
|
||||||
<A> IS <${A}>
|
<A> IS <${A}>
|
||||||
|
|
||||||
V DEFINES ${T}-vector
|
V DEFINES-CLASS ${T}-vector
|
||||||
<V> DEFINES <${V}>
|
<V> DEFINES <${V}>
|
||||||
>V DEFINES >${V}
|
>V DEFINES >${V}
|
||||||
V{ DEFINES ${V}{
|
V{ DEFINES ${V}{
|
||||||
|
|
|
||||||
|
|
@ -42,3 +42,18 @@ C: <color> color
|
||||||
[ bad-new-test ] must-infer
|
[ bad-new-test ] must-infer
|
||||||
|
|
||||||
[ bad-new-test ] must-fail
|
[ bad-new-test ] must-fail
|
||||||
|
|
||||||
|
! Corner case if macro expansion calls 'infer', found by Doug
|
||||||
|
DEFER: smart-combo ( quot -- )
|
||||||
|
|
||||||
|
\ smart-combo [ infer [ ] curry ] 1 define-transform
|
||||||
|
|
||||||
|
[ [ "a" "b" "c" ] smart-combo ] must-infer
|
||||||
|
|
||||||
|
[ [ [ "a" "b" ] smart-combo "c" ] smart-combo ] must-infer
|
||||||
|
|
||||||
|
: very-smart-combo ( quot -- ) smart-combo ; inline
|
||||||
|
|
||||||
|
[ [ "a" "b" "c" ] very-smart-combo ] must-infer
|
||||||
|
|
||||||
|
[ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
|
||||||
|
|
|
||||||
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: fry accessors arrays kernel words sequences generic math
|
USING: fry accessors arrays kernel words sequences generic math
|
||||||
namespaces make quotations assocs combinators classes.tuple
|
namespaces make quotations assocs combinators classes.tuple
|
||||||
classes.tuple.private effects summary hashtables classes generic
|
classes.tuple.private effects summary hashtables classes generic
|
||||||
sets definitions generic.standard slots.private continuations
|
sets definitions generic.standard slots.private continuations locals
|
||||||
stack-checker.backend stack-checker.state stack-checker.visitor
|
stack-checker.backend stack-checker.state stack-checker.visitor
|
||||||
stack-checker.errors stack-checker.values
|
stack-checker.errors stack-checker.values
|
||||||
stack-checker.recursive-state ;
|
stack-checker.recursive-state ;
|
||||||
|
|
@ -15,48 +15,32 @@ IN: stack-checker.transforms
|
||||||
[ dup infer-word apply-word/effect ]
|
[ dup infer-word apply-word/effect ]
|
||||||
if ;
|
if ;
|
||||||
|
|
||||||
: ((apply-transform)) ( word quot values stack -- )
|
:: ((apply-transform)) ( word quot values stack rstate -- )
|
||||||
rot with-datastack first2
|
rstate recursive-state
|
||||||
dup [
|
[ stack quot with-datastack first ] with-variable
|
||||||
[
|
[
|
||||||
[ drop ]
|
word inlined-dependency depends-on
|
||||||
[ [ length meta-d shorten-by ] [ #drop, ] bi ] bi*
|
values [ length meta-d shorten-by ] [ #drop, ] bi
|
||||||
] 2dip
|
rstate infer-quot
|
||||||
swap infer-quot
|
] [ word give-up-transform ] if* ;
|
||||||
] [
|
|
||||||
3drop give-up-transform
|
|
||||||
] if ; inline
|
|
||||||
|
|
||||||
: (apply-transform) ( word quot n -- )
|
: (apply-transform) ( word quot n -- )
|
||||||
ensure-d dup [ known literal? ] all? [
|
ensure-d dup [ known literal? ] all? [
|
||||||
dup empty? [
|
dup empty? [ dup recursive-state get ] [
|
||||||
recursive-state get 1array
|
|
||||||
] [
|
|
||||||
[ ]
|
[ ]
|
||||||
[ [ literal value>> ] map ]
|
[ [ literal value>> ] map ]
|
||||||
[ first literal recursion>> ] tri
|
[ first literal recursion>> ] tri
|
||||||
prefix
|
|
||||||
] if
|
] if
|
||||||
((apply-transform))
|
((apply-transform))
|
||||||
] [ 2drop give-up-transform ] if ;
|
] [ 2drop give-up-transform ] if ;
|
||||||
|
|
||||||
: apply-transform ( word -- )
|
: apply-transform ( word -- )
|
||||||
[ inlined-dependency depends-on ] [
|
[ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
|
||||||
[ ]
|
(apply-transform) ;
|
||||||
[ "transform-quot" word-prop ]
|
|
||||||
[ "transform-n" word-prop ]
|
|
||||||
tri
|
|
||||||
(apply-transform)
|
|
||||||
] bi ;
|
|
||||||
|
|
||||||
: apply-macro ( word -- )
|
: apply-macro ( word -- )
|
||||||
[ inlined-dependency depends-on ] [
|
[ ] [ "macro" word-prop ] [ "declared-effect" word-prop in>> length ] tri
|
||||||
[ ]
|
(apply-transform) ;
|
||||||
[ "macro" word-prop ]
|
|
||||||
[ "declared-effect" word-prop in>> length ]
|
|
||||||
tri
|
|
||||||
(apply-transform)
|
|
||||||
] bi ;
|
|
||||||
|
|
||||||
: define-transform ( word quot n -- )
|
: define-transform ( word quot n -- )
|
||||||
[ drop "transform-quot" set-word-prop ]
|
[ drop "transform-quot" set-word-prop ]
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,7 @@ C-STRUCT: test-struct
|
||||||
[ 5/4 ] [
|
[ 5/4 ] [
|
||||||
[
|
[
|
||||||
2 "test-struct" malloc-struct-array
|
2 "test-struct" malloc-struct-array
|
||||||
dup underlying>> &free drop
|
dup &free drop
|
||||||
1 2 make-point over set-first
|
1 2 make-point over set-first
|
||||||
3 4 make-point over set-second
|
3 4 make-point over set-second
|
||||||
0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce
|
0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce
|
||||||
|
|
@ -34,6 +34,6 @@ C-STRUCT: test-struct
|
||||||
[ ] [
|
[ ] [
|
||||||
[
|
[
|
||||||
10 "test-struct" malloc-struct-array
|
10 "test-struct" malloc-struct-array
|
||||||
underlying>> &free drop
|
&free drop
|
||||||
] with-destructors
|
] with-destructors
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
|
! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
|
||||||
! Portions copyright (C) 2008 Slava Pestov.
|
! Portions copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml.utilities kernel assocs math.order
|
USING: xml.traversal kernel assocs math.order
|
||||||
strings sequences xml.data xml.writer
|
strings sequences xml.data xml.writer
|
||||||
io.streams.string combinators xml xml.entities.html io.files io
|
io.streams.string combinators xml xml.entities.html io.files io
|
||||||
http.client namespaces make xml.literals hashtables
|
http.client namespaces make xml.syntax hashtables
|
||||||
calendar.format accessors continuations urls present ;
|
calendar.format accessors continuations urls present ;
|
||||||
IN: syndication
|
IN: syndication
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Daniel Ehrenberg.
|
! Copyright (C) 2008 Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: unicode.data sequences sequences.next namespaces
|
USING: unicode.data sequences namespaces
|
||||||
sbufs make unicode.syntax unicode.normalize math hints
|
sbufs make unicode.syntax unicode.normalize math hints
|
||||||
unicode.categories combinators unicode.syntax assocs
|
unicode.categories combinators unicode.syntax assocs
|
||||||
strings splitting kernel accessors unicode.breaks fry locals ;
|
strings splitting kernel accessors unicode.breaks fry locals ;
|
||||||
|
|
|
||||||
|
|
@ -16,5 +16,5 @@ IN: unix.utilities
|
||||||
'[ [ advance ] [ *void* _ alien>string ] bi ]
|
'[ [ advance ] [ *void* _ alien>string ] bi ]
|
||||||
[ ] produce nip ;
|
[ ] produce nip ;
|
||||||
|
|
||||||
: strings>alien ( strings encoding -- alien )
|
: strings>alien ( strings encoding -- array )
|
||||||
'[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ;
|
'[ _ malloc-string ] void*-array{ } map-as f suffix ;
|
||||||
|
|
|
||||||
|
|
@ -132,7 +132,7 @@ unless
|
||||||
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
|
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
|
||||||
|
|
||||||
: (callbacks>vtbl) ( callbacks -- vtbl )
|
: (callbacks>vtbl) ( callbacks -- vtbl )
|
||||||
[ execute ] void*-array{ } map-as underlying>> malloc-byte-array ;
|
[ execute ] void*-array{ } map-as malloc-byte-array ;
|
||||||
: (callbacks>vtbls) ( callbacks -- vtbls )
|
: (callbacks>vtbls) ( callbacks -- vtbls )
|
||||||
[ (callbacks>vtbl) ] map ;
|
[ (callbacks>vtbl) ] map ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -59,7 +59,7 @@ SYMBOLS:
|
||||||
struct args <DIOBJECTDATAFORMAT>
|
struct args <DIOBJECTDATAFORMAT>
|
||||||
i alien set-nth
|
i alien set-nth
|
||||||
] each-index
|
] each-index
|
||||||
alien underlying>>
|
alien
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
: (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
|
: (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
|
||||||
|
|
|
||||||
|
|
@ -51,7 +51,7 @@ TUPLE: x-clipboard atom contents ;
|
||||||
"TARGETS" x-atom 32 PropModeReplace
|
"TARGETS" x-atom 32 PropModeReplace
|
||||||
{
|
{
|
||||||
"UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
|
"UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
|
||||||
} [ x-atom ] int-array{ } map-as underlying>>
|
} [ x-atom ] int-array{ } map-as
|
||||||
4 XChangeProperty drop ;
|
4 XChangeProperty drop ;
|
||||||
|
|
||||||
: set-timestamp-prop ( evt -- )
|
: set-timestamp-prop ( evt -- )
|
||||||
|
|
|
||||||
|
|
@ -93,7 +93,7 @@ FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
|
||||||
GLX_RGBA ,
|
GLX_RGBA ,
|
||||||
GLX_DEPTH_SIZE , 16 ,
|
GLX_DEPTH_SIZE , 16 ,
|
||||||
0 ,
|
0 ,
|
||||||
] int-array{ } make underlying>>
|
] int-array{ } make
|
||||||
glXChooseVisual
|
glXChooseVisual
|
||||||
[ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ;
|
[ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -50,7 +50,7 @@ SYMBOL: keysym
|
||||||
: lookup-string ( event xic -- string keysym )
|
: lookup-string ( event xic -- string keysym )
|
||||||
[
|
[
|
||||||
prepare-lookup
|
prepare-lookup
|
||||||
swap keybuf get underlying>> buf-size keysym get 0 <int>
|
swap keybuf get buf-size keysym get 0 <int>
|
||||||
XwcLookupString
|
XwcLookupString
|
||||||
finish-lookup
|
finish-lookup
|
||||||
] with-scope ;
|
] with-scope ;
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel xml arrays math generic http.client
|
USING: accessors kernel xml arrays math generic http.client
|
||||||
combinators hashtables namespaces io base64 sequences strings
|
combinators hashtables namespaces io base64 sequences strings
|
||||||
calendar xml.data xml.writer xml.utilities assocs math.parser
|
calendar xml.data xml.writer xml.traversal assocs math.parser
|
||||||
debugger calendar.format math.order xml.literals xml.dispatch ;
|
debugger calendar.format math.order xml.syntax ;
|
||||||
IN: xml-rpc
|
IN: xml-rpc
|
||||||
|
|
||||||
! * Sending RPC requests
|
! * Sending RPC requests
|
||||||
|
|
@ -113,14 +113,18 @@ M: server-error error.
|
||||||
"Description: " write dup message>> print
|
"Description: " write dup message>> print
|
||||||
"Tag: " write tag>> xml>string print ;
|
"Tag: " write tag>> xml>string print ;
|
||||||
|
|
||||||
PROCESS: xml>item ( tag -- object )
|
TAGS: xml>item ( tag -- object )
|
||||||
|
|
||||||
TAG: string xml>item
|
TAG: string xml>item
|
||||||
children>string ;
|
children>string ;
|
||||||
|
|
||||||
TAG: i4/int/double xml>item
|
: children>number ( tag -- n )
|
||||||
children>string string>number ;
|
children>string string>number ;
|
||||||
|
|
||||||
|
TAG: i4 xml>item children>number ;
|
||||||
|
TAG: int xml>item children>number ;
|
||||||
|
TAG: double xml>item children>number ;
|
||||||
|
|
||||||
TAG: boolean xml>item
|
TAG: boolean xml>item
|
||||||
dup children>string {
|
dup children>string {
|
||||||
{ [ dup "1" = ] [ 2drop t ] }
|
{ [ dup "1" = ] [ 2drop t ] }
|
||||||
|
|
@ -174,5 +178,5 @@ TAG: array xml>item
|
||||||
! This needs to do something in the event of an error
|
! This needs to do something in the event of an error
|
||||||
[ send-rpc ] dip http-post nip string>xml receive-rpc ;
|
[ send-rpc ] dip http-post nip string>xml receive-rpc ;
|
||||||
|
|
||||||
: invoke-method ( params method url -- )
|
: invoke-method ( params method url -- response )
|
||||||
[ swap <rpc-method> ] dip post-rpc ;
|
[ swap <rpc-method> ] dip post-rpc ;
|
||||||
|
|
|
||||||
|
|
@ -10,7 +10,7 @@ ARTICLE: "xml.data" "XML data types"
|
||||||
"Simple words for manipulating names:"
|
"Simple words for manipulating names:"
|
||||||
{ $subsection names-match? }
|
{ $subsection names-match? }
|
||||||
{ $subsection assure-name }
|
{ $subsection assure-name }
|
||||||
"For high-level tools for manipulating XML, see " { $vocab-link "xml.utilities" } ;
|
"For high-level tools for manipulating XML, see " { $vocab-link "xml.traversal" } ;
|
||||||
|
|
||||||
ARTICLE: { "xml.data" "classes" } "XML data classes"
|
ARTICLE: { "xml.data" "classes" } "XML data classes"
|
||||||
"XML documents and chunks are made of the following classes:"
|
"XML documents and chunks are made of the following classes:"
|
||||||
|
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: help.markup help.syntax ;
|
|
||||||
IN: xml.dispatch
|
|
||||||
|
|
||||||
ABOUT: "xml.dispatch"
|
|
||||||
|
|
||||||
ARTICLE: "xml.dispatch" "Dispatch on XML tag names"
|
|
||||||
"Two parsing words define a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
|
|
||||||
{ $subsection POSTPONE: PROCESS: }
|
|
||||||
"and to define a new 'method' for this word, use"
|
|
||||||
{ $subsection POSTPONE: TAG: } ;
|
|
||||||
|
|
||||||
HELP: PROCESS:
|
|
||||||
{ $syntax "PROCESS: word" }
|
|
||||||
{ $values { "word" "a new word to define" } }
|
|
||||||
{ $description "creates a new word to process XML tags" }
|
|
||||||
{ $see-also POSTPONE: TAG: } ;
|
|
||||||
|
|
||||||
HELP: TAG:
|
|
||||||
{ $syntax "TAG: tag word definition... ;" }
|
|
||||||
{ $values { "tag" "an xml tag name" } { "word" "an XML process" } }
|
|
||||||
{ $description "defines what a process should do when it encounters a specific tag" }
|
|
||||||
{ $examples { $code "PROCESS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
|
|
||||||
{ $see-also POSTPONE: PROCESS: } ;
|
|
||||||
|
|
@ -1,31 +0,0 @@
|
||||||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: xml io kernel math sequences strings xml.utilities
|
|
||||||
tools.test math.parser xml.dispatch ;
|
|
||||||
IN: xml.dispatch.tests
|
|
||||||
|
|
||||||
PROCESS: calculate ( tag -- n )
|
|
||||||
|
|
||||||
: calc-2children ( tag -- n n )
|
|
||||||
children-tags first2 [ calculate ] dip calculate ;
|
|
||||||
|
|
||||||
TAG: number calculate
|
|
||||||
children>string string>number ;
|
|
||||||
TAG: add calculate
|
|
||||||
calc-2children + ;
|
|
||||||
TAG: minus calculate
|
|
||||||
calc-2children - ;
|
|
||||||
TAG: times calculate
|
|
||||||
calc-2children * ;
|
|
||||||
TAG: divide calculate
|
|
||||||
calc-2children / ;
|
|
||||||
TAG: neg calculate
|
|
||||||
children-tags first calculate neg ;
|
|
||||||
|
|
||||||
: calc-arith ( string -- n )
|
|
||||||
string>xml first-child-tag calculate ;
|
|
||||||
|
|
||||||
[ 32 ] [
|
|
||||||
"<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
|
|
||||||
calc-arith
|
|
||||||
] unit-test
|
|
||||||
|
|
@ -1,27 +0,0 @@
|
||||||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: words assocs kernel accessors parser sequences summary
|
|
||||||
lexer splitting fry ;
|
|
||||||
IN: xml.dispatch
|
|
||||||
|
|
||||||
TUPLE: process-missing process tag ;
|
|
||||||
M: process-missing summary
|
|
||||||
drop "Tag not implemented on process" ;
|
|
||||||
|
|
||||||
: run-process ( tag word -- )
|
|
||||||
2dup "xtable" word-prop
|
|
||||||
[ dup main>> ] dip at* [ 2nip call ] [
|
|
||||||
drop \ process-missing boa throw
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: PROCESS:
|
|
||||||
CREATE
|
|
||||||
dup H{ } clone "xtable" set-word-prop
|
|
||||||
dup '[ _ run-process ] define ; parsing
|
|
||||||
|
|
||||||
: TAG:
|
|
||||||
scan scan-word
|
|
||||||
parse-definition
|
|
||||||
swap "xtable" word-prop
|
|
||||||
rot "/" split [ [ 2dup ] dip swap set-at ] each 2drop ;
|
|
||||||
parsing
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Daniel Ehrenberg
|
|
||||||
|
|
@ -1,60 +0,0 @@
|
||||||
USING: help.markup help.syntax present multiline xml.data ;
|
|
||||||
IN: xml.literals
|
|
||||||
|
|
||||||
ABOUT: "xml.literals"
|
|
||||||
|
|
||||||
ARTICLE: "xml.literals" "XML literals"
|
|
||||||
"The " { $vocab-link "xml.literals" } " vocabulary provides a convenient syntax for generating XML documents and chunks. It defines the following parsing words:"
|
|
||||||
{ $subsection POSTPONE: <XML }
|
|
||||||
{ $subsection POSTPONE: [XML }
|
|
||||||
"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
|
|
||||||
{ $subsection { "xml.literals" "interpolation" } } ;
|
|
||||||
|
|
||||||
HELP: <XML
|
|
||||||
{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
|
|
||||||
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
|
|
||||||
|
|
||||||
HELP: [XML
|
|
||||||
{ $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" }
|
|
||||||
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
|
|
||||||
|
|
||||||
ARTICLE: { "xml.literals" "interpolation" } "XML interpolation syntax"
|
|
||||||
"XML interpolation has two forms for each of the words " { $link POSTPONE: <XML } " and " { $link POSTPONE: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
|
|
||||||
$nl
|
|
||||||
"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
|
|
||||||
{ $example
|
|
||||||
{" USING: splitting sequences xml.writer xml.literals ;
|
|
||||||
"one two three" " " split
|
|
||||||
[ [XML <item><-></item> XML] ] map
|
|
||||||
<XML <doc><-></doc> XML> pprint-xml"}
|
|
||||||
{" <?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<doc>
|
|
||||||
<item>
|
|
||||||
one
|
|
||||||
</item>
|
|
||||||
<item>
|
|
||||||
two
|
|
||||||
</item>
|
|
||||||
<item>
|
|
||||||
three
|
|
||||||
</item>
|
|
||||||
</doc>"} }
|
|
||||||
"Here is an example of the locals version:"
|
|
||||||
{ $example
|
|
||||||
{" USING: locals urls xml.literals xml.writer ;
|
|
||||||
[let |
|
|
||||||
number [ 3 ]
|
|
||||||
false [ f ]
|
|
||||||
url [ URL" http://factorcode.org/" ]
|
|
||||||
string [ "hello" ]
|
|
||||||
word [ \ drop ] |
|
|
||||||
<XML
|
|
||||||
<x
|
|
||||||
number=<-number->
|
|
||||||
false=<-false->
|
|
||||||
url=<-url->
|
|
||||||
string=<-string->
|
|
||||||
word=<-word-> />
|
|
||||||
XML> pprint-xml ] "}
|
|
||||||
{" <?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} } ;
|
|
||||||
|
|
@ -1,68 +0,0 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: tools.test xml.literals multiline kernel assocs
|
|
||||||
sequences accessors xml.writer xml.literals.private
|
|
||||||
locals splitting urls xml.data classes ;
|
|
||||||
IN: xml.literals.tests
|
|
||||||
|
|
||||||
[ "a" "c" { "a" "c" f } ] [
|
|
||||||
"<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
|
|
||||||
string>doc
|
|
||||||
[ second var>> ]
|
|
||||||
[ fourth "val" attr var>> ]
|
|
||||||
[ extract-variables ] tri
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<x>
|
|
||||||
one
|
|
||||||
<b val="two"/>
|
|
||||||
y
|
|
||||||
<foo/>
|
|
||||||
</x>"} ] [
|
|
||||||
[let* | a [ "one" ] c [ "two" ] x [ "y" ]
|
|
||||||
d [ [XML <-x-> <foo/> XML] ] |
|
|
||||||
<XML
|
|
||||||
<x> <-a-> <b val=<-c->/> <-d-> </x>
|
|
||||||
XML> pprint-xml>string
|
|
||||||
]
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<doc>
|
|
||||||
<item>
|
|
||||||
one
|
|
||||||
</item>
|
|
||||||
<item>
|
|
||||||
two
|
|
||||||
</item>
|
|
||||||
<item>
|
|
||||||
three
|
|
||||||
</item>
|
|
||||||
</doc>"} ] [
|
|
||||||
"one two three" " " split
|
|
||||||
[ [XML <item><-></item> XML] ] map
|
|
||||||
<XML <doc><-></doc> XML> pprint-xml>string
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
|
|
||||||
[ 3 f URL" http://factorcode.org/" "hello" \ drop
|
|
||||||
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
|
|
||||||
pprint-xml>string ] unit-test
|
|
||||||
|
|
||||||
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
|
|
||||||
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
|
|
||||||
|
|
||||||
\ <XML must-infer
|
|
||||||
[ { } "" interpolate-xml ] must-infer
|
|
||||||
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
|
|
||||||
|
|
||||||
[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
|
|
||||||
[ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
|
|
||||||
[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
|
|
||||||
[ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
|
|
||||||
[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
|
|
||||||
[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
|
|
||||||
|
|
||||||
[ "" ] [ [XML XML] concat ] unit-test
|
|
||||||
|
|
@ -1,109 +0,0 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: xml xml.state kernel sequences fry assocs xml.data
|
|
||||||
accessors strings make multiline parser namespaces macros
|
|
||||||
sequences.deep generalizations words combinators
|
|
||||||
math present arrays unicode.categories ;
|
|
||||||
IN: xml.literals
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: string>chunk ( string -- chunk )
|
|
||||||
t interpolating? [ string>xml-chunk ] with-variable ;
|
|
||||||
|
|
||||||
: string>doc ( string -- xml )
|
|
||||||
t interpolating? [ string>xml ] with-variable ;
|
|
||||||
|
|
||||||
DEFER: interpolate-sequence
|
|
||||||
|
|
||||||
: interpolate-attrs ( table attrs -- attrs )
|
|
||||||
swap '[
|
|
||||||
dup interpolated?
|
|
||||||
[ var>> _ at dup [ present ] when ] when
|
|
||||||
] assoc-map [ nip ] assoc-filter ;
|
|
||||||
|
|
||||||
: interpolate-tag ( table tag -- tag )
|
|
||||||
[ nip name>> ]
|
|
||||||
[ attrs>> interpolate-attrs ]
|
|
||||||
[ children>> [ interpolate-sequence ] [ drop f ] if* ] 2tri
|
|
||||||
<tag> ;
|
|
||||||
|
|
||||||
GENERIC: push-item ( item -- )
|
|
||||||
M: string push-item , ;
|
|
||||||
M: xml-data push-item , ;
|
|
||||||
M: object push-item present , ;
|
|
||||||
M: sequence push-item
|
|
||||||
dup xml-data? [ , ] [ [ push-item ] each ] if ;
|
|
||||||
M: number push-item present , ;
|
|
||||||
M: xml-chunk push-item % ;
|
|
||||||
|
|
||||||
GENERIC: interpolate-item ( table item -- )
|
|
||||||
M: object interpolate-item nip , ;
|
|
||||||
M: tag interpolate-item interpolate-tag , ;
|
|
||||||
M: interpolated interpolate-item
|
|
||||||
var>> swap at push-item ;
|
|
||||||
|
|
||||||
: interpolate-sequence ( table seq -- seq )
|
|
||||||
[ [ interpolate-item ] with each ] { } make ;
|
|
||||||
|
|
||||||
: interpolate-xml-doc ( table xml -- xml )
|
|
||||||
(clone) [ interpolate-tag ] change-body ;
|
|
||||||
|
|
||||||
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
|
|
||||||
{
|
|
||||||
{ [ over interpolated? ] [ call ] }
|
|
||||||
{ [ over tag? ] [
|
|
||||||
[ attrs>> values [ interpolated? ] filter ] dip each
|
|
||||||
] }
|
|
||||||
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
|
|
||||||
[ 2drop ]
|
|
||||||
} cond ; inline recursive
|
|
||||||
|
|
||||||
: each-interpolated ( xml quot -- )
|
|
||||||
'[ _ (each-interpolated) ] deep-each ; inline
|
|
||||||
|
|
||||||
: number<-> ( doc -- dup )
|
|
||||||
0 over [
|
|
||||||
dup var>> [
|
|
||||||
over >>var [ 1+ ] dip
|
|
||||||
] unless drop
|
|
||||||
] each-interpolated drop ;
|
|
||||||
|
|
||||||
GENERIC: interpolate-xml ( table xml -- xml )
|
|
||||||
|
|
||||||
M: xml interpolate-xml
|
|
||||||
interpolate-xml-doc ;
|
|
||||||
|
|
||||||
M: xml-chunk interpolate-xml
|
|
||||||
interpolate-sequence <xml-chunk> ;
|
|
||||||
|
|
||||||
: >search-hash ( seq -- hash )
|
|
||||||
[ dup search ] H{ } map>assoc ;
|
|
||||||
|
|
||||||
: extract-variables ( xml -- seq )
|
|
||||||
[ [ var>> , ] each-interpolated ] { } make ;
|
|
||||||
|
|
||||||
: nenum ( ... n -- assoc )
|
|
||||||
narray <enum> ; inline
|
|
||||||
|
|
||||||
: collect ( accum variables -- accum ? )
|
|
||||||
{
|
|
||||||
{ [ dup empty? ] [ drop f ] } ! Just a literal
|
|
||||||
{ [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals
|
|
||||||
{ [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry
|
|
||||||
[ drop "XML interpolation contains both fry and locals" throw ] ! mixed
|
|
||||||
} cond ;
|
|
||||||
|
|
||||||
: parse-def ( accum delimiter quot -- accum )
|
|
||||||
[ parse-multiline-string [ blank? ] trim ] dip call
|
|
||||||
[ extract-variables collect ] keep swap
|
|
||||||
[ number<-> parsed ] dip
|
|
||||||
[ \ interpolate-xml parsed ] when ; inline
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: <XML
|
|
||||||
"XML>" [ string>doc ] parse-def ; parsing
|
|
||||||
|
|
||||||
: [XML
|
|
||||||
"XML]" [ string>chunk ] parse-def ; parsing
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Syntax for XML interpolation
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
syntax
|
|
||||||
enterprise
|
|
||||||
|
|
@ -0,0 +1,101 @@
|
||||||
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: help.markup help.syntax xml.data present multiline ;
|
||||||
|
IN: xml.syntax
|
||||||
|
|
||||||
|
ABOUT: "xml.syntax"
|
||||||
|
|
||||||
|
ARTICLE: "xml.syntax" "Syntax extensions for XML"
|
||||||
|
"The " { $link "xml.syntax" } " vocabulary defines a number of new parsing words forXML processing."
|
||||||
|
{ $subsection { "xml.syntax" "tags" } }
|
||||||
|
{ $subsection { "xml.syntax" "literals" } }
|
||||||
|
{ $subsection POSTPONE: XML-NS: } ;
|
||||||
|
|
||||||
|
ARTICLE: { "xml.syntax" "tags" } "Dispatch on XML tag names"
|
||||||
|
"There is a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
|
||||||
|
{ $subsection POSTPONE: TAGS: }
|
||||||
|
"and to define a new 'method' for this word, use"
|
||||||
|
{ $subsection POSTPONE: TAG: } ;
|
||||||
|
|
||||||
|
HELP: TAGS:
|
||||||
|
{ $syntax "TAGS: word" }
|
||||||
|
{ $values { "word" "a new word to define" } }
|
||||||
|
{ $description "Creates a new word to which dispatches on XML tag names." }
|
||||||
|
{ $see-also POSTPONE: TAG: } ;
|
||||||
|
|
||||||
|
HELP: TAG:
|
||||||
|
{ $syntax "TAG: tag word definition... ;" }
|
||||||
|
{ $values { "tag" "an XML tag name" } { "word" "an XML process" } }
|
||||||
|
{ $description "Defines a 'method' on a word created with " { $link POSTPONE: TAGS: } ". It determines what such a word should do for an argument that is has the given name." }
|
||||||
|
{ $examples { $code "TAGS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
|
||||||
|
{ $see-also POSTPONE: TAGS: } ;
|
||||||
|
|
||||||
|
ARTICLE: { "xml.syntax" "literals" } "XML literals"
|
||||||
|
"The following words provide syntax for XML literals:"
|
||||||
|
{ $subsection POSTPONE: <XML }
|
||||||
|
{ $subsection POSTPONE: [XML }
|
||||||
|
"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
|
||||||
|
{ $subsection { "xml.syntax" "interpolation" } } ;
|
||||||
|
|
||||||
|
HELP: <XML
|
||||||
|
{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
|
||||||
|
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
|
||||||
|
|
||||||
|
HELP: [XML
|
||||||
|
{ $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" }
|
||||||
|
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
|
||||||
|
|
||||||
|
ARTICLE: { "xml.syntax" "interpolation" } "XML interpolation syntax"
|
||||||
|
"XML interpolation has two forms for each of the words " { $link POSTPONE: <XML } " and " { $link POSTPONE: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
|
||||||
|
$nl
|
||||||
|
"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
|
||||||
|
{ $example
|
||||||
|
{" USING: splitting sequences xml.writer xml.syntax ;
|
||||||
|
"one two three" " " split
|
||||||
|
[ [XML <item><-></item> XML] ] map
|
||||||
|
<XML <doc><-></doc> XML> pprint-xml"}
|
||||||
|
{" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<doc>
|
||||||
|
<item>
|
||||||
|
one
|
||||||
|
</item>
|
||||||
|
<item>
|
||||||
|
two
|
||||||
|
</item>
|
||||||
|
<item>
|
||||||
|
three
|
||||||
|
</item>
|
||||||
|
</doc>"} }
|
||||||
|
"Here is an example of the locals version:"
|
||||||
|
{ $example
|
||||||
|
{" USING: locals urls xml.syntax xml.writer ;
|
||||||
|
[let |
|
||||||
|
number [ 3 ]
|
||||||
|
false [ f ]
|
||||||
|
url [ URL" http://factorcode.org/" ]
|
||||||
|
string [ "hello" ]
|
||||||
|
word [ \ drop ] |
|
||||||
|
<XML
|
||||||
|
<x
|
||||||
|
number=<-number->
|
||||||
|
false=<-false->
|
||||||
|
url=<-url->
|
||||||
|
string=<-string->
|
||||||
|
word=<-word-> />
|
||||||
|
XML> pprint-xml ] "}
|
||||||
|
{" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} }
|
||||||
|
"XML interpolation can also be used, in conjunction with " { $vocab-link "inverse" } " in pattern matching. For example:"
|
||||||
|
{ $example {" USING: sequences xml.syntax inverse ;
|
||||||
|
: dispatch ( xml -- string )
|
||||||
|
{
|
||||||
|
{ [ [XML <a><-></a> XML] ] [ "a" prepend ] }
|
||||||
|
{ [ [XML <b><-></b> XML] ] [ "b" prepend ] }
|
||||||
|
{ [ [XML <b val='yes'/> XML] ] [ "yes" ] }
|
||||||
|
{ [ [XML <b val=<->/> XML] ] [ "no" prepend ] }
|
||||||
|
} switch ;
|
||||||
|
[XML <a>pple</a> XML] dispatch write "} "apple" } ;
|
||||||
|
|
||||||
|
HELP: XML-NS:
|
||||||
|
{ $syntax "XML-NS: name http://url" }
|
||||||
|
{ $description "Defines a new word of the given name which constructs XML names in the namespace of the given URL. The names constructed are memoized." } ;
|
||||||
|
|
@ -0,0 +1,138 @@
|
||||||
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: xml io kernel math sequences strings xml.traversal
|
||||||
|
tools.test math.parser xml.syntax xml.data xml.syntax.private
|
||||||
|
accessors multiline locals inverse xml.writer splitting classes ;
|
||||||
|
IN: xml.syntax.tests
|
||||||
|
|
||||||
|
! TAGS test
|
||||||
|
|
||||||
|
TAGS: calculate ( tag -- n )
|
||||||
|
|
||||||
|
: calc-2children ( tag -- n n )
|
||||||
|
children-tags first2 [ calculate ] dip calculate ;
|
||||||
|
|
||||||
|
TAG: number calculate
|
||||||
|
children>string string>number ;
|
||||||
|
TAG: add calculate
|
||||||
|
calc-2children + ;
|
||||||
|
TAG: minus calculate
|
||||||
|
calc-2children - ;
|
||||||
|
TAG: times calculate
|
||||||
|
calc-2children * ;
|
||||||
|
TAG: divide calculate
|
||||||
|
calc-2children / ;
|
||||||
|
TAG: neg calculate
|
||||||
|
children-tags first calculate neg ;
|
||||||
|
|
||||||
|
: calc-arith ( string -- n )
|
||||||
|
string>xml first-child-tag calculate ;
|
||||||
|
|
||||||
|
[ 32 ] [
|
||||||
|
"<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
|
||||||
|
calc-arith
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
\ calc-arith must-infer
|
||||||
|
|
||||||
|
XML-NS: foo http://blah.com
|
||||||
|
|
||||||
|
[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
|
||||||
|
|
||||||
|
! XML literals
|
||||||
|
|
||||||
|
[ "a" "c" { "a" "c" f } ] [
|
||||||
|
"<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
|
||||||
|
string>doc
|
||||||
|
[ second var>> ]
|
||||||
|
[ fourth "val" attr var>> ]
|
||||||
|
[ extract-variables ] tri
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<x>
|
||||||
|
one
|
||||||
|
<b val="two"/>
|
||||||
|
y
|
||||||
|
<foo/>
|
||||||
|
</x>"} ] [
|
||||||
|
[let* | a [ "one" ] c [ "two" ] x [ "y" ]
|
||||||
|
d [ [XML <-x-> <foo/> XML] ] |
|
||||||
|
<XML
|
||||||
|
<x> <-a-> <b val=<-c->/> <-d-> </x>
|
||||||
|
XML> pprint-xml>string
|
||||||
|
]
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<doc>
|
||||||
|
<item>
|
||||||
|
one
|
||||||
|
</item>
|
||||||
|
<item>
|
||||||
|
two
|
||||||
|
</item>
|
||||||
|
<item>
|
||||||
|
three
|
||||||
|
</item>
|
||||||
|
</doc>"} ] [
|
||||||
|
"one two three" " " split
|
||||||
|
[ [XML <item><-></item> XML] ] map
|
||||||
|
<XML <doc><-></doc> XML> pprint-xml>string
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ {" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
|
||||||
|
[ 3 f "http://factorcode.org/" "hello" \ drop
|
||||||
|
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
|
||||||
|
pprint-xml>string ] unit-test
|
||||||
|
|
||||||
|
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
|
||||||
|
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
|
||||||
|
|
||||||
|
\ <XML must-infer
|
||||||
|
[ [XML <-> XML] ] must-infer
|
||||||
|
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
|
||||||
|
|
||||||
|
[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
|
||||||
|
[ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
|
||||||
|
[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
|
||||||
|
[ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
|
||||||
|
[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
|
||||||
|
[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
|
||||||
|
|
||||||
|
[ "" ] [ [XML XML] concat ] unit-test
|
||||||
|
|
||||||
|
USE: inverse
|
||||||
|
|
||||||
|
[ "foo" ] [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
|
||||||
|
[ "foo" ] [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
|
||||||
|
[ "foo" "baz" ] [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
|
||||||
|
|
||||||
|
: dispatch ( xml -- string )
|
||||||
|
{
|
||||||
|
{ [ [XML <a><-></a> XML] ] [ "a" prepend ] }
|
||||||
|
{ [ [XML <b><-></b> XML] ] [ "b" prepend ] }
|
||||||
|
{ [ [XML <b val='yes'/> XML] ] [ "byes" ] }
|
||||||
|
{ [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
|
||||||
|
} switch ;
|
||||||
|
|
||||||
|
[ "apple" ] [ [XML <a>pple</a> XML] dispatch ] unit-test
|
||||||
|
[ "banana" ] [ [XML <b>anana</b> XML] dispatch ] unit-test
|
||||||
|
[ "byes" ] [ [XML <b val="yes"/> XML] dispatch ] unit-test
|
||||||
|
[ "bnowhere" ] [ [XML <b val="where"/> XML] dispatch ] unit-test
|
||||||
|
[ "baboon" ] [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
|
||||||
|
[ "apple" ] [ <XML <a>pple</a> XML> dispatch ] unit-test
|
||||||
|
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
|
||||||
|
|
||||||
|
: dispatch-doc ( xml -- string )
|
||||||
|
{
|
||||||
|
{ [ <XML <a><-></a> XML> ] [ "a" prepend ] }
|
||||||
|
{ [ <XML <b><-></b> XML> ] [ "b" prepend ] }
|
||||||
|
{ [ <XML <b val='yes'/> XML> ] [ "byes" ] }
|
||||||
|
{ [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
|
||||||
|
} switch ;
|
||||||
|
|
||||||
|
[ "apple" ] [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
|
||||||
|
[ "apple" ] [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
|
||||||
|
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test
|
||||||
|
|
@ -0,0 +1,243 @@
|
||||||
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: words assocs kernel accessors parser sequences summary
|
||||||
|
lexer splitting combinators locals xml.data memoize sequences.deep
|
||||||
|
xml.data xml.state xml namespaces present arrays generalizations strings
|
||||||
|
make math macros multiline inverse combinators.short-circuit
|
||||||
|
sorting fry unicode.categories ;
|
||||||
|
IN: xml.syntax
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
TUPLE: no-tag name word ;
|
||||||
|
M: no-tag summary
|
||||||
|
drop "The tag-dispatching word has no method for the given tag name" ;
|
||||||
|
|
||||||
|
: compile-tags ( word xtable -- quot )
|
||||||
|
>alist swap '[ _ no-tag boa throw ] suffix
|
||||||
|
'[ dup main>> _ case ] ;
|
||||||
|
|
||||||
|
: define-tags ( word -- )
|
||||||
|
dup dup "xtable" word-prop compile-tags define ;
|
||||||
|
|
||||||
|
:: define-tag ( string word quot -- )
|
||||||
|
quot string word "xtable" word-prop set-at
|
||||||
|
word define-tags ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: TAGS:
|
||||||
|
CREATE
|
||||||
|
[ H{ } clone "xtable" set-word-prop ]
|
||||||
|
[ define-tags ] bi ; parsing
|
||||||
|
|
||||||
|
: TAG:
|
||||||
|
scan scan-word parse-definition define-tag ; parsing
|
||||||
|
|
||||||
|
: XML-NS:
|
||||||
|
CREATE-WORD (( string -- name )) over set-stack-effect
|
||||||
|
scan '[ f swap _ <name> ] define-memoized ; parsing
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: each-attrs ( attrs quot -- )
|
||||||
|
[ values [ interpolated? ] filter ] dip each ; inline
|
||||||
|
|
||||||
|
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
|
||||||
|
{
|
||||||
|
{ [ over interpolated? ] [ call ] }
|
||||||
|
{ [ over tag? ] [ [ attrs>> ] dip each-attrs ] }
|
||||||
|
{ [ over attrs? ] [ each-attrs ] }
|
||||||
|
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
|
||||||
|
[ 2drop ]
|
||||||
|
} cond ; inline recursive
|
||||||
|
|
||||||
|
: each-interpolated ( xml quot -- )
|
||||||
|
'[ _ (each-interpolated) ] deep-each ; inline
|
||||||
|
|
||||||
|
: has-interpolated? ( xml -- ? )
|
||||||
|
! If this becomes a performance problem, it can be improved
|
||||||
|
f swap [ 2drop t ] each-interpolated ;
|
||||||
|
|
||||||
|
: when-interpolated ( xml quot -- genquot )
|
||||||
|
[ dup has-interpolated? ] dip [ '[ _ swap ] ] if ; inline
|
||||||
|
|
||||||
|
: string>chunk ( string -- chunk )
|
||||||
|
t interpolating? [ string>xml-chunk ] with-variable ;
|
||||||
|
|
||||||
|
: string>doc ( string -- xml )
|
||||||
|
t interpolating? [ string>xml ] with-variable ;
|
||||||
|
|
||||||
|
DEFER: interpolate-sequence
|
||||||
|
|
||||||
|
: get-interpolated ( interpolated -- quot )
|
||||||
|
var>> '[ [ _ swap at ] keep ] ;
|
||||||
|
|
||||||
|
: ?present ( object -- string )
|
||||||
|
dup [ present ] when ;
|
||||||
|
|
||||||
|
: interpolate-attr ( key value -- quot )
|
||||||
|
dup interpolated?
|
||||||
|
[ get-interpolated '[ _ swap @ [ ?present 2array ] dip ] ]
|
||||||
|
[ 2array '[ _ swap ] ] if ;
|
||||||
|
|
||||||
|
: filter-nulls ( assoc -- newassoc )
|
||||||
|
[ nip ] assoc-filter ;
|
||||||
|
|
||||||
|
: interpolate-attrs ( attrs -- quot )
|
||||||
|
[
|
||||||
|
[ [ interpolate-attr ] { } assoc>map [ ] join ]
|
||||||
|
[ assoc-size ] bi
|
||||||
|
'[ @ _ swap [ narray filter-nulls <attrs> ] dip ]
|
||||||
|
] when-interpolated ;
|
||||||
|
|
||||||
|
: interpolate-tag ( tag -- quot )
|
||||||
|
[
|
||||||
|
[ name>> ]
|
||||||
|
[ attrs>> interpolate-attrs ]
|
||||||
|
[ children>> interpolate-sequence ] tri
|
||||||
|
'[ _ swap @ @ [ <tag> ] dip ]
|
||||||
|
] when-interpolated ;
|
||||||
|
|
||||||
|
GENERIC: push-item ( item -- )
|
||||||
|
M: string push-item , ;
|
||||||
|
M: xml-data push-item , ;
|
||||||
|
M: object push-item present , ;
|
||||||
|
M: sequence push-item
|
||||||
|
dup xml-data? [ , ] [ [ push-item ] each ] if ;
|
||||||
|
M: number push-item present , ;
|
||||||
|
M: xml-chunk push-item % ;
|
||||||
|
|
||||||
|
: concat-interpolate ( array -- newarray )
|
||||||
|
[ [ push-item ] each ] { } make ;
|
||||||
|
|
||||||
|
GENERIC: interpolate-item ( item -- quot )
|
||||||
|
M: object interpolate-item [ swap ] curry ;
|
||||||
|
M: tag interpolate-item interpolate-tag ;
|
||||||
|
M: interpolated interpolate-item get-interpolated ;
|
||||||
|
|
||||||
|
: interpolate-sequence ( seq -- quot )
|
||||||
|
[
|
||||||
|
[ [ interpolate-item ] map concat ]
|
||||||
|
[ length ] bi
|
||||||
|
'[ @ _ swap [ narray concat-interpolate ] dip ]
|
||||||
|
] when-interpolated ;
|
||||||
|
|
||||||
|
GENERIC: [interpolate-xml] ( xml -- quot )
|
||||||
|
|
||||||
|
M: xml [interpolate-xml]
|
||||||
|
dup body>> interpolate-tag
|
||||||
|
'[ _ (clone) swap @ drop >>body ] ;
|
||||||
|
|
||||||
|
M: xml-chunk [interpolate-xml]
|
||||||
|
interpolate-sequence
|
||||||
|
'[ @ drop <xml-chunk> ] ;
|
||||||
|
|
||||||
|
MACRO: interpolate-xml ( xml -- quot )
|
||||||
|
[interpolate-xml] ;
|
||||||
|
|
||||||
|
: number<-> ( doc -- dup )
|
||||||
|
0 over [
|
||||||
|
dup var>> [
|
||||||
|
over >>var [ 1+ ] dip
|
||||||
|
] unless drop
|
||||||
|
] each-interpolated drop ;
|
||||||
|
|
||||||
|
: >search-hash ( seq -- hash )
|
||||||
|
[ dup search ] H{ } map>assoc ;
|
||||||
|
|
||||||
|
: extract-variables ( xml -- seq )
|
||||||
|
[ [ var>> , ] each-interpolated ] { } make ;
|
||||||
|
|
||||||
|
: nenum ( ... n -- assoc )
|
||||||
|
narray <enum> ; inline
|
||||||
|
|
||||||
|
: collect ( accum variables -- accum ? )
|
||||||
|
{
|
||||||
|
{ [ dup empty? ] [ drop f ] } ! Just a literal
|
||||||
|
{ [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals
|
||||||
|
{ [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry
|
||||||
|
[ drop "XML interpolation contains both fry and locals" throw ] ! mixed
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
: parse-def ( accum delimiter quot -- accum )
|
||||||
|
[ parse-multiline-string [ blank? ] trim ] dip call
|
||||||
|
[ extract-variables collect ] keep swap
|
||||||
|
[ number<-> parsed ] dip
|
||||||
|
[ \ interpolate-xml parsed ] when ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: <XML
|
||||||
|
"XML>" [ string>doc ] parse-def ; parsing
|
||||||
|
|
||||||
|
: [XML
|
||||||
|
"XML]" [ string>chunk ] parse-def ; parsing
|
||||||
|
|
||||||
|
: remove-blanks ( seq -- newseq )
|
||||||
|
[ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
|
||||||
|
|
||||||
|
GENERIC: >xml ( xml -- tag )
|
||||||
|
M: xml >xml body>> ;
|
||||||
|
M: tag >xml ;
|
||||||
|
M: xml-chunk >xml
|
||||||
|
remove-blanks
|
||||||
|
[ length 1 =/fail ]
|
||||||
|
[ first dup tag? [ fail ] unless ] bi ;
|
||||||
|
M: object >xml fail ;
|
||||||
|
|
||||||
|
: 1chunk ( object -- xml-chunk )
|
||||||
|
1array <xml-chunk> ;
|
||||||
|
|
||||||
|
GENERIC: >xml-chunk ( xml -- chunk )
|
||||||
|
M: xml >xml-chunk body>> 1chunk ;
|
||||||
|
M: xml-chunk >xml-chunk ;
|
||||||
|
M: object >xml-chunk 1chunk ;
|
||||||
|
|
||||||
|
GENERIC: [undo-xml] ( xml -- quot )
|
||||||
|
|
||||||
|
M: xml [undo-xml]
|
||||||
|
body>> [undo-xml] '[ >xml @ ] ;
|
||||||
|
|
||||||
|
M: xml-chunk [undo-xml]
|
||||||
|
seq>> [undo-xml] '[ >xml-chunk @ ] ;
|
||||||
|
|
||||||
|
: undo-attrs ( attrs -- quot: ( attrs -- ) )
|
||||||
|
[
|
||||||
|
[ main>> ] dip dup interpolated?
|
||||||
|
[ var>> '[ _ attr _ set ] ]
|
||||||
|
[ '[ _ attr _ =/fail ] ] if
|
||||||
|
] { } assoc>map '[ _ cleave ] ;
|
||||||
|
|
||||||
|
M: tag [undo-xml] ( tag -- quot: ( tag -- ) )
|
||||||
|
{
|
||||||
|
[ name>> main>> '[ name>> main>> _ =/fail ] ]
|
||||||
|
[ attrs>> undo-attrs ]
|
||||||
|
[ children>> [undo-xml] '[ children>> @ ] ]
|
||||||
|
} cleave '[ _ _ _ tri ] ;
|
||||||
|
|
||||||
|
: firstn-strong ( seq n -- ... )
|
||||||
|
[ swap length =/fail ]
|
||||||
|
[ firstn ] 2bi ; inline
|
||||||
|
|
||||||
|
M: sequence [undo-xml] ( sequence -- quot: ( seq -- ) )
|
||||||
|
remove-blanks [ length ] [ [ [undo-xml] ] { } map-as ] bi
|
||||||
|
'[ remove-blanks _ firstn-strong _ spread ] ;
|
||||||
|
|
||||||
|
M: string [undo-xml] ( string -- quot: ( string -- ) )
|
||||||
|
'[ _ =/fail ] ;
|
||||||
|
|
||||||
|
M: xml-data [undo-xml] ( datum -- quot: ( datum -- ) )
|
||||||
|
'[ _ =/fail ] ;
|
||||||
|
|
||||||
|
M: interpolated [undo-xml]
|
||||||
|
var>> '[ _ set ] ;
|
||||||
|
|
||||||
|
: >enum ( assoc -- enum )
|
||||||
|
! Assumes keys are 0..n
|
||||||
|
>alist sort-keys values <enum> ;
|
||||||
|
|
||||||
|
: undo-xml ( xml -- quot )
|
||||||
|
[undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
|
||||||
|
|
||||||
|
\ interpolate-xml 1 [ undo-xml ] define-pop-inverse
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
USING: xml xml.data xml.utilities tools.test accessors kernel
|
USING: xml xml.data xml.traversal tools.test accessors kernel
|
||||||
io.encodings.8-bit ;
|
io.encodings.8-bit ;
|
||||||
|
|
||||||
[ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test
|
[ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
USING: sequences xml kernel arrays xml.utilities io.files tools.test ;
|
USING: sequences xml kernel arrays xml.traversal io.files tools.test ;
|
||||||
IN: xml.tests
|
IN: xml.tests
|
||||||
|
|
||||||
: assemble-data ( tag -- 3array )
|
: assemble-data ( tag -- 3array )
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
USING: kernel xml sequences assocs tools.test io arrays namespaces fry
|
USING: kernel xml sequences assocs tools.test io arrays namespaces fry
|
||||||
accessors xml.data xml.utilities xml.writer generic sequences.deep multiline ;
|
accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
|
||||||
IN: xml.tests
|
IN: xml.tests
|
||||||
|
|
||||||
: sub-tag
|
: sub-tag
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
IN: xml.tests
|
IN: xml.tests
|
||||||
USING: kernel xml tools.test io namespaces make sequences
|
USING: kernel xml tools.test io namespaces make sequences
|
||||||
xml.errors xml.entities.html parser strings xml.data io.files
|
xml.errors xml.entities.html parser strings xml.data io.files
|
||||||
xml.utilities continuations assocs
|
xml.traversal continuations assocs
|
||||||
sequences.deep accessors io.streams.string ;
|
sequences.deep accessors io.streams.string ;
|
||||||
|
|
||||||
! This is insufficient
|
! This is insufficient
|
||||||
|
|
@ -67,3 +67,4 @@ SYMBOL: xml-file
|
||||||
[ "x" "<" ] [ "<x value='<'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
|
[ "x" "<" ] [ "<x value='<'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
|
||||||
[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
|
[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
|
||||||
[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
|
[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
|
||||||
|
[ "1.1" ] [ "<?xml version='1.1'?><x/>" string>xml prolog>> version>> ] unit-test
|
||||||
|
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue