logs
work
build-support/wordsize
+*.bak
clean:
rm -f vm/*.o
- rm -f factor*.dll libfactor*.*
+ rm -f factor*.dll libfactor.{a,so,dylib}
vm/resources.o:
$(WINDRES) vm/factor.rs vm/resources.o
[ time>> ] dip before=? ;
: reschedule-alarm ( alarm -- )
- dup [ swap interval>> time+ ] change-time register-alarm ;
+ dup [ swap interval>> time+ now max ] change-time register-alarm ;
: call-alarm ( alarm -- )
[ entry>> box> drop ]
USING: help help.topics help.syntax help.crossref
help.definitions io io.files kernel namespaces vocabs sequences
-parser vocabs.loader ;
+parser vocabs.loader vocabs.loader.private accessors assocs ;
IN: bootstrap.help
: load-help ( -- )
t load-help? set-global
[ drop ] load-vocab-hook [
- vocabs
- [ vocab-docs-loaded? not ] filter
+ dictionary get values
+ [ docs-loaded?>> not ] filter
[ load-docs ] each
] with-variable ;
SYMBOL: jit-if-jump
SYMBOL: jit-dispatch-word
SYMBOL: jit-dispatch
+SYMBOL: jit-dip-word
+SYMBOL: jit-dip
+SYMBOL: jit-2dip-word
+SYMBOL: jit-2dip
+SYMBOL: jit-3dip-word
+SYMBOL: jit-3dip
SYMBOL: jit-epilog
SYMBOL: jit-return
SYMBOL: jit-profiling
! Default definition for undefined words
SYMBOL: undefined-quot
-: userenv-offset ( symbol -- n )
- {
+: userenvs ( -- assoc )
+ H{
{ bootstrap-boot-quot 20 }
{ bootstrap-global 21 }
{ jit-code-format 22 }
{ jit-push-immediate 36 }
{ jit-declare-word 42 }
{ jit-save-stack 43 }
+ { jit-dip-word 44 }
+ { jit-dip 45 }
+ { jit-2dip-word 46 }
+ { jit-2dip 47 }
+ { jit-3dip-word 48 }
+ { jit-3dip 49 }
{ undefined-quot 60 }
- } at header-size + ;
+ } ; inline
+
+: userenv-offset ( symbol -- n )
+ userenvs at header-size + ;
: emit ( cell -- ) image get push ;
\ dispatch jit-dispatch-word set
\ do-primitive jit-primitive-word set
\ declare jit-declare-word set
+ \ dip jit-dip-word set
+ \ 2dip jit-2dip-word set
+ \ 3dip jit-3dip-word set
[ undefined ] undefined-quot set
{
jit-code-format
jit-if-jump
jit-dispatch-word
jit-dispatch
+ jit-dip-word
+ jit-dip
+ jit-2dip-word
+ jit-2dip
+ jit-3dip-word
+ jit-3dip
jit-epilog
jit-return
jit-profiling
os wince? [ "windows.ce" require ] when
os winnt? [ "windows.nt" require ] when
- "deploy-vocab" get [
+ "staging" get "deploy-vocab" get or [
"stage2: deployment mode" print
] [
"listener" require
[ -> filenames CF>string-array ] [ drop f ] if ;
: split-path ( path -- dir file )
- "/" last-split1 [ <NSString> ] bi@ ;
+ "/" split1-last [ <NSString> ] bi@ ;
: save-panel ( path -- paths )
<NSSavePanel> dup
{ "quot" quotation } }
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
-HELP: n&&-rewrite
+HELP: n&&
{ $values
{ "quots" "a sequence of quotations" } { "N" integer }
{ "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each AND quotation." } ;
+{ $description "A macro that rewrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
-HELP: n||-rewrite
+HELP: n||
{ $values
- { "quots" "a sequence of quotations" } { "N" integer }
+ { "quots" "a sequence of quotations" } { "n" integer }
{ "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ;
+{ $description "A macro that rewrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
"The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
{ $subsection 2|| }
{ $subsection 3|| }
"Generalized combinators:"
-{ $subsection n&&-rewrite }
-{ $subsection n||-rewrite }
+{ $subsection n&& }
+{ $subsection n|| }
;
ABOUT: "combinators.short-circuit"
-
USING: kernel combinators quotations arrays sequences assocs
- locals generalizations macros fry ;
-
+locals generalizations macros fry ;
IN: combinators.short-circuit
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: n&&-rewrite ( quots N -- quot )
- quots
- [ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
- map
- [ t ] [ N nnip ] 2array suffix
- '[ f _ cond ] ;
-
-MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
-MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
-MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
-MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-:: n||-rewrite ( quots N -- quot )
- quots
- [ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
- map
- [ drop N ndrop t ] [ f ] 2array suffix
- '[ f _ cond ] ;
-
-MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
-MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
-MACRO: 2|| ( quots -- quot ) 2 n||-rewrite ;
-MACRO: 3|| ( quots -- quot ) 3 n||-rewrite ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+MACRO:: n&& ( quots n -- quot )
+ [ f ]
+ quots [| q | { [ drop n ndup q call dup not ] [ drop n ndrop f ] } ] map
+ [ n nnip ] suffix 1array
+ [ cond ] 3append ;
+
+MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
+MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ;
+MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
+MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
+
+MACRO:: n|| ( quots n -- quot )
+ [ f ]
+ quots
+ [| q | { [ drop n ndup q call dup ] [ n nnip ] } ] map
+ { [ drop n ndrop t ] [ f ] } suffix 1array
+ [ cond ] 3append ;
+
+MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;
+MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ;
+MACRO: 2|| ( quots -- quot ) '[ _ 2 n|| ] ;
+MACRO: 3|| ( quots -- quot ) '[ _ 3 n|| ] ;
-
USING: kernel sequences math stack-checker effects accessors macros
- combinators.short-circuit ;
-
+fry combinators.short-circuit ;
IN: combinators.short-circuit.smart
<PRIVATE
PRIVATE>
-MACRO: && ( quots -- quot ) dup arity n&&-rewrite ;
+MACRO: && ( quots -- quot ) dup arity '[ _ _ n&& ] ;
-MACRO: || ( quots -- quot ) dup arity n||-rewrite ;
+MACRO: || ( quots -- quot ) dup arity '[ _ _ n|| ] ;
[
dup crossref?
[
- dependencies get >alist
- generic-dependencies get >alist
+ dependencies get
+ generic-dependencies get
compiled-xref
] [ drop ] if
] tri ;
--- /dev/null
+USING: math fry macros eval tools.test ;
+IN: compiler.tests.redefine13
+
+: breakage-word ( a b -- c ) + ;
+
+MACRO: breakage-macro ( a -- ) '[ _ breakage-word ] ;
+
+GENERIC: breakage-caller ( a -- c )
+
+M: fixnum breakage-caller 2 breakage-macro ;
+
+: breakage ( -- obj ) 2 breakage-caller ;
+
+! [ ] [ "IN: compiler.tests.redefine13 : breakage-word ( a b -- c ) ;" eval ] unit-test
--- /dev/null
+USING: compiler.units definitions tools.test sequences ;
+IN: compiler.tests.redefine14
+
+! TUPLE: bad ;
+!
+! M: bad length 1 2 3 ;
+!
+! [ ] [ [ { bad length } forget ] with-compilation-unit ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes classes.algebra classes.tuple
classes.tuple.private kernel accessors math math.intervals
-namespaces sequences words combinators combinators.short-circuit
+namespaces sequences words combinators
arrays compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.info
{ [ over not ] [ 2drop f ] }
[
{
- [ [ class>> ] bi@ class<= ]
- [ [ interval>> ] bi@ interval-subset? ]
- [ literals<= ]
- [ [ length>> ] bi@ value-info<= ]
- [ [ slots>> ] bi@ [ value-info<= ] 2all? ]
- } 2&&
+ { [ 2dup [ class>> ] bi@ class<= not ] [ f ] }
+ { [ 2dup [ interval>> ] bi@ interval-subset? not ] [ f ] }
+ { [ 2dup literals<= not ] [ f ] }
+ { [ 2dup [ length>> ] bi@ value-info<= not ] [ f ] }
+ { [ 2dup [ slots>> ] bi@ [ value-info<= ] 2all? not ] [ f ] }
+ [ t ]
+ } cond 2nip
]
} cond ;
\ mod [ [ interval-mod ] [ real-valued ] binary-op ] each-derived-op
\ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
+{ /mod fixnum/mod } [
+ \ /i \ mod
+ [ "outputs" word-prop ] bi@
+ '[ _ _ 2bi ] "outputs" set-word-prop
+] each
+
\ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op
\ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op
{ $errors "Throws an error if one of the iterations throws an error." } ;\r
\r
ARTICLE: "concurrency.combinators" "Concurrent combinators"\r
-"The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of " { $link each } ", " { $link map } " and " { $link filter } ":"\r
+"The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of various combinators."\r
+$nl\r
+"Concurrent sequence combinators:"\r
{ $subsection parallel-each }\r
{ $subsection 2parallel-each }\r
{ $subsection parallel-map }\r
{ $subsection 2parallel-map }\r
-{ $subsection parallel-filter } ;\r
+{ $subsection parallel-filter }\r
+"Concurrent cleave combinators:"\r
+{ $subsection parallel-cleave }\r
+{ $subsection parallel-spread }\r
+{ $subsection parallel-napply } ;\r
\r
ABOUT: "concurrency.combinators"\r
IN: concurrency.combinators.tests\r
USING: concurrency.combinators tools.test random kernel math \r
-concurrency.mailboxes threads sequences accessors arrays ;\r
+concurrency.mailboxes threads sequences accessors arrays\r
+math.parser ;\r
\r
[ [ drop ] parallel-each ] must-infer\r
{ 2 0 } [ [ 2drop ] 2parallel-each ] must-infer-as\r
] unit-test\r
\r
[ { f } [ "OOPS" throw ] parallel-each ] must-fail\r
+\r
+[ "1a" "4b" "3c" ] [\r
+ 2\r
+ { [ 1- ] [ sq ] [ 1+ ] } parallel-cleave\r
+ [ number>string ] 3 parallel-napply\r
+ { [ "a" append ] [ "b" append ] [ "c" append ] } parallel-spread\r
+] unit-test\r
! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: concurrency.futures concurrency.count-downs sequences\r
-kernel ;\r
+kernel macros fry combinators generalizations ;\r
IN: concurrency.combinators\r
\r
<PRIVATE\r
+\r
: (parallel-each) ( n quot -- )\r
- >r <count-down> r> keep await ; inline\r
+ [ <count-down> ] dip keep await ; inline\r
+\r
PRIVATE>\r
\r
: parallel-each ( seq quot -- )\r
over length [\r
- [ >r curry r> spawn-stage ] 2curry each\r
+ '[ _ curry _ spawn-stage ] each\r
] (parallel-each) ; inline\r
\r
: 2parallel-each ( seq1 seq2 quot -- )\r
2over min-length [\r
- [ >r 2curry r> spawn-stage ] 2curry 2each\r
+ '[ _ 2curry _ spawn-stage ] 2each\r
] (parallel-each) ; inline\r
\r
: parallel-filter ( seq quot -- newseq )\r
- over >r pusher >r each r> r> like ; inline\r
+ over [ pusher [ each ] dip ] dip like ; inline\r
\r
<PRIVATE\r
+\r
+: [future] ( quot -- quot' ) '[ _ curry future ] ; inline\r
+\r
: future-values dup [ ?future ] change-each ; inline\r
+\r
PRIVATE>\r
\r
: parallel-map ( seq quot -- newseq )\r
- [ curry future ] curry map future-values ;\r
- inline\r
+ [future] map future-values ; inline\r
\r
: 2parallel-map ( seq1 seq2 quot -- newseq )\r
- [ 2curry future ] curry 2map future-values ;\r
+ '[ _ 2curry future ] 2map future-values ;\r
+\r
+<PRIVATE\r
+\r
+: (parallel-spread) ( n -- spread-array )\r
+ [ ?future ] <repetition> ; inline\r
+\r
+: (parallel-cleave) ( quots -- quot-array spread-array )\r
+ [ [future] ] map dup length (parallel-spread) ; inline\r
+\r
+PRIVATE>\r
+\r
+MACRO: parallel-cleave ( quots -- )\r
+ (parallel-cleave) '[ _ cleave _ spread ] ;\r
+\r
+MACRO: parallel-spread ( quots -- )\r
+ (parallel-cleave) '[ _ spread _ spread ] ;\r
+\r
+MACRO: parallel-napply ( quot n -- )\r
+ [ [future] ] dip dup (parallel-spread) '[ _ _ napply _ spread ] ;\r
\r
[ 0 B ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define\r
\r
-: jit-call-quot ( -- )\r
+: jit-jump-quot ( -- )\r
4 3 quot-xt-offset LWZ\r
4 MTCTR\r
BCTR ;\r
\r
+: jit-call-quot ( -- )\r
+ 4 3 quot-xt-offset LWZ\r
+ 4 MTLR\r
+ BLR ;\r
+\r
[\r
0 3 LOAD32\r
6 ds-reg 0 LWZ\r
3 3 4 ADDI\r
3 3 0 LWZ\r
ds-reg dup 4 SUBI\r
- jit-call-quot\r
+ jit-jump-quot\r
] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define\r
\r
[\r
3 3 6 ADD\r
3 3 array-start-offset LWZ\r
ds-reg dup 4 SUBI\r
- jit-call-quot\r
+ jit-jump-quot\r
] rc-absolute-ppc-2/2 rt-literal 1 jit-dispatch jit-define\r
\r
+! These should not clobber r3 since we store a quotation in there\r
+! in jit-dip\r
+\r
+: jit->r ( -- )\r
+ 4 ds-reg 0 LWZ\r
+ ds-reg dup 4 SUBI\r
+ 4 rs-reg 4 STWU ;\r
+\r
+: jit-2>r ( -- )\r
+ 4 ds-reg 0 LWZ\r
+ 5 ds-reg -4 LWZ\r
+ ds-reg dup 8 SUBI\r
+ rs-reg dup 8 ADDI\r
+ 4 rs-reg 0 STW\r
+ 5 rs-reg -4 STW ;\r
+\r
+: jit-3>r ( -- )\r
+ 4 ds-reg 0 LWZ\r
+ 5 ds-reg -4 LWZ\r
+ 6 ds-reg -8 LWZ\r
+ ds-reg dup 12 SUBI\r
+ rs-reg dup 12 ADDI\r
+ 4 rs-reg 0 STW\r
+ 5 rs-reg -4 STW\r
+ 6 rs-reg -8 STW ;\r
+\r
+: jit-r> ( -- )\r
+ 4 ds-reg 0 LWZ\r
+ ds-reg dup 4 SUBI\r
+ 4 rs-reg 4 STWU ;\r
+\r
+: jit-2r> ( -- )\r
+ 4 rs-reg 0 LWZ\r
+ 5 rs-reg -4 LWZ\r
+ rs-reg dup 8 SUBI\r
+ ds-reg dup 8 ADDI\r
+ 4 ds-reg 0 STW\r
+ 5 ds-reg -4 STW ;\r
+\r
+: jit-3r> ( -- )\r
+ 4 rs-reg 0 LWZ\r
+ 5 rs-reg -4 LWZ\r
+ 6 rs-reg -8 LWZ\r
+ rs-reg dup 12 SUBI\r
+ ds-reg dup 12 ADDI\r
+ 4 ds-reg 0 STW\r
+ 5 ds-reg -4 STW\r
+ 6 ds-reg -8 STW ;\r
+\r
+: prepare-dip ( -- )\r
+ 0 3 LOAD32\r
+ 3 3 0 LWZ ;\r
+\r
+[\r
+ prepare-dip\r
+ jit->r\r
+ jit-call-quot\r
+ jit-r>\r
+] rc-absolute-ppc-2/2 rt-literal 1 jit-dip jit-define\r
+\r
+[\r
+ prepare-dip\r
+ jit-2>r\r
+ jit-call-quot\r
+ jit-2r>\r
+] rc-absolute-ppc-2/2 rt-literal 1 jit-2dip jit-define\r
+\r
+[\r
+ prepare-dip\r
+ jit-3>r\r
+ jit-call-quot\r
+ jit-3r>\r
+] rc-absolute-ppc-2/2 rt-literal 1 jit-3dip jit-define\r
+\r
[\r
0 1 lr-save stack-frame + LWZ\r
1 1 stack-frame ADDI\r
[\r
3 ds-reg 0 LWZ\r
ds-reg dup 4 SUBI\r
- jit-call-quot\r
+ jit-jump-quot\r
] f f f \ (call) define-sub-primitive\r
\r
[\r
4 ds-reg 0 STW\r
] f f f \ -rot define-sub-primitive\r
\r
-[\r
- 3 ds-reg 0 LWZ\r
- ds-reg dup 4 SUBI\r
- 3 rs-reg 4 STWU\r
-] f f f \ >r define-sub-primitive\r
+[ jit->r ] f f f \ >r define-sub-primitive\r
\r
-[\r
- 3 rs-reg 0 LWZ\r
- rs-reg dup 4 SUBI\r
- 3 ds-reg 4 STWU\r
-] f f f \ r> define-sub-primitive\r
+[ jit-r> ] f f f \ r> define-sub-primitive\r
\r
! Comparisons\r
: jit-compare ( insn -- )\r
7 ds-reg 0 STW\r
] f f f \ fixnum-mod define-sub-primitive\r
\r
+[\r
+ 3 ds-reg 0 LWZ\r
+ ds-reg ds-reg 4 SUBI\r
+ 4 ds-reg 0 LWZ\r
+ 5 4 3 DIVW\r
+ 5 ds-reg 0 STW\r
+] f f f \ fixnum/i-fast define-sub-primitive\r
+\r
+[\r
+ 3 ds-reg 0 LWZ\r
+ 4 ds-reg -4 LWZ\r
+ 5 4 3 DIVW\r
+ 6 5 3 MULLW\r
+ 7 6 4 SUBF\r
+ 5 ds-reg -4 STW\r
+ 7 ds-reg 0 STW\r
+] f f f \ fixnum/mod-fast define-sub-primitive\r
+\r
[\r
3 ds-reg 0 LWZ\r
3 3 1 SRAWI\r
: mod-arg ( -- reg ) EDX ;
: arg0 ( -- reg ) EAX ;
: arg1 ( -- reg ) EDX ;
+: arg2 ( -- reg ) ECX ;
: temp-reg ( -- reg ) EBX ;
: stack-reg ( -- reg ) ESP ;
: ds-reg ( -- reg ) ESI ;
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
: arg0 ( -- reg ) RDI ;
: arg1 ( -- reg ) RSI ;
+: arg2 ( -- reg ) RDX ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
: arg0 ( -- reg ) RCX ;
: arg1 ( -- reg ) RDX ;
+: arg2 ( -- reg ) R8 ;
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
arg0 quot-xt-offset [+] JMP ! execute branch
] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
+! The jit->r words cannot clobber arg0
+
+: jit->r ( -- )
+ rs-reg bootstrap-cell ADD
+ temp-reg ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ rs-reg [] temp-reg MOV ;
+
+: jit-2>r ( -- )
+ rs-reg 2 bootstrap-cells ADD
+ temp-reg ds-reg [] MOV
+ arg1 ds-reg -1 bootstrap-cells [+] MOV
+ ds-reg 2 bootstrap-cells SUB
+ rs-reg [] temp-reg MOV
+ rs-reg -1 bootstrap-cells [+] arg1 MOV ;
+
+: jit-3>r ( -- )
+ rs-reg 3 bootstrap-cells ADD
+ temp-reg ds-reg [] MOV
+ arg1 ds-reg -1 bootstrap-cells [+] MOV
+ arg2 ds-reg -2 bootstrap-cells [+] MOV
+ ds-reg 3 bootstrap-cells SUB
+ rs-reg [] temp-reg MOV
+ rs-reg -1 bootstrap-cells [+] arg1 MOV
+ rs-reg -2 bootstrap-cells [+] arg2 MOV ;
+
+: jit-r> ( -- )
+ ds-reg bootstrap-cell ADD
+ temp-reg rs-reg [] MOV
+ rs-reg bootstrap-cell SUB
+ ds-reg [] temp-reg MOV ;
+
+: jit-2r> ( -- )
+ ds-reg 2 bootstrap-cells ADD
+ temp-reg rs-reg [] MOV
+ arg1 rs-reg -1 bootstrap-cells [+] MOV
+ rs-reg 2 bootstrap-cells SUB
+ ds-reg [] temp-reg MOV
+ ds-reg -1 bootstrap-cells [+] arg1 MOV ;
+
+: jit-3r> ( -- )
+ ds-reg 3 bootstrap-cells ADD
+ temp-reg rs-reg [] MOV
+ arg1 rs-reg -1 bootstrap-cells [+] MOV
+ arg2 rs-reg -2 bootstrap-cells [+] MOV
+ rs-reg 3 bootstrap-cells SUB
+ ds-reg [] temp-reg MOV
+ ds-reg -1 bootstrap-cells [+] arg1 MOV
+ ds-reg -2 bootstrap-cells [+] arg2 MOV ;
+
+[
+ arg0 0 MOV ! load quotation addr
+ arg0 arg0 [] MOV ! load quotation
+ jit->r
+ arg0 quot-xt-offset [+] CALL ! call quotation
+ jit-r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-dip jit-define
+
+[
+ arg0 0 MOV ! load quotation addr
+ arg0 arg0 [] MOV ! load quotation
+ jit-2>r
+ arg0 quot-xt-offset [+] CALL ! call quotation
+ jit-2r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-2dip jit-define
+
+[
+ arg0 0 MOV ! load quotation addr
+ arg0 arg0 [] MOV ! load quotation
+ jit-3>r
+ arg0 quot-xt-offset [+] CALL ! call quotation
+ jit-3r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-3dip jit-define
+
[
stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
] f f f jit-epilog jit-define
ds-reg [] arg1 MOV
] f f f \ -rot define-sub-primitive
-[
- rs-reg bootstrap-cell ADD
- arg0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- rs-reg [] arg0 MOV
-] f f f \ >r define-sub-primitive
+[ jit->r ] f f f \ >r define-sub-primitive
-[
- ds-reg bootstrap-cell ADD
- arg0 rs-reg [] MOV
- rs-reg bootstrap-cell SUB
- ds-reg [] arg0 MOV
-] f f f \ r> define-sub-primitive
+[ jit-r> ] f f f \ r> define-sub-primitive
! Comparisons
: jit-compare ( insn -- )
ds-reg [] arg1 MOV ! push to stack
] f f f \ fixnum-shift-fast define-sub-primitive
-[
+: jit-fixnum-/mod ( -- )
temp-reg ds-reg [] MOV ! load second parameter
- ds-reg bootstrap-cell SUB ! adjust stack pointer
- div-arg ds-reg [] MOV ! load first parameter
+ div-arg ds-reg bootstrap-cell neg [+] MOV ! load first parameter
mod-arg div-arg MOV ! make a copy
mod-arg bootstrap-cell-bits 1- SAR ! sign-extend
- temp-reg IDIV ! divide
+ temp-reg IDIV ; ! divide
+
+[
+ jit-fixnum-/mod
+ ds-reg bootstrap-cell SUB ! adjust stack pointer
ds-reg [] mod-arg MOV ! push to stack
] f f f \ fixnum-mod define-sub-primitive
+[
+ jit-fixnum-/mod
+ ds-reg bootstrap-cell SUB ! adjust stack pointer
+ div-arg tag-bits get SHL ! tag it
+ ds-reg [] div-arg MOV ! push to stack
+] f f f \ fixnum/i-fast define-sub-primitive
+
+[
+ jit-fixnum-/mod
+ div-arg tag-bits get SHL ! tag it
+ ds-reg [] mod-arg MOV ! push to stack
+ ds-reg bootstrap-cell neg [+] div-arg MOV
+] f f f \ fixnum/mod-fast define-sub-primitive
+
[
arg0 ds-reg [] MOV ! load local number
fixnum>slot@ ! turn local number into offset
M: no-case summary
drop "Fall-through in case" ;
-M: slice-error error.
- "Cannot create slice because " write
- reason>> print ;
+M: slice-error summary
+ drop "Cannot create slice" ;
M: bounds-error summary drop "Sequence index out of bounds" ;
math.order ;
IN: documents
-: +col ( loc n -- newloc ) >r first2 r> + 2array ;
+: +col ( loc n -- newloc ) [ first2 ] dip + 2array ;
-: +line ( loc n -- newloc ) >r first2 swap r> + swap 2array ;
+: +line ( loc n -- newloc ) [ first2 swap ] dip + swap 2array ;
: =col ( n loc -- newloc ) first swap 2array ;
: doc-line ( n document -- string ) value>> nth ;
: doc-lines ( from to document -- slice )
- >r 1+ r> value>> <slice> ;
+ [ 1+ ] dip value>> <slice> ;
: start-on-line ( document from line# -- n1 )
- >r dup first r> = [ nip second ] [ 2drop 0 ] if ;
+ [ dup first ] dip = [ nip second ] [ 2drop 0 ] if ;
: end-on-line ( document to line# -- n2 )
over first over = [
2over = [
3drop
] [
- >r [ first ] bi@ 1+ dup <slice> r> each
+ [ [ first ] bi@ 1+ dup <slice> ] dip each
] if ; inline
: start/end-on-line ( from to line# -- n1 n2 )
- tuck >r >r document get -rot start-on-line r> r>
- document get -rot end-on-line ;
+ tuck
+ [ [ document get ] 2dip start-on-line ]
+ [ [ document get ] 2dip end-on-line ]
+ 2bi* ;
: (doc-range) ( from to line# -- )
[ start/end-on-line ] keep document get doc-line <slice> , ;
: doc-range ( from to document -- string )
[
document set 2dup [
- >r 2dup r> (doc-range)
+ [ 2dup ] dip (doc-range)
] each-line 2drop
] { } make "\n" join ;
: text+loc ( lines loc -- loc )
- over >r over length 1 = [
- nip first2
- ] [
- first swap length 1- + 0
- ] if r> peek length + 2array ;
+ over [
+ over length 1 = [
+ nip first2
+ ] [
+ first swap length 1- + 0
+ ] if
+ ] dip peek length + 2array ;
: prepend-first ( str seq -- )
0 swap [ append ] change-nth ;
[ length 1- ] keep [ prepend ] change-nth ;
: loc-col/str ( loc document -- str col )
- >r first2 swap r> nth swap ;
+ [ first2 swap ] dip nth swap ;
: prepare-insert ( newinput from to lines -- newinput )
- tuck loc-col/str tail-slice >r loc-col/str head-slice r>
+ tuck [ loc-col/str head-slice ] [ loc-col/str tail-slice ] 2bi*
pick append-last over prepend-first ;
: (set-doc-range) ( newlines from to lines -- )
[ prepare-insert ] 3keep
- >r [ first ] bi@ 1+ r>
+ [ [ first ] bi@ 1+ ] dip
replace-slice ;
: set-doc-range ( string from to document -- )
[
- >r >r >r string-lines r> [ text+loc ] 2keep r> r>
+ [ [ string-lines ] dip [ text+loc ] 2keep ] 2dip
[ [ (set-doc-range) ] keep ] change-model
] keep update-locs ;
: remove-doc-range ( from to document -- )
- >r >r >r "" r> r> r> set-doc-range ;
+ [ "" ] 3dip set-doc-range ;
: last-line# ( document -- line )
value>> length 1- ;
dupd doc-line length 2array ;
: line-end? ( loc document -- ? )
- >r first2 swap r> doc-line length = ;
+ [ first2 swap ] dip doc-line length = ;
: doc-end ( document -- loc )
[ last-line# ] keep line-end ;
over first 0 < [
2drop { 0 0 }
] [
- >r first2 swap tuck r> validate-col 2array
+ [ first2 swap tuck ] dip validate-col 2array
] if
] if ;
value>> "\n" join ;
: set-doc-string ( string document -- )
- >r string-lines V{ } like r> [ set-model ] keep
+ [ string-lines V{ } like ] dip [ set-model ] keep
[ doc-end ] [ update-locs ] bi ;
: clear-doc ( document -- )
GENERIC: next-elt ( loc document elt -- newloc )
: prev/next-elt ( loc document elt -- start end )
- 3dup next-elt >r prev-elt r> ;
+ [ prev-elt ] [ next-elt ] 3bi ;
: elt-string ( loc document elt -- string )
- over >r prev/next-elt r> doc-range ;
+ [ prev/next-elt ] [ drop ] 2bi doc-range ;
TUPLE: char-elt ;
: (prev-char) ( loc document quot -- loc )
-rot {
{ [ over { 0 0 } = ] [ drop ] }
- { [ over second zero? ] [ >r first 1- r> line-end ] }
+ { [ over second zero? ] [ [ first 1- ] dip line-end ] }
[ pick call ]
} cond nip ; inline
M: one-char-elt next-elt 2drop ;
: (word-elt) ( loc document quot -- loc )
- pick >r
- >r >r first2 swap r> doc-line r> call
- r> =col ; inline
+ pick [
+ [ [ first2 swap ] dip doc-line ] dip call
+ ] dip =col ; inline
: ((word-elt)) ( n seq -- ? n seq ) [ ?nth blank? ] 2keep ;
: break-detector ( ? -- quot )
- [ >r blank? r> xor ] curry ; inline
+ [ [ blank? ] dip xor ] curry ; inline
: (prev-word) ( ? col str -- col )
rot break-detector find-last-from drop ?1+ ;
M: one-word-elt prev-elt
drop
- [ f -rot >r 1- r> (prev-word) ] (word-elt) ;
+ [ [ [ f ] dip 1- ] dip (prev-word) ] (word-elt) ;
M: one-word-elt next-elt
drop
- [ f -rot (next-word) ] (word-elt) ;
+ [ [ f ] 2dip (next-word) ] (word-elt) ;
TUPLE: word-elt ;
M: word-elt prev-elt
drop
- [ [ >r 1- r> ((word-elt)) (prev-word) ] (word-elt) ]
+ [ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ]
(prev-char) ;
M: word-elt next-elt
2drop first 0 2array ;
M: one-line-elt next-elt
- drop >r first dup r> doc-line length 2array ;
+ drop [ first dup ] dip doc-line length 2array ;
TUPLE: line-elt ;
--- /dev/null
+Marc Fauconneau
--- /dev/null
+USING: editors io.files io.launcher kernel math.parser
+namespaces sequences windows.shell32 make ;
+IN: editors.notepad2
+
+: notepad2-path ( -- str )
+ \ notepad2-path get-global [
+ program-files "C:\\Windows\\system32\\notepad.exe" append-path
+ ] unless* ;
+
+: notepad2 ( file line -- )
+ [
+ notepad2-path ,
+ "/g" , number>string , ,
+ ] { } make run-detached drop ;
+
+[ notepad2 ] edit-hook set-global
\ No newline at end of file
--- /dev/null
+Notepad2 editor integration
--- /dev/null
+unportable
{ "http://" "https://" "ftp://" } [ head? ] with contains? ;
: simple-link-title ( string -- string' )
- dup absolute-url? [ "/" last-split1 swap or ] unless ;
+ dup absolute-url? [ "/" split1-last swap or ] unless ;
EBNF: parse-farkup
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
} ;\r
\r
HELP: '[\r
-{ $syntax "code... ]" }\r
+{ $syntax "'[ code... ]" }\r
{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }\r
{ $examples "See " { $link "fry.examples" } "." } ;\r
\r
+HELP: >r/r>-in-fry-error\r
+{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ;\r
+\r
ARTICLE: "fry.examples" "Examples of fried quotations"\r
"The easiest way to understand fried quotations is to look at some examples."\r
$nl\r
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"\r
"{ 8 13 14 27 } [ even? dup 5 ? ] map"\r
}\r
+"The following is a no-op:"\r
+{ $code "'[ @ ]" }\r
"Here are some built-in combinators rewritten in terms of fried quotations:"\r
{ $table\r
{ { $link literalize } { $snippet ": literalize '[ _ ] ;" } }\r
} ;\r
\r
ARTICLE: "fry.limitations" "Fried quotation limitations"\r
-"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead." ;\r
+"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead."\r
+$nl\r
+"An error thrown if a fried quotation contains calls to " { $link >r } " and " { $link r> } ":"\r
+{ $subsection >r/r>-in-fry-error } ;\r
\r
ARTICLE: "fry" "Fried quotations"\r
-"A " { $emphasis "fried quotation" } " differs from a literal quotation in that when it is evaluated, instead of just pushing itself on the stack, it consumes zero or more stack values and inserts them into the quotation."\r
+"The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with ``holes'' (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."\r
$nl\r
-"Fried quotations are denoted with a special parsing word:"\r
+"Fried quotations are started by a special parsing word:"\r
{ $subsection POSTPONE: '[ }\r
-"Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":"\r
+"There are two types of fry specifiers; the first can hold a value, and the second ``splices'' a quotation, as if it were inserted without surrounding brackets:"\r
{ $subsection _ }\r
{ $subsection @ }\r
-"When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left."\r
+"The holes are filled in with the top of stack going in the rightmost hole, the second item on the stack going in the second hole from the right, and so on."\r
{ $subsection "fry.examples" }\r
{ $subsection "fry.philosophy" }\r
{ $subsection "fry.limitations" }\r
-"Quotations can also be fried without using a parsing word:"\r
-{ $subsection fry } ;\r
+"Fry is implemented as a parsing word which reads a quotation and scans for occurrences of " { $link _ } " and " { $link @ } "; these words are not actually executed, and doing so raises an error (this can happen if they're accidentally used outside of a fry)."\r
+$nl\r
+"Fried quotations can also be constructed without using a parsing word; this is useful when meta-programming:"\r
+{ $subsection fry }\r
+"Fried quotations are an abstraction on top of the " { $link "compositional-combinators" } "; their use is encouraged over the combinators, because often the fry form is shorter and clearer than the combinator form." ;\r
\r
ABOUT: "fry"\r
IN: fry.tests
USING: fry tools.test math prettyprint kernel io arrays
-sequences ;
+sequences eval accessors ;
[ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
[ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
-[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
+[ [ 1 [ + ] call ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
-[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
+[ [ 1 [ + ] call . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
-[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
+[ [ [ + ] [ - ] [ call ] dip call ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
-[ [ "a" write "b" print ] ]
+[ [ "a" "b" [ write ] dip print ] ]
[ "a" "b" '[ _ write _ print ] ] unit-test
-[ [ 1 2 + 3 4 - ] ]
-[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
-
[ 1/2 ] [
1 '[ [ _ ] dip / ] 2 swap call
] unit-test
[ { { { 3 } } } ] [
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
+
+[ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
+[ error>> >r/r>-in-fry-error? ] must-fail-with
+
+[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
+ 1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
+] unit-test
! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences combinators parser splitting math
-quotations arrays make words ;
+quotations arrays make words locals.backend summary sets ;
IN: fry
: _ ( -- * ) "Only valid inside a fry" throw ;
: @ ( -- * ) "Only valid inside a fry" throw ;
+ERROR: >r/r>-in-fry-error ;
+
<PRIVATE
-DEFER: (shallow-fry)
-DEFER: shallow-fry
-
-: ((shallow-fry)) ( accum quot adder -- result )
- >r shallow-fry r>
- append swap [
- [ prepose ] curry append
- ] unless-empty ; inline
-
-: (shallow-fry) ( accum quot -- result )
- [ 1quotation ] [
- unclip {
- { \ _ [ [ curry ] ((shallow-fry)) ] }
- { \ @ [ [ compose ] ((shallow-fry)) ] }
- [ swap >r suffix r> (shallow-fry) ]
- } case
- ] if-empty ;
-
-: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
+: [ncurry] ( n -- quot )
+ {
+ { 0 [ [ ] ] }
+ { 1 [ [ curry ] ] }
+ { 2 [ [ 2curry ] ] }
+ { 3 [ [ 3curry ] ] }
+ [ \ curry <repetition> ]
+ } case ;
+
+M: >r/r>-in-fry-error summary
+ drop
+ "Explicit retain stack manipulation is not permitted in fried quotations" ;
+
+: check-fry ( quot -- quot )
+ dup { >r r> load-locals get-local drop-locals } intersect
+ empty? [ >r/r>-in-fry-error ] unless ;
+
+: shallow-fry ( quot -- quot' )
+ check-fry
+ [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
+ { _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
PREDICATE: fry-specifier < word { _ @ } memq? ;
[ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test\r
[ ] [ { } 0 firstn ] unit-test\r
[ "a" ] [ { "a" } 1 firstn ] unit-test\r
+\r
+[ [ 1 2 ] ] [ 1 2 2 [ ] nsequence ] unit-test\r
IN: generalizations\r
\r
MACRO: nsequence ( n seq -- quot )\r
- [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi\r
- [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;\r
+ [\r
+ [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi\r
+ [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce\r
+ ] keep\r
+ '[ @ _ like ] ;\r
\r
MACRO: narray ( n -- quot )\r
'[ _ { } nsequence ] ;\r
USING: help.markup help.syntax io kernel math namespaces parser
-prettyprint sequences vocabs.loader namespaces stack-checker ;
+prettyprint sequences vocabs.loader namespaces stack-checker
+help ;
IN: help.cookbook
ARTICLE: "cookbook-syntax" "Basic syntax cookbook"
{ "If " { $link run-file } " throws a stack depth assertion, it means that the top-level form in the file left behind values on the stack. The stack depth is compared before and after loading a source file, since this type of situation is almost always an error. If you have a legitimate need to load a source file which returns data in some manner, define a word in the source file which produces this data on the stack and call the word after loading the file." }
} ;
+ARTICLE: "cookbook-next" "Next steps"
+"Once you have read through " { $link "first-program" } " and " { $link "cookbook" } ", the best way to keep learning Factor is to start looking at some simple example programs. Here are a few particularly nice vocabularies which should keep you busy for a little while:"
+{ $list
+ { $vocab-link "base64" }
+ { $vocab-link "roman" }
+ { $vocab-link "rot13" }
+ { $vocab-link "smtp" }
+ { $vocab-link "time-server" }
+ { $vocab-link "tools.hexdump" }
+ { $vocab-link "webapps.counter" }
+}
+"If you see code in there that you do not understand, use " { $link see } " and " { $link help } " to explore." ;
+
ARTICLE: "cookbook" "Factor cookbook"
"The Factor cookbook is a high-level overview of the most important concepts required to program in Factor."
{ $subsection "cookbook-syntax" }
{ $subsection "cookbook-scripts" }
{ $subsection "cookbook-compiler" }
{ $subsection "cookbook-philosophy" }
-{ $subsection "cookbook-pitfalls" } ;
+{ $subsection "cookbook-pitfalls" }
+{ $subsection "cookbook-next" } ;
ABOUT: "cookbook"
[ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test
- [ ] [ "xxx" "help.definitions.tests" lookup help ] unit-test
+ [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test
[ ] [ "xxx" "help.definitions.tests" lookup >link synopsis print ] unit-test
] with-file-vocabs
IN: help.handbook.tests
USING: help tools.test ;
-[ ] [ "article-index" help ] unit-test
-[ ] [ "primitive-index" help ] unit-test
-[ ] [ "error-index" help ] unit-test
-[ ] [ "type-index" help ] unit-test
-[ ] [ "class-index" help ] unit-test
+[ ] [ "article-index" print-topic ] unit-test
+[ ] [ "primitive-index" print-topic ] unit-test
+[ ] [ "error-index" print-topic ] unit-test
+[ ] [ "type-index" print-topic ] unit-test
+[ ] [ "class-index" print-topic ] unit-test
{ "word" { "the basic unit of code, analogous to a function or procedure in other programming languages. See " { $link "words" } } }
} ;
+ARTICLE: "tail-call-opt" "Tail-call optimization"
+"If the last action performed is the execution of a word, the current quotation is not saved on the call stack; this is known as " { $emphasis "tail-call optimization" } " and the Factor implementation guarantees that it will be performed."
+$nl
+"Tail-call optimization allows iterative algorithms to be implemented in an efficient manner using recursion, without the need for any kind of primitive looping construct in the language. However, in practice, most iteration is performed via combinators such as " { $link while } ", " { $link each } ", " { $link map } ", " { $link assoc-each } ", and so on. The definitions of these combinators do bottom-out in recursive words, however." ;
+
ARTICLE: "evaluator" "Evaluation semantics"
{ $link "quotations" } " are evaluated sequentially from beginning to end. When the end is reached, the quotation returns to its caller. As each object in the quotation is evaluated in turn, an action is taken based on its type:"
{ $list
{ "a " { $link wrapper } " - the wrapped object is pushed on the data stack. Wrappers are used to push word objects directly on the stack when they would otherwise execute. See the " { $link POSTPONE: \ } " parsing word." }
{ "All other types of objects are pushed on the data stack." }
}
-"If the last action performed is the execution of a word, the current quotation is not saved on the call stack; this is known as " { $snippet "tail-recursion" } " and allows iterative algorithms to execute without incurring unbounded call stack usage."
+{ $subsection "tail-call-opt" }
{ $see-also "compiler" } ;
ARTICLE: "objects" "Objects"
{ $values { "topic" "a help article name or a word" } }
{ $description "Prints a help article's title, or a word's " { $link summary } ", depending on the type of " { $snippet "topic" } "." } ;
-HELP: help
+HELP: print-topic
{ $values { "topic" "an article name or a word" } }
{ $description
- "Displays a help article or documentation associated to a word on " { $link output-stream } "."
+ "Displays a help topic on " { $link output-stream } "."
} ;
+HELP: help
+{ $values { "topic" "an article name or a word" } }
+{ $description
+ "Displays a help topic."
+} ;
HELP: about
{ $values { "vocab" "a vocabulary specifier" } }
{ $description
{ { "object" object } { "?" "a boolean" } } $values
[
"Tests if the object is an instance of the " ,
- first "predicating" word-prop \ $link swap 2array ,
+ first "predicating" word-prop <$link> ,
" class." ,
] { } make $description ;
append
] if ;
-M: word article-content
+<PRIVATE
+
+: (word-help) ( word -- element )
[
- \ $vocabulary over 2array ,
- dup word-help %
- \ $related over 2array ,
- dup get-global [ \ $value swap 2array , ] when*
- \ $definition swap 2array ,
+ {
+ [ \ $vocabulary swap 2array , ]
+ [ word-help % ]
+ [ \ $related swap 2array , ]
+ [ get-global [ \ $value swap 2array , ] when* ]
+ [ \ $definition swap 2array , ]
+ } cleave
] { } make ;
+M: word article-content (word-help) ;
+
+<PRIVATE
+
+: word-with-methods ( word -- elements )
+ [
+ [ (word-help) % ]
+ [ \ $methods swap 2array , ]
+ bi
+ ] { } make ;
+
+PRIVATE>
+
+M: generic article-content word-with-methods ;
+
+M: class article-content word-with-methods ;
+
M: word article-parent "help-parent" word-prop ;
M: word set-article-parent swap "help-parent" set-word-prop ;
] with-nesting
] with-style nl ;
-: help ( topic -- )
+: print-topic ( topic -- )
last-element off dup $title
article-content print-content nl ;
+SYMBOL: help-hook
+
+help-hook global [ [ print-topic ] or ] change-at
+
+: help ( topic -- )
+ help-hook get call ;
+
: about ( vocab -- )
dup require
dup vocab [ ] [
] each ;
: check-rendering ( word element -- )
- [ help ] with-string-writer drop ;
+ [ print-topic ] with-string-writer drop ;
: all-word-help ( words -- seq )
[ word-help ] filter ;
[ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
-[ ] [ \ quux>> help ] unit-test
-[ ] [ \ >>quux help ] unit-test
-[ ] [ \ blahblah? help ] unit-test
+[ ] [ \ quux>> print-topic ] unit-test
+[ ] [ \ >>quux print-topic ] unit-test
+[ ] [ \ blahblah? print-topic ] unit-test
: fooey "fooey" throw ;
-[ ] [ \ fooey help ] unit-test
+[ ] [ \ fooey print-topic ] unit-test
-[ ] [ gensym help ] unit-test
+[ ] [ gensym print-topic ] unit-test
: $see ( element -- ) first [ see ] ($see) ;
+: $see-methods ( element -- ) first [ see-methods ] ($see) ;
+
: $synopsis ( element -- ) first [ synopsis write ] ($see) ;
: $definition ( element -- )
"Definition" $heading $see ;
+: $methods ( element -- )
+ "Methods" $heading $see-methods ;
+
: $value ( object -- )
"Variable value" $heading
"Current value in global namespace:" print-element
] each
] curry each
] H{ } make-assoc keys ;
+
+: <$link> ( topic -- element )
+ \ $link swap 2array ;
: test-template ( path -- ? )
"resource:basis/html/templates/fhtml/test/"
prepend
- [
- ".fhtml" append <fhtml> [ call-template ] with-string-writer
- <string-reader> lines
- ] keep
- ".html" append utf8 file-lines
+ [ ".fhtml" append <fhtml> [ call-template ] with-string-writer ]
+ [ ".html" append utf8 file-contents ] bi
[ . . ] [ = ] 2bi ;
[ t ] [ "example" test-template ] unit-test
! See http://factorcode.org/license.txt for BSD license.\r
USING: calendar io io.files kernel math math.order\r
math.parser namespaces parser sequences strings\r
-assocs hashtables debugger mime-types sorting logging\r
+assocs hashtables debugger mime.types sorting logging\r
calendar.format accessors splitting\r
io.encodings.binary fry xml.entities destructors urls\r
html.elements html.templates.fhtml\r
USING: accessors combinators kernel system unicode.case
io.unix.files io.files.listing generalizations strings
arrays sequences io.files math.parser unix.groups unix.users
-io.files.listing.private ;
+io.files.listing.private unix.stat math ;
IN: io.files.listing.unix
<PRIVATE
[ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ]
} cleave 10 narray concat ;
+: mode>symbol ( mode -- ch )
+ S_IFMT bitand
+ {
+ { [ dup S_IFDIR = ] [ drop "/" ] }
+ { [ dup S_IFIFO = ] [ drop "|" ] }
+ { [ dup any-execute? ] [ drop "*" ] }
+ { [ dup S_IFLNK = ] [ drop "@" ] }
+ { [ dup S_IFWHT = ] [ drop "%" ] }
+ { [ dup S_IFSOCK = ] [ drop "=" ] }
+ { [ t ] [ drop "" ] }
+ } cond ;
+
M: unix (directory.) ( path -- lines )
[ [
[
--- /dev/null
+! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays kernel debugger sequences namespaces math
+math.order combinators init alien alien.c-types alien.strings libc
+continuations destructors debugger summary splitting assocs
+random math.parser locals unicode.case
+openssl.libcrypto openssl.libssl
+io.backend io.ports io.files io.encodings.8-bit
+io.timeouts ;
+IN: io.sockets.secure.openssl
+
+GENERIC: ssl-method ( symbol -- method )
+
+M: SSLv2 ssl-method drop SSLv2_client_method ;
+M: SSLv23 ssl-method drop SSLv23_method ;
+M: SSLv3 ssl-method drop SSLv3_method ;
+M: TLSv1 ssl-method drop TLSv1_method ;
+
+TUPLE: openssl-context < secure-context aliens sessions ;
+
+: set-session-cache ( ctx -- )
+ handle>>
+ [ SSL_SESS_CACHE_BOTH SSL_CTX_set_session_cache_mode ssl-error ]
+ [ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
+ bi ;
+
+: load-certificate-chain ( ctx -- )
+ dup config>> key-file>> [
+ [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+ SSL_CTX_use_certificate_chain_file
+ ssl-error
+ ] [ drop ] if ;
+
+: password-callback ( -- alien )
+ "int" { "void*" "int" "bool" "void*" } "cdecl"
+ [| buf size rwflag password! |
+ password [ B{ 0 } password! ] unless
+
+ [let | len [ password strlen ] |
+ buf password len 1+ size min memcpy
+ len
+ ]
+ ] alien-callback ;
+
+: default-pasword ( ctx -- alien )
+ [ config>> password>> latin1 malloc-string ] [ aliens>> ] bi
+ [ push ] [ drop ] 2bi ;
+
+: set-default-password ( ctx -- )
+ [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
+ [
+ [ handle>> ] [ default-pasword ] bi
+ SSL_CTX_set_default_passwd_cb_userdata
+ ] bi ;
+
+: use-private-key-file ( ctx -- )
+ dup config>> key-file>> [
+ [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+ SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
+ ssl-error
+ ] [ drop ] if ;
+
+: load-verify-locations ( ctx -- )
+ dup config>> [ ca-file>> ] [ ca-path>> ] bi or [
+ [ handle>> ]
+ [
+ config>>
+ [ ca-file>> dup [ (normalize-path) ] when ]
+ [ ca-path>> dup [ (normalize-path) ] when ] bi
+ ] bi
+ SSL_CTX_load_verify_locations
+ ] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;
+
+: set-verify-depth ( ctx -- )
+ dup config>> verify-depth>> [
+ [ handle>> ] [ config>> verify-depth>> ] bi
+ SSL_CTX_set_verify_depth
+ ] [ drop ] if ;
+
+TUPLE: bio handle disposed ;
+
+: <bio> ( handle -- bio ) f bio boa ;
+
+M: bio dispose* handle>> BIO_free ssl-error ;
+
+: <file-bio> ( path -- bio )
+ normalize-path "r" BIO_new_file dup ssl-error <bio> ;
+
+: load-dh-params ( ctx -- )
+ dup config>> dh-file>> [
+ [ handle>> ] [ config>> dh-file>> ] bi <file-bio> &dispose
+ handle>> f f f PEM_read_bio_DHparams dup ssl-error
+ SSL_CTX_set_tmp_dh ssl-error
+ ] [ drop ] if ;
+
+TUPLE: rsa handle disposed ;
+
+: <rsa> ( handle -- rsa ) f rsa boa ;
+
+M: rsa dispose* handle>> RSA_free ;
+
+: generate-eph-rsa-key ( ctx -- )
+ [ handle>> ]
+ [
+ config>> ephemeral-key-bits>> RSA_F4 f f RSA_generate_key
+ dup ssl-error <rsa> &dispose handle>>
+ ] bi
+ SSL_CTX_set_tmp_rsa ssl-error ;
+
+: <openssl-context> ( config ctx -- context )
+ openssl-context new
+ swap >>handle
+ swap >>config
+ V{ } clone >>aliens
+ H{ } clone >>sessions ;
+
+M: openssl <secure-context> ( config -- context )
+ maybe-init-ssl
+ [
+ dup method>> ssl-method SSL_CTX_new
+ dup ssl-error <openssl-context> |dispose
+ {
+ [ set-session-cache ]
+ [ load-certificate-chain ]
+ [ set-default-password ]
+ [ use-private-key-file ]
+ [ load-verify-locations ]
+ [ set-verify-depth ]
+ [ load-dh-params ]
+ [ generate-eph-rsa-key ]
+ [ ]
+ } cleave
+ ] with-destructors ;
+
+M: openssl-context dispose*
+ [ aliens>> [ free ] each ]
+ [ sessions>> values [ SSL_SESSION_free ] each ]
+ [ handle>> SSL_CTX_free ]
+ tri ;
+
+TUPLE: ssl-handle file handle connected disposed ;
+
+SYMBOL: default-secure-context
+
+: context-expired? ( context -- ? )
+ dup [ handle>> expired? ] [ drop t ] if ;
+
+: current-secure-context ( -- ctx )
+ secure-context get [
+ default-secure-context get dup context-expired? [
+ drop
+ <secure-config> <secure-context> default-secure-context set-global
+ current-secure-context
+ ] when
+ ] unless* ;
+
+: <ssl-handle> ( fd -- ssl )
+ current-secure-context handle>> SSL_new dup ssl-error
+ f f ssl-handle boa ;
+
+M: ssl-handle dispose*
+ [ handle>> SSL_free ] [ file>> dispose ] bi ;
+
+: check-verify-result ( ssl-handle -- )
+ SSL_get_verify_result dup X509_V_OK =
+ [ drop ] [ verify-message certificate-verify-error ] if ;
+
+: common-name ( certificate -- host )
+ X509_get_subject_name
+ NID_commonName 256 <byte-array>
+ [ 256 X509_NAME_get_text_by_NID ] keep
+ swap -1 = [ drop f ] [ latin1 alien>string ] if ;
+
+: common-names-match? ( expected actual -- ? )
+ [ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
+
+: check-common-name ( host ssl-handle -- )
+ SSL_get_peer_certificate common-name
+ 2dup common-names-match?
+ [ 2drop ] [ common-name-verify-error ] if ;
+
+M: openssl check-certificate ( host ssl -- )
+ current-secure-context config>> verify>> [
+ handle>>
+ [ nip check-verify-result ]
+ [ check-common-name ]
+ 2bi
+ ] [ 2drop ] if ;
+
+: get-session ( addrspec -- session/f )
+ current-secure-context sessions>> at
+ dup expired? [ drop f ] when ;
+
+: save-session ( session addrspec -- )
+ current-secure-context sessions>> set-at ;
+
+openssl secure-socket-backend set-global
io.encodings.binary accessors sequences strings system
io.files.private destructors vocabs.loader calendar.unix
unix.stat alien.c-types arrays unix.users unix.groups
-environment fry io.encodings.utf8 alien.strings unix.statfs ;
+environment fry io.encodings.utf8 alien.strings unix.statfs
+combinators.short-circuit ;
IN: io.unix.files
M: unix cwd ( -- path )
[ stat-st_blksize >>blocksize ]
} cleave ;
-M: unix stat>type ( stat -- type )
- stat-st_mode S_IFMT bitand {
+: n>file-type ( n -- type )
+ S_IFMT bitand {
{ S_IFREG [ +regular-file+ ] }
{ S_IFDIR [ +directory+ ] }
{ S_IFCHR [ +character-device+ ] }
[ drop +unknown+ ]
} case ;
+M: unix stat>type ( stat -- type )
+ stat-st_mode n>file-type ;
+
! Linux has no extra fields in its stat struct
os {
{ macosx [ "io.unix.files.bsd" require ] }
M: unix >directory-entry ( byte-array -- directory-entry )
[ dirent-d_name utf8 alien>string ]
- [ dirent-d_type ] bi directory-entry boa ;
+ [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
M: unix (directory-entries) ( path -- seq )
[
GENERIC: other-write? ( obj -- ? )
GENERIC: other-execute? ( obj -- ? )
+: any-read? ( obj -- ? )
+ { [ user-read? ] [ group-read? ] [ other-read? ] } 1|| ;
+
+: any-write? ( obj -- ? )
+ { [ user-write? ] [ group-write? ] [ other-write? ] } 1|| ;
+
+: any-execute? ( obj -- ? )
+ { [ user-execute? ] [ group-execute? ] [ other-execute? ] } 1|| ;
+
M: integer uid? ( integer -- ? ) UID mask? ;
M: integer gid? ( integer -- ? ) GID mask? ;
M: integer sticky? ( integer -- ? ) STICKY mask? ;
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors unix byte-arrays kernel debugger sequences namespaces math
-math.order combinators init alien alien.c-types alien.strings libc
-continuations destructors
-openssl openssl.libcrypto openssl.libssl
-io.files io.ports io.unix.backend io.unix.sockets
-io.encodings.ascii io.buffers io.sockets io.sockets.secure
+USING: accessors unix byte-arrays kernel debugger sequences
+namespaces math math.order combinators init alien alien.c-types
+alien.strings libc continuations destructors openssl
+openssl.libcrypto openssl.libssl io.files io.ports
+io.unix.backend io.unix.sockets io.encodings.ascii io.buffers
+io.sockets io.sockets.secure io.sockets.secure.openssl
io.timeouts system summary ;
IN: io.unix.sockets.secure
normalize-path
RemoveDirectory win32-error=0/f ;
-M: windows >directory-entry ( byte-array -- directory-entry )
- [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
- [ WIN32_FIND_DATA-dwFileAttributes ]
- bi directory-entry boa ;
-
: find-first-file ( path -- WIN32_FIND_DATA handle )
"WIN32_FIND_DATA" <c-object> tuck
FindFirstFile
: win32-file-type ( n -- symbol )
FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
+TUPLE: windows-directory-entry < directory-entry attributes ;
+
+M: windows >directory-entry ( byte-array -- directory-entry )
+ [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
+ [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
+ [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
+ tri
+ dupd remove windows-directory-entry boa ;
+
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
[ \ windows-file-info new ] dip
{
USING: help.markup help.syntax kernel io system prettyprint ;
IN: listener
+ARTICLE: "listener-watch" "Watching variables in the listener"
+"The listener prints the concepts of the data and retain stacks after every expression. It can also print values of dynamic variables which are added to a watch list:"
+{ $subsection visible-vars }
+"To add or remove a single variable:"
+{ $subsection show-var }
+{ $subsection hide-var }
+"To add and remove multiple variables:"
+{ $subsection show-vars }
+{ $subsection hide-vars }
+"Hiding all visible variables:"
+{ $subsection hide-all-vars } ;
+
+HELP: show-var
+{ $values { "var" "a variable name" } }
+{ $description "Adds a variable to the watch list; its value will be printed by the listener after every expression." } ;
+
+HELP: show-vars
+{ $values { "seq" "a sequence of variable names" } }
+{ $description "Adds a sequence of variables to the watch list; their values will be printed by the listener after every expression." } ;
+
+HELP: hide-var
+{ $values { "var" "a variable name" } }
+{ $description "Removes a variable from the watch list." } ;
+
+HELP: hide-vars
+{ $values { "seq" "a sequence of variable names" } }
+{ $description "Removes a sequence of variables from the watch list." } ;
+
+HELP: hide-all-vars
+{ $description "Removes all variables from the watch list." } ;
+
ARTICLE: "listener" "The listener"
"The listener evaluates Factor expressions read from a stream. The listener is the primary interface to the Factor runtime. Typically, you write Factor code in a text editor, then load it using the listener and test it."
$nl
"The classical first program can be run in the listener:"
{ $example "\"Hello, world\" print" "Hello, world" }
-"Multi-line phrases are supported:"
+"Multi-line expressions are supported:"
{ $example "{ 1 2 3 } [\n .\n] each" "1\n2\n3" }
"The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them."
-$nl
-"A very common operation is to inspect the contents of the data stack in the listener:"
-{ $subsection .s }
-"Note that calls to " { $link .s } " can also be included inside words as a debugging aid, however a more convenient way to achieve this is to use the annotation facility. See " { $link "tools.annotations" } "."
-$nl
+{ $subsection "listener-watch" }
"You can start a nested listener or exit a listener using the following words:"
{ $subsection listener }
{ $subsection bye }
-"The following variables can be rebound inside a nested scope to customize the behavior of a listener; this can be done to create a development tool with a custom interaction loop:"
-{ $subsection listener-hook }
"Finally, the multi-line expression reading word can be used independently of the rest of the listener:"
{ $subsection read-quot } ;
ABOUT: "listener"
+<PRIVATE
+
HELP: quit-flag
{ $var-description "Variable set to true by " { $link bye } " word; it forces the next iteration of the " { $link listener } " loop to end." } ;
-HELP: listener-hook
-{ $var-description "Variable holding a quotation called by the listener before reading an input expression. The UI sets this variable to a quotation which updates the stack display in a listener gadget." } ;
+PRIVATE>
HELP: read-quot
{ $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
USING: arrays hashtables io kernel math math.parser memory
namespaces parser lexer sequences strings io.styles
vectors words generic system combinators continuations debugger
-definitions compiler.units accessors colors ;
-
+definitions compiler.units accessors colors prettyprint fry
+sets ;
IN: listener
-SYMBOL: quit-flag
-
-SYMBOL: listener-hook
-
-[ ] listener-hook set-global
-
GENERIC: stream-read-quot ( stream -- quot/f )
: parse-lines-interactive ( lines -- quot/f )
: read-quot ( -- quot/f ) input-stream get stream-read-quot ;
+<PRIVATE
+
+SYMBOL: quit-flag
+
+PRIVATE>
+
: bye ( -- ) quit-flag on ;
-: prompt. ( -- )
- "( " in get " )" 3append
- H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
+SYMBOL: visible-vars
+
+: show-var ( var -- ) visible-vars [ swap suffix ] change ;
+
+: show-vars ( seq -- ) visible-vars [ swap union ] change ;
+
+: hide-var ( var -- ) visible-vars [ remove ] change ;
+
+: hide-vars ( seq -- ) visible-vars [ swap diff ] change ;
+
+: hide-all-vars ( -- ) visible-vars off ;
SYMBOL: error-hook
[ print-error-and-restarts ] error-hook set-global
+<PRIVATE
+
+: title. ( string -- )
+ H{ { foreground T{ rgba f 0.3 0.3 0.3 1 } } } format nl ;
+
+: visible-vars. ( -- )
+ visible-vars get [
+ nl "--- Watched variables:" title.
+ standard-table-style [
+ [
+ [
+ [ [ short. ] with-cell ]
+ [ [ get short. ] with-cell ]
+ bi
+ ] with-row
+ ] each
+ ] tabular-output
+ ] unless-empty ;
+
+SYMBOL: display-stacks?
+
+t display-stacks? set-global
+
+: stacks. ( -- )
+ display-stacks? get [
+ datastack [ nl "--- Data stack:" title. stack. ] unless-empty
+ retainstack [ nl "--- Retain stack:" title. stack. ] unless-empty
+ ] when ;
+
+: prompt. ( -- )
+ "( " in get auto-use? get [ " - auto" append ] when " )" 3append
+ H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
+
: listen ( -- )
- listener-hook get call prompt.
+ visible-vars. stacks. prompt.
[ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
[
dup lexer-error? [
: until-quit ( -- )
quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
+PRIVATE>
+
: listener ( -- )
[ until-quit ] with-interactive-vocabs ;
"Unlike some languages such as Python and Java, writing to mutable locals in outer scopes is fully supported and has the expected semantics." ;
ARTICLE: "locals-limitations" "Limitations of locals"
-"The first limitation is that the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator."
-$nl
+"The first limitation is also shared by " { $vocab-link "fry" } ": the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator. An error is thrown at parse time if an attempt is made to use " { $link >r } " and " { $link r> } " inside a lambda body:"
+{ $subsection >r/r>-in-lambda-error }
"Another limitation concerns combinators implemented as macros. Locals can only be used with such combinators if the input array immediately precedes the combinator call. For example, the following will work:"
{ $code
":: good-cond-usage ( a -- ... )"
namespaces arrays strings prettyprint io.streams.string parser
accessors generic eval combinators combinators.short-circuit
combinators.short-circuit.smart math.order math.functions
-definitions compiler.units ;
+definitions compiler.units fry lexer ;
IN: locals.tests
:: foo ( a b -- a a ) a a ;
{ [ a b > ] [ 5 ] }
} cond ;
+\ cond-test must-infer
+
[ 3 ] [ 1 2 cond-test ] unit-test
[ 4 ] [ 2 2 cond-test ] unit-test
[ 5 ] [ 3 2 cond-test ] unit-test
:: 0&&-test ( a -- ? )
{ [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ;
+\ 0&&-test must-infer
+
[ f ] [ 1.5 0&&-test ] unit-test
[ f ] [ 3 0&&-test ] unit-test
[ f ] [ 8 0&&-test ] unit-test
:: &&-test ( a -- ? )
{ [ a integer? ] [ a even? ] [ a 10 > ] } && ;
+\ &&-test must-infer
+
[ f ] [ 1.5 &&-test ] unit-test
[ f ] [ 3 &&-test ] unit-test
[ f ] [ 8 &&-test ] unit-test
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
+ERROR: punned-class x ;
+
+[ T{ punned-class f 3 } ] [ 3 [| a | T{ punned-class f a } ] call ] unit-test
+
:: literal-identity-test ( -- a b )
{ } V{ } ;
[ ] [ [ { integer lambda-method-forget-test } forget ] with-compilation-unit ] unit-test
+[ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test
+
+[
+ "USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval
+] [ error>> >r/r>-in-fry-error? ] must-fail-with
+
+:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
+: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
+
+\ funny-macro-test must-infer
+
+[ t ] [ 3 funny-macro-test ] unit-test
+[ f ] [ 2 funny-macro-test ] unit-test
+
+! Some odd parser corner cases
+[ "USE: locals [let" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let |" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with
+
! :: wlet-&&-test ( a -- ? )
! [wlet | is-integer? [ a integer? ]
! is-even? [ a even? ]
prettyprint.backend definitions prettyprint hashtables
prettyprint.sections sets sequences.private effects
effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes ;
+locals.backend memoize macros.expander lexer classes summary ;
IN: locals
! Inspired by
! http://cat-language.googlecode.com/svn/trunk/CatPointFreeForm.cs
+ERROR: >r/r>-in-lambda-error ;
+
+M: >r/r>-in-lambda-error summary
+ drop
+ "Explicit retain stack manipulation is not permitted in lambda bodies" ;
+
<PRIVATE
TUPLE: lambda vars body ;
: free-vars ( form -- vars )
[ free-vars* ] { } make prune ;
-: add-if-free ( object -- )
- {
- { [ dup local-writer? ] [ "local-reader" word-prop , ] }
- { [ dup lexical? ] [ , ] }
- { [ dup quote? ] [ local>> , ] }
- { [ t ] [ free-vars* ] }
- } cond ;
+M: local-writer free-vars* "local-reader" word-prop , ;
+
+M: lexical free-vars* , ;
+
+M: quote free-vars* , ;
M: object free-vars* drop ;
-M: quotation free-vars* [ add-if-free ] each ;
+M: quotation free-vars* [ free-vars* ] each ;
-M: lambda free-vars*
- [ vars>> ] [ body>> ] bi free-vars swap diff % ;
+M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ;
GENERIC: lambda-rewrite* ( obj -- )
M: array rewrite-literal? [ rewrite-literal? ] contains? ;
+M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+
M: hashtable rewrite-literal? drop t ;
M: vector rewrite-literal? drop t ;
[ rewrite-element ] each ;
: rewrite-sequence ( seq -- )
- [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;
+ [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
M: array rewrite-element
dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
+M: quotation rewrite-element
+ dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
+
M: vector rewrite-element rewrite-sequence ;
M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
M: tuple rewrite-element
- [ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ;
+ [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
M: local rewrite-element , ;
M: hashtable local-rewrite* rewrite-element ;
+M: word local-rewrite*
+ dup { >r r> } memq?
+ [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
+
M: object lambda-rewrite* , ;
M: object local-rewrite* , ;
\ ] (parse-lambda) <lambda> ;
: parse-binding ( -- pair/f )
- scan dup "|" = [
- drop f
- ] [
- scan {
- { "[" [ \ ] parse-until >quotation ] }
- { "[|" [ parse-lambda ] }
- } case 2array
- ] if ;
+ scan {
+ { [ dup not ] [ unexpected-eof ] }
+ { [ dup "|" = ] [ drop f ] }
+ { [ dup "!" = ] [ drop POSTPONE: ! parse-binding ] }
+ [ scan-object 2array ]
+ } cond ;
: (parse-bindings) ( -- )
parse-binding [
- first2 >r make-local r> 2array ,
+ first2 [ make-local ] dip 2array ,
(parse-bindings)
] when* ;
in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
: parse-locals-definition ( word -- word quot )
- scan "(" assert= parse-locals \ ; (parse-lambda) <lambda>
+ "(" expect parse-locals \ ; (parse-lambda) <lambda>
2dup "lambda" set-word-prop
lambda-rewrite first ;
: [| parse-lambda parsed-lambda ; parsing
: [let
- scan "|" assert= parse-bindings
+ "|" expect parse-bindings
\ ] (parse-lambda) <let> parsed-lambda ; parsing
: [let*
- scan "|" assert= parse-bindings*
+ "|" expect parse-bindings*
\ ] (parse-lambda) <let*> parsed-lambda ; parsing
: [wlet
- scan "|" assert= parse-wbindings
+ "|" expect parse-wbindings
\ ] (parse-lambda) <wlet> parsed-lambda ; parsing
: :: (::) define ; parsing
[ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
] bi ;
-: expand-macro ( quot -- )
- stack [ swap with-datastack >vector ] change
- stack get pop >quotation end (expand-macros) ;
+: word, ( word -- ) end , ;
+
+: expand-macro ( word quot -- )
+ '[
+ drop
+ stack [ _ with-datastack >vector ] change
+ stack get pop >quotation end (expand-macros)
+ ] [
+ drop
+ word,
+ ] recover ;
: expand-macro? ( word -- quot ? )
dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
stack get length <=
] [ 2drop f f ] if ;
-: word, ( word -- ) end , ;
-
M: word expand-macros*
dup expand-dispatch? [ drop expand-dispatch ] [
- dup expand-macro? [ nip expand-macro ] [
+ dup expand-macro? [ expand-macro ] [
drop word,
] if
] if ;
"Some applications, such as binary communication protocols and assemblers, need to construct integers from elaborate bit field specifications. Hand-coding this using " { $link shift } " and " { $link bitor } " results in repetitive code. A higher-level facility exists to factor out this repetition:"
{ $subsection bitfield } ;
-ARTICLE: "math.bitwise" "Bitwise arithmetic"
-"The " { $vocab-link "math.bitwise" } " vocabulary can implements bitwise arithmetic words that are useful for efficiency, low-level programming, and interfacing with C libraries." $nl
+ARTICLE: "math.bitwise" "Additional bitwise arithmetic"
+"The " { $vocab-link "math.bitwise" } " vocabulary provides bitwise arithmetic words extending " { $link "bitwise-arithmetic" } ". They are useful for efficiency, low-level programming, and interfacing with C libraries."
+$nl
"Setting and clearing bits:"
{ $subsection set-bit }
{ $subsection clear-bit }
{ $values { "rect" "a new " { $link rect } } }
{ $description "Creates a rectangle located at the origin with zero dimensions." } ;
+ARTICLE: "math.geometry.rect" "Rectangles"
+"The " { $vocab-link "math.geometry.rect" } " vocabulary defines a rectangle data type and operations on them."
+{ $subsection rect }
+"Rectangles can be taken apart:"
+{ $subsection rect-loc }
+{ $subsection rect-dim }
+{ $subsection rect-bounds }
+{ $subsection rect-extent }
+"New rectangles can be created:"
+{ $subsection <zero-rect> }
+{ $subsection <rect> }
+{ $subsection <extent-rect> }
+"More utility words for working with rectangles:"
+{ $subsection offset-rect }
+{ $subsection rect-intersect }
+{ $subsection intersects? } ;
+
+ABOUT: "math.geometry.rect"
{ fixnum- fixnum-fast }
{ fixnum* fixnum*fast }
{ fixnum-shift fixnum-shift-fast }
+ { fixnum/i fixnum/i-fast }
+ { fixnum/mod fixnum/mod-fast }
} at ;
: modular-variant ( op -- fast-op )
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs help.markup help.syntax io.streams.string sequences ;
-IN: mime-types
-
-HELP: mime-db
-{ $values
-
- { "seq" sequence } }
-{ $description "Outputs an array where the first element is a MIME type and the rest of the array is file extensions that have that MIME type." } ;
-
-HELP: mime-type
-{ $values
- { "filename" "a filename" }
- { "mime-type" "a MIME type string" } }
-{ $description "Outputs the MIME type associtated with a path by parsing the path's file extension and looking it up in the table returned by " { $link mime-types } "." } ;
-
-HELP: mime-types
-{ $values
-
- { "assoc" assoc } }
-{ $description "Outputs an " { $snippet "assoc" } " made from the data in the " { $link mime-db } " word where the keys are file extensions and the values are the corresponding MIME types." } ;
-
-HELP: nonstandard-mime-types
-{ $values
-
- { "assoc" assoc } }
-{ $description "A list of Factor-specific MIME types that are added to the MIME database loaded from disk." } ;
-
-ARTICLE: "mime-types" "MIME types"
-"The " { $vocab-link "mime-types" } " vocabulary loads a file of MIME types and provides a word to look up the MIME type based on a file extension." $nl
-"Looking up a MIME type:"
-{ $subsection mime-type } ;
-
-ABOUT: "mime-types"
+++ /dev/null
-IN: mime-types.tests
-USING: mime-types tools.test ;
-
-[ "application/postscript" ] [ "foo.ps" mime-type ] unit-test
-[ "application/octet-stream" ] [ "foo.ps.gz" mime-type ] unit-test
-[ "text/plain" ] [ "foo.factor" mime-type ] unit-test
+++ /dev/null
-! Copyright (C) 2004, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: io.files io.encodings.ascii assocs sequences splitting
-kernel namespaces fry memoize ;
-IN: mime-types
-
-MEMO: mime-db ( -- seq )
- "resource:basis/mime-types/mime.types" ascii file-lines
- [ "#" head? not ] filter [ " \t" split harvest ] map harvest ;
-
-: nonstandard-mime-types ( -- assoc )
- H{
- { "factor" "text/plain" }
- { "cgi" "application/x-cgi-script" }
- { "fhtml" "application/x-factor-server-page" }
- } ;
-
-MEMO: mime-types ( -- assoc )
- [
- mime-db [ unclip '[ [ _ ] dip set ] each ] each
- ] H{ } make-assoc
- nonstandard-mime-types assoc-union ;
-
-: mime-type ( filename -- mime-type )
- file-extension mime-types at "application/octet-stream" or ;
+++ /dev/null
-# This is a comment. I love comments.
-
-# This file controls what Internet media types are sent to the client for
-# given file extension(s). Sending the correct media type to the client
-# is important so they know how to handle the content of the file.
-# Extra types can either be added here or by using an AddType directive
-# in your config files. For more information about Internet media types,
-# please read RFC 2045, 2046, 2047, 2048, and 2077. The Internet media type
-# registry is at <http://www.iana.org/assignments/media-types/>.
-
-# MIME type Extensions
-application/activemessage
-application/andrew-inset ez
-application/applefile
-application/atom+xml atom
-application/atomcat+xml atomcat
-application/atomicmail
-application/atomsvc+xml atomsvc
-application/auth-policy+xml
-application/batch-smtp
-application/beep+xml
-application/cals-1840
-application/ccxml+xml ccxml
-application/cellml+xml
-application/cnrp+xml
-application/commonground
-application/conference-info+xml
-application/cpl+xml
-application/csta+xml
-application/cstadata+xml
-application/cybercash
-application/davmount+xml davmount
-application/dca-rft
-application/dec-dx
-application/dialog-info+xml
-application/dicom
-application/dns
-application/dvcs
-application/ecmascript ecma
-application/edi-consent
-application/edi-x12
-application/edifact
-application/epp+xml
-application/eshop
-application/fastinfoset
-application/fastsoap
-application/fits
-application/font-tdpfr pfr
-application/h224
-application/http
-application/hyperstudio stk
-application/iges
-application/im-iscomposing+xml
-application/index
-application/index.cmd
-application/index.obj
-application/index.response
-application/index.vnd
-application/iotp
-application/ipp
-application/isup
-application/javascript js
-application/json json
-application/kpml-request+xml
-application/kpml-response+xml
-application/mac-binhex40 hqx
-application/mac-compactpro cpt
-application/macwriteii
-application/marc mrc
-application/mathematica ma nb mb
-application/mathml+xml mathml
-application/mbms-associated-procedure-description+xml
-application/mbms-deregister+xml
-application/mbms-envelope+xml
-application/mbms-msk+xml
-application/mbms-msk-response+xml
-application/mbms-protection-description+xml
-application/mbms-reception-report+xml
-application/mbms-register+xml
-application/mbms-register-response+xml
-application/mbms-user-service-description+xml
-application/mbox mbox
-application/mediaservercontrol+xml mscml
-application/mikey
-application/mp4 mp4s
-application/mpeg4-generic
-application/mpeg4-iod
-application/mpeg4-iod-xmt
-application/msword doc dot
-application/mxf mxf
-application/nasdata
-application/news-message-id
-application/news-transmission
-application/nss
-application/ocsp-request
-application/ocsp-response
-application/octet-stream bin dms lha lzh class so iso dmg dist distz pkg bpk dump elc scpt
-application/oda oda
-application/oebps-package+xml
-application/ogg ogg
-application/parityfec
-application/pdf pdf
-application/pgp-encrypted pgp
-application/pgp-keys
-application/pgp-signature asc sig
-application/pics-rules prf
-application/pidf+xml
-application/pkcs10 p10
-application/pkcs7-mime p7m p7c
-application/pkcs7-signature p7s
-application/pkix-cert cer
-application/pkix-crl crl
-application/pkix-pkipath pkipath
-application/pkixcmp pki
-application/pls+xml pls
-application/poc-settings+xml
-application/postscript ai eps ps
-application/prs.alvestrand.titrax-sheet
-application/prs.cww cww
-application/prs.nprend
-application/prs.plucker
-application/qsig
-application/rdf+xml rdf
-application/reginfo+xml rif
-application/relax-ng-compact-syntax rnc
-application/remote-printing
-application/resource-lists+xml rl
-application/riscos
-application/rlmi+xml
-application/rls-services+xml rs
-application/rsd+xml rsd
-application/rss+xml rss
-application/rtf rtf
-application/rtx
-application/samlassertion+xml
-application/samlmetadata+xml
-application/sbml+xml sbml
-application/sdp sdp
-application/set-payment
-application/set-payment-initiation setpay
-application/set-registration
-application/set-registration-initiation setreg
-application/sgml
-application/sgml-open-catalog
-application/shf+xml shf
-application/sieve
-application/simple-filter+xml
-application/simple-message-summary
-application/simplesymbolcontainer
-application/slate
-application/smil
-application/smil+xml smi smil
-application/soap+fastinfoset
-application/soap+xml
-application/spirits-event+xml
-application/srgs gram
-application/srgs+xml grxml
-application/ssml+xml ssml
-application/timestamp-query
-application/timestamp-reply
-application/tve-trigger
-application/vemmi
-application/vividence.scriptfile
-application/vnd.3gpp.bsf+xml
-application/vnd.3gpp.pic-bw-large plb
-application/vnd.3gpp.pic-bw-small psb
-application/vnd.3gpp.pic-bw-var pvb
-application/vnd.3gpp.sms
-application/vnd.3gpp2.bcmcsinfo+xml
-application/vnd.3gpp2.sms
-application/vnd.3m.post-it-notes pwn
-application/vnd.accpac.simply.aso aso
-application/vnd.accpac.simply.imp imp
-application/vnd.acucobol acu
-application/vnd.acucorp atc acutc
-application/vnd.adobe.xdp+xml xdp
-application/vnd.adobe.xfdf xfdf
-application/vnd.aether.imp
-application/vnd.amiga.ami ami
-application/vnd.anser-web-certificate-issue-initiation cii
-application/vnd.anser-web-funds-transfer-initiation fti
-application/vnd.antix.game-component atx
-application/vnd.apple.installer+xml mpkg
-application/vnd.audiograph aep
-application/vnd.autopackage
-application/vnd.avistar+xml
-application/vnd.blueice.multipass mpm
-application/vnd.bmi bmi
-application/vnd.businessobjects rep
-application/vnd.cab-jscript
-application/vnd.canon-cpdl
-application/vnd.canon-lips
-application/vnd.cendio.thinlinc.clientconf
-application/vnd.chemdraw+xml cdxml
-application/vnd.chipnuts.karaoke-mmd mmd
-application/vnd.cinderella cdy
-application/vnd.cirpack.isdn-ext
-application/vnd.claymore cla
-application/vnd.clonk.c4group c4g c4d c4f c4p c4u
-application/vnd.commerce-battelle
-application/vnd.commonspace csp cst
-application/vnd.contact.cmsg cdbcmsg
-application/vnd.cosmocaller cmc
-application/vnd.crick.clicker clkx
-application/vnd.crick.clicker.keyboard clkk
-application/vnd.crick.clicker.palette clkp
-application/vnd.crick.clicker.template clkt
-application/vnd.crick.clicker.wordbank clkw
-application/vnd.criticaltools.wbs+xml wbs
-application/vnd.ctc-posml pml
-application/vnd.cups-pdf
-application/vnd.cups-postscript
-application/vnd.cups-ppd ppd
-application/vnd.cups-raster
-application/vnd.cups-raw
-application/vnd.curl curl
-application/vnd.cybank
-application/vnd.data-vision.rdz rdz
-application/vnd.denovo.fcselayout-link fe_launch
-application/vnd.dna dna
-application/vnd.dolby.mlp mlp
-application/vnd.dpgraph dpg
-application/vnd.dreamfactory dfac
-application/vnd.dvb.esgcontainer
-application/vnd.dvb.ipdcesgaccess
-application/vnd.dxr
-application/vnd.ecdis-update
-application/vnd.ecowin.chart mag
-application/vnd.ecowin.filerequest
-application/vnd.ecowin.fileupdate
-application/vnd.ecowin.series
-application/vnd.ecowin.seriesrequest
-application/vnd.ecowin.seriesupdate
-application/vnd.enliven nml
-application/vnd.epson.esf esf
-application/vnd.epson.msf msf
-application/vnd.epson.quickanime qam
-application/vnd.epson.salt slt
-application/vnd.epson.ssf ssf
-application/vnd.ericsson.quickcall
-application/vnd.eszigno3+xml es3 et3
-application/vnd.eudora.data
-application/vnd.ezpix-album ez2
-application/vnd.ezpix-package ez3
-application/vnd.fdf fdf
-application/vnd.ffsns
-application/vnd.fints
-application/vnd.flographit gph
-application/vnd.fluxtime.clip ftc
-application/vnd.framemaker fm frame maker
-application/vnd.frogans.fnc fnc
-application/vnd.frogans.ltf ltf
-application/vnd.fsc.weblaunch fsc
-application/vnd.fujitsu.oasys oas
-application/vnd.fujitsu.oasys2 oa2
-application/vnd.fujitsu.oasys3 oa3
-application/vnd.fujitsu.oasysgp fg5
-application/vnd.fujitsu.oasysprs bh2
-application/vnd.fujixerox.art-ex
-application/vnd.fujixerox.art4
-application/vnd.fujixerox.hbpl
-application/vnd.fujixerox.ddd ddd
-application/vnd.fujixerox.docuworks xdw
-application/vnd.fujixerox.docuworks.binder xbd
-application/vnd.fut-misnet
-application/vnd.fuzzysheet fzs
-application/vnd.genomatix.tuxedo txd
-application/vnd.google-earth.kml+xml kml
-application/vnd.google-earth.kmz kmz
-application/vnd.grafeq gqf gqs
-application/vnd.gridmp
-application/vnd.groove-account gac
-application/vnd.groove-help ghf
-application/vnd.groove-identity-message gim
-application/vnd.groove-injector grv
-application/vnd.groove-tool-message gtm
-application/vnd.groove-tool-template tpl
-application/vnd.groove-vcard vcg
-application/vnd.handheld-entertainment+xml zmm
-application/vnd.hbci hbci
-application/vnd.hcl-bireports
-application/vnd.hhe.lesson-player les
-application/vnd.hp-hpgl hpgl
-application/vnd.hp-hpid hpid
-application/vnd.hp-hps hps
-application/vnd.hp-jlyt jlt
-application/vnd.hp-pcl pcl
-application/vnd.hp-pclxl pclxl
-application/vnd.httphone
-application/vnd.hzn-3d-crossword x3d
-application/vnd.ibm.afplinedata
-application/vnd.ibm.electronic-media
-application/vnd.ibm.minipay mpy
-application/vnd.ibm.modcap afp listafp list3820
-application/vnd.ibm.rights-management irm
-application/vnd.ibm.secure-container sc
-application/vnd.igloader igl
-application/vnd.immervision-ivp ivp
-application/vnd.immervision-ivu ivu
-application/vnd.informedcontrol.rms+xml
-application/vnd.intercon.formnet xpw xpx
-application/vnd.intertrust.digibox
-application/vnd.intertrust.nncp
-application/vnd.intu.qbo qbo
-application/vnd.intu.qfx qfx
-application/vnd.ipunplugged.rcprofile rcprofile
-application/vnd.irepository.package+xml irp
-application/vnd.is-xpr xpr
-application/vnd.jam jam
-application/vnd.japannet-directory-service
-application/vnd.japannet-jpnstore-wakeup
-application/vnd.japannet-payment-wakeup
-application/vnd.japannet-registration
-application/vnd.japannet-registration-wakeup
-application/vnd.japannet-setstore-wakeup
-application/vnd.japannet-verification
-application/vnd.japannet-verification-wakeup
-application/vnd.jcp.javame.midlet-rms rms
-application/vnd.jisp jisp
-application/vnd.kahootz ktz ktr
-application/vnd.kde.karbon karbon
-application/vnd.kde.kchart chrt
-application/vnd.kde.kformula kfo
-application/vnd.kde.kivio flw
-application/vnd.kde.kontour kon
-application/vnd.kde.kpresenter kpr kpt
-application/vnd.kde.kspread ksp
-application/vnd.kde.kword kwd kwt
-application/vnd.kenameaapp htke
-application/vnd.kidspiration kia
-application/vnd.kinar kne knp
-application/vnd.koan skp skd skt skm
-application/vnd.liberty-request+xml
-application/vnd.llamagraphics.life-balance.desktop lbd
-application/vnd.llamagraphics.life-balance.exchange+xml lbe
-application/vnd.lotus-1-2-3 123
-application/vnd.lotus-approach apr
-application/vnd.lotus-freelance pre
-application/vnd.lotus-notes nsf
-application/vnd.lotus-organizer org
-application/vnd.lotus-screencam scm
-application/vnd.lotus-wordpro lwp
-application/vnd.macports.portpkg portpkg
-application/vnd.marlin.drm.actiontoken+xml
-application/vnd.marlin.drm.conftoken+xml
-application/vnd.marlin.drm.mdcf
-application/vnd.mcd mcd
-application/vnd.medcalcdata mc1
-application/vnd.mediastation.cdkey cdkey
-application/vnd.meridian-slingshot
-application/vnd.mfer mwf
-application/vnd.mfmp mfm
-application/vnd.micrografx.flo flo
-application/vnd.micrografx.igx igx
-application/vnd.mif mif
-application/vnd.minisoft-hp3000-save
-application/vnd.mitsubishi.misty-guard.trustweb
-application/vnd.mobius.daf daf
-application/vnd.mobius.dis dis
-application/vnd.mobius.mbk mbk
-application/vnd.mobius.mqy mqy
-application/vnd.mobius.msl msl
-application/vnd.mobius.plc plc
-application/vnd.mobius.txf txf
-application/vnd.mophun.application mpn
-application/vnd.mophun.certificate mpc
-application/vnd.motorola.flexsuite
-application/vnd.motorola.flexsuite.adsi
-application/vnd.motorola.flexsuite.fis
-application/vnd.motorola.flexsuite.gotap
-application/vnd.motorola.flexsuite.kmr
-application/vnd.motorola.flexsuite.ttc
-application/vnd.motorola.flexsuite.wem
-application/vnd.mozilla.xul+xml xul
-application/vnd.ms-artgalry cil
-application/vnd.ms-asf asf
-application/vnd.ms-cab-compressed cab
-application/vnd.ms-excel xls xlm xla xlc xlt xlw
-application/vnd.ms-fontobject eot
-application/vnd.ms-htmlhelp chm
-application/vnd.ms-ims ims
-application/vnd.ms-lrm lrm
-application/vnd.ms-playready.initiator+xml
-application/vnd.ms-powerpoint ppt pps pot
-application/vnd.ms-project mpp mpt
-application/vnd.ms-tnef
-application/vnd.ms-wmdrm.lic-chlg-req
-application/vnd.ms-wmdrm.lic-resp
-application/vnd.ms-wmdrm.meter-chlg-req
-application/vnd.ms-wmdrm.meter-resp
-application/vnd.ms-works wps wks wcm wdb
-application/vnd.ms-wpl wpl
-application/vnd.ms-xpsdocument xps
-application/vnd.mseq mseq
-application/vnd.msign
-application/vnd.music-niff
-application/vnd.musician mus
-application/vnd.ncd.control
-application/vnd.nervana
-application/vnd.netfpx
-application/vnd.neurolanguage.nlu nlu
-application/vnd.noblenet-directory nnd
-application/vnd.noblenet-sealer nns
-application/vnd.noblenet-web nnw
-application/vnd.nokia.catalogs
-application/vnd.nokia.conml+wbxml
-application/vnd.nokia.conml+xml
-application/vnd.nokia.isds-radio-presets
-application/vnd.nokia.iptv.config+xml
-application/vnd.nokia.landmark+wbxml
-application/vnd.nokia.landmark+xml
-application/vnd.nokia.landmarkcollection+xml
-application/vnd.nokia.n-gage.ac+xml
-application/vnd.nokia.n-gage.data ngdat
-application/vnd.nokia.n-gage.symbian.install n-gage
-application/vnd.nokia.ncd
-application/vnd.nokia.pcd+wbxml
-application/vnd.nokia.pcd+xml
-application/vnd.nokia.radio-preset rpst
-application/vnd.nokia.radio-presets rpss
-application/vnd.novadigm.edm edm
-application/vnd.novadigm.edx edx
-application/vnd.novadigm.ext ext
-application/vnd.oasis.opendocument.chart odc
-application/vnd.oasis.opendocument.chart-template otc
-application/vnd.oasis.opendocument.formula odf
-application/vnd.oasis.opendocument.formula-template otf
-application/vnd.oasis.opendocument.graphics odg
-application/vnd.oasis.opendocument.graphics-template otg
-application/vnd.oasis.opendocument.image odi
-application/vnd.oasis.opendocument.image-template oti
-application/vnd.oasis.opendocument.presentation odp
-application/vnd.oasis.opendocument.presentation-template otp
-application/vnd.oasis.opendocument.spreadsheet ods
-application/vnd.oasis.opendocument.spreadsheet-template ots
-application/vnd.oasis.opendocument.text odt
-application/vnd.oasis.opendocument.text-master otm
-application/vnd.oasis.opendocument.text-template ott
-application/vnd.oasis.opendocument.text-web oth
-application/vnd.obn
-application/vnd.olpc-sugar xo
-application/vnd.oma-scws-config
-application/vnd.oma-scws-http-request
-application/vnd.oma-scws-http-response
-application/vnd.oma.bcast.associated-procedure-parameter+xml
-application/vnd.oma.bcast.drm-trigger+xml
-application/vnd.oma.bcast.imd+xml
-application/vnd.oma.bcast.notification+xml
-application/vnd.oma.bcast.sgboot
-application/vnd.oma.bcast.sgdd+xml
-application/vnd.oma.bcast.sgdu
-application/vnd.oma.bcast.simple-symbol-container
-application/vnd.oma.bcast.smartcard-trigger+xml
-application/vnd.oma.bcast.sprov+xml
-application/vnd.oma.dd2+xml dd2
-application/vnd.oma.drm.risd+xml
-application/vnd.oma.group-usage-list+xml
-application/vnd.oma.poc.groups+xml
-application/vnd.oma.xcap-directory+xml
-application/vnd.omads-email+xml
-application/vnd.omads-file+xml
-application/vnd.omads-folder+xml
-application/vnd.omaloc-supl-init
-application/vnd.openofficeorg.extension oxt
-application/vnd.osa.netdeploy
-application/vnd.osgi.dp dp
-application/vnd.otps.ct-kip+xml
-application/vnd.palm prc pdb pqa oprc
-application/vnd.paos.xml
-application/vnd.pg.format str
-application/vnd.pg.osasli ei6
-application/vnd.piaccess.application-licence
-application/vnd.picsel efif
-application/vnd.poc.group-advertisement+xml
-application/vnd.pocketlearn plf
-application/vnd.powerbuilder6 pbd
-application/vnd.powerbuilder6-s
-application/vnd.powerbuilder7
-application/vnd.powerbuilder7-s
-application/vnd.powerbuilder75
-application/vnd.powerbuilder75-s
-application/vnd.preminet
-application/vnd.previewsystems.box box
-application/vnd.proteus.magazine mgz
-application/vnd.publishare-delta-tree qps
-application/vnd.pvi.ptid1 ptid
-application/vnd.pwg-multiplexed
-application/vnd.pwg-xhtml-print+xml
-application/vnd.qualcomm.brew-app-res
-application/vnd.quark.quarkxpress qxd qxt qwd qwt qxl qxb
-application/vnd.rapid
-application/vnd.recordare.musicxml mxl
-application/vnd.recordare.musicxml+xml
-application/vnd.renlearn.rlprint
-application/vnd.rn-realmedia rm
-application/vnd.ruckus.download
-application/vnd.s3sms
-application/vnd.scribus
-application/vnd.sealed.3df
-application/vnd.sealed.csf
-application/vnd.sealed.doc
-application/vnd.sealed.eml
-application/vnd.sealed.mht
-application/vnd.sealed.net
-application/vnd.sealed.ppt
-application/vnd.sealed.tiff
-application/vnd.sealed.xls
-application/vnd.sealedmedia.softseal.html
-application/vnd.sealedmedia.softseal.pdf
-application/vnd.seemail see
-application/vnd.sema sema
-application/vnd.semd semd
-application/vnd.semf semf
-application/vnd.shana.informed.formdata ifm
-application/vnd.shana.informed.formtemplate itp
-application/vnd.shana.informed.interchange iif
-application/vnd.shana.informed.package ipk
-application/vnd.simtech-mindmapper twd twds
-application/vnd.smaf mmf
-application/vnd.solent.sdkm+xml sdkm sdkd
-application/vnd.spotfire.dxp dxp
-application/vnd.spotfire.sfs sfs
-application/vnd.sss-cod
-application/vnd.sss-dtf
-application/vnd.sss-ntf
-application/vnd.street-stream
-application/vnd.sun.wadl+xml
-application/vnd.sus-calendar sus susp
-application/vnd.svd svd
-application/vnd.swiftview-ics
-application/vnd.syncml+xml xsm
-application/vnd.syncml.dm+wbxml bdm
-application/vnd.syncml.dm+xml xdm
-application/vnd.syncml.ds.notification
-application/vnd.tao.intent-module-archive tao
-application/vnd.tmobile-livetv tmo
-application/vnd.trid.tpt tpt
-application/vnd.triscape.mxs mxs
-application/vnd.trueapp tra
-application/vnd.truedoc
-application/vnd.ufdl ufd ufdl
-application/vnd.uiq.theme utz
-application/vnd.umajin umj
-application/vnd.unity unityweb
-application/vnd.uoml+xml uoml
-application/vnd.uplanet.alert
-application/vnd.uplanet.alert-wbxml
-application/vnd.uplanet.bearer-choice
-application/vnd.uplanet.bearer-choice-wbxml
-application/vnd.uplanet.cacheop
-application/vnd.uplanet.cacheop-wbxml
-application/vnd.uplanet.channel
-application/vnd.uplanet.channel-wbxml
-application/vnd.uplanet.list
-application/vnd.uplanet.list-wbxml
-application/vnd.uplanet.listcmd
-application/vnd.uplanet.listcmd-wbxml
-application/vnd.uplanet.signal
-application/vnd.vcx vcx
-application/vnd.vd-study
-application/vnd.vectorworks
-application/vnd.vidsoft.vidconference
-application/vnd.visio vsd vst vss vsw
-application/vnd.visionary vis
-application/vnd.vividence.scriptfile
-application/vnd.vsf vsf
-application/vnd.wap.sic
-application/vnd.wap.slc
-application/vnd.wap.wbxml wbxml
-application/vnd.wap.wmlc wmlc
-application/vnd.wap.wmlscriptc wmlsc
-application/vnd.webturbo wtb
-application/vnd.wfa.wsc
-application/vnd.wordperfect wpd
-application/vnd.wqd wqd
-application/vnd.wrq-hp3000-labelled
-application/vnd.wt.stf stf
-application/vnd.wv.csp+wbxml
-application/vnd.wv.csp+xml
-application/vnd.wv.ssp+xml
-application/vnd.xara xar
-application/vnd.xfdl xfdl
-application/vnd.xmpie.cpkg
-application/vnd.xmpie.dpkg
-application/vnd.xmpie.plan
-application/vnd.xmpie.ppkg
-application/vnd.xmpie.xlim
-application/vnd.yamaha.hv-dic hvd
-application/vnd.yamaha.hv-script hvs
-application/vnd.yamaha.hv-voice hvp
-application/vnd.yamaha.smaf-audio saf
-application/vnd.yamaha.smaf-phrase spf
-application/vnd.yellowriver-custom-menu cmp
-application/vnd.zzazz.deck+xml zaz
-application/voicexml+xml vxml
-application/watcherinfo+xml
-application/whoispp-query
-application/whoispp-response
-application/winhlp hlp
-application/wita
-application/wordperfect5.1
-application/wsdl+xml wsdl
-application/wspolicy+xml wspolicy
-application/x-ace-compressed ace
-application/x-bcpio bcpio
-application/x-bittorrent torrent
-application/x-bzip bz
-application/x-bzip2 bz2 boz
-application/x-cdlink vcd
-application/x-chat chat
-application/x-chess-pgn pgn
-application/x-compress
-application/x-cpio cpio
-application/x-csh csh
-application/x-director dcr dir dxr fgd
-application/x-dvi dvi
-application/x-futuresplash spl
-application/x-gtar gtar
-application/x-gzip
-application/x-hdf hdf
-application/x-java-jnlp-file jnlp
-application/x-latex latex
-application/x-ms-wmd wmd
-application/x-ms-wmz wmz
-application/x-msaccess mdb
-application/x-msbinder obd
-application/x-mscardfile crd
-application/x-msclip clp
-application/x-msdownload exe dll com bat msi
-application/x-msmediaview mvb m13 m14
-application/x-msmetafile wmf
-application/x-msmoney mny
-application/x-mspublisher pub
-application/x-msschedule scd
-application/x-msterminal trm
-application/x-mswrite wri
-application/x-netcdf nc cdf
-application/x-pkcs12 p12 pfx
-application/x-pkcs7-certificates p7b spc
-application/x-pkcs7-certreqresp p7r
-application/x-rar-compressed rar
-application/x-sh sh
-application/x-shar shar
-application/x-shockwave-flash swf
-application/x-stuffit sit
-application/x-stuffitx sitx
-application/x-sv4cpio sv4cpio
-application/x-sv4crc sv4crc
-application/x-tar tar
-application/x-tcl tcl
-application/x-tex tex
-application/x-texinfo texinfo texi
-application/x-ustar ustar
-application/x-wais-source src
-application/x-x509-ca-cert der crt
-application/x400-bp
-application/xcap-att+xml
-application/xcap-caps+xml
-application/xcap-el+xml
-application/xcap-error+xml
-application/xcap-ns+xml
-application/xenc+xml xenc
-application/xhtml+xml xhtml xht
-application/xml xml xsl
-application/xml-dtd dtd
-application/xml-external-parsed-entity
-application/xmpp+xml
-application/xop+xml xop
-application/xslt+xml xslt
-application/xspf+xml xspf
-application/xv+xml mxml xhvml xvml xvm
-application/zip zip
-audio/32kadpcm
-audio/3gpp
-audio/3gpp2
-audio/ac3
-audio/amr
-audio/amr-wb
-audio/amr-wb+
-audio/asc
-audio/basic au snd
-audio/bv16
-audio/bv32
-audio/clearmode
-audio/cn
-audio/dat12
-audio/dls
-audio/dsr-es201108
-audio/dsr-es202050
-audio/dsr-es202211
-audio/dsr-es202212
-audio/dvi4
-audio/eac3
-audio/evrc
-audio/evrc-qcp
-audio/evrc0
-audio/evrc1
-audio/evrcb
-audio/evrcb0
-audio/evrcb1
-audio/g722
-audio/g7221
-audio/g723
-audio/g726-16
-audio/g726-24
-audio/g726-32
-audio/g726-40
-audio/g728
-audio/g729
-audio/g7291
-audio/g729d
-audio/g729e
-audio/gsm
-audio/gsm-efr
-audio/ilbc
-audio/l16
-audio/l20
-audio/l24
-audio/l8
-audio/lpc
-audio/midi mid midi kar rmi
-audio/mobile-xmf
-audio/mp4 mp4a
-audio/mp4a-latm m4a m4p
-audio/mpa
-audio/mpa-robust
-audio/mpeg mpga mp2 mp2a mp3 m2a m3a
-audio/mpeg4-generic
-audio/parityfec
-audio/pcma
-audio/pcmu
-audio/prs.sid
-audio/qcelp
-audio/red
-audio/rtp-enc-aescm128
-audio/rtp-midi
-audio/rtx
-audio/smv
-audio/smv0
-audio/smv-qcp
-audio/sp-midi
-audio/t140c
-audio/t38
-audio/telephone-event
-audio/tone
-audio/vdvi
-audio/vmr-wb
-audio/vnd.3gpp.iufp
-audio/vnd.4sb
-audio/vnd.audiokoz
-audio/vnd.celp
-audio/vnd.cisco.nse
-audio/vnd.cmles.radio-events
-audio/vnd.cns.anp1
-audio/vnd.cns.inf1
-audio/vnd.digital-winds eol
-audio/vnd.dlna.adts
-audio/vnd.dolby.mlp
-audio/vnd.everad.plj
-audio/vnd.hns.audio
-audio/vnd.lucent.voice lvp
-audio/vnd.nokia.mobile-xmf
-audio/vnd.nortel.vbk
-audio/vnd.nuera.ecelp4800 ecelp4800
-audio/vnd.nuera.ecelp7470 ecelp7470
-audio/vnd.nuera.ecelp9600 ecelp9600
-audio/vnd.octel.sbc
-audio/vnd.qcelp
-audio/vnd.rhetorex.32kadpcm
-audio/vnd.sealedmedia.softseal.mpeg
-audio/vnd.vmx.cvsd
-audio/wav wav
-audio/x-aiff aif aiff aifc
-audio/x-mpegurl m3u
-audio/x-ms-wax wax
-audio/x-ms-wma wma
-audio/x-pn-realaudio ram ra
-audio/x-pn-realaudio-plugin rmp
-audio/x-wav wav
-chemical/x-cdx cdx
-chemical/x-cif cif
-chemical/x-cmdf cmdf
-chemical/x-cml cml
-chemical/x-csml csml
-chemical/x-pdb pdb
-chemical/x-xyz xyz
-image/bmp bmp
-image/cgm cgm
-image/fits
-image/g3fax g3
-image/gif gif
-image/ief ief
-image/jp2 jp2
-image/jpeg jpeg jpg jpe
-image/jpm
-image/jpx
-image/naplps
-image/pict pict pic pct
-image/png png
-image/prs.btif btif
-image/prs.pti
-image/svg+xml svg svgz
-image/t38
-image/tiff tiff tif
-image/tiff-fx
-image/vnd.adobe.photoshop psd
-image/vnd.cns.inf2
-image/vnd.djvu djvu djv
-image/vnd.dwg dwg
-image/vnd.dxf dxf
-image/vnd.fastbidsheet fbs
-image/vnd.fpx fpx
-image/vnd.fst fst
-image/vnd.fujixerox.edmics-mmr mmr
-image/vnd.fujixerox.edmics-rlc rlc
-image/vnd.globalgraphics.pgb
-image/vnd.microsoft.icon ico
-image/vnd.mix
-image/vnd.ms-modi mdi
-image/vnd.net-fpx npx
-image/vnd.sealed.png
-image/vnd.sealedmedia.softseal.gif
-image/vnd.sealedmedia.softseal.jpg
-image/vnd.svf
-image/vnd.wap.wbmp wbmp
-image/vnd.xiff xif
-image/x-cmu-raster ras
-image/x-cmx cmx
-image/x-icon
-image/x-macpaint pntg pnt mac
-image/x-pcx pcx
-image/x-pict pic pct
-image/x-portable-anymap pnm
-image/x-portable-bitmap pbm
-image/x-portable-graymap pgm
-image/x-portable-pixmap ppm
-image/x-quicktime qtif qti
-image/x-rgb rgb
-image/x-xbitmap xbm
-image/x-xpixmap xpm
-image/x-xwindowdump xwd
-message/cpim
-message/delivery-status
-message/disposition-notification
-message/external-body
-message/http
-message/news
-message/partial
-message/rfc822 eml mime
-message/s-http
-message/sip
-message/sipfrag
-message/tracking-status
-model/iges igs iges
-model/mesh msh mesh silo
-model/vnd.dwf dwf
-model/vnd.flatland.3dml
-model/vnd.gdl gdl
-model/vnd.gs.gdl
-model/vnd.gtw gtw
-model/vnd.moml+xml
-model/vnd.mts mts
-model/vnd.parasolid.transmit.binary
-model/vnd.parasolid.transmit.text
-model/vnd.vtu vtu
-model/vrml wrl vrml
-multipart/alternative
-multipart/appledouble
-multipart/byteranges
-multipart/digest
-multipart/encrypted
-multipart/form-data
-multipart/header-set
-multipart/mixed
-multipart/parallel
-multipart/related
-multipart/report
-multipart/signed
-multipart/voice-message
-text/calendar ics ifb
-text/css css
-text/csv csv
-text/directory
-text/dns
-text/enriched
-text/html html htm
-text/parityfec
-text/plain txt text conf def list log in
-text/prs.fallenstein.rst
-text/prs.lines.tag dsc
-text/red
-text/rfc822-headers
-text/richtext rtx
-text/rtf
-text/rtp-enc-aescm128
-text/rtx
-text/sgml sgml sgm
-text/t140
-text/tab-separated-values tsv
-text/troff t tr roff man me ms
-text/uri-list uri uris urls
-text/vnd.abc
-text/vnd.curl
-text/vnd.dmclientscript
-text/vnd.esmertec.theme-descriptor
-text/vnd.fly fly
-text/vnd.fmi.flexstor flx
-text/vnd.in3d.3dml 3dml
-text/vnd.in3d.spot spot
-text/vnd.iptc.newsml
-text/vnd.iptc.nitf
-text/vnd.latex-z
-text/vnd.motorola.reflex
-text/vnd.ms-mediapackage
-text/vnd.net2phone.commcenter.command
-text/vnd.sun.j2me.app-descriptor jad
-text/vnd.trolltech.linguist
-text/vnd.wap.si
-text/vnd.wap.sl
-text/vnd.wap.wml wml
-text/vnd.wap.wmlscript wmls
-text/x-asm s asm
-text/x-c c cc cxx cpp h hh dic
-text/x-fortran f for f77 f90
-text/x-pascal p pas
-text/x-java-source java
-text/x-setext etx
-text/x-uuencode uu
-text/x-vcalendar vcs
-text/x-vcard vcf
-text/xml
-text/xml-external-parsed-entity
-video/3gpp 3gp
-video/3gpp-tt
-video/3gpp2 3g2
-video/bmpeg
-video/bt656
-video/celb
-video/dv
-video/h261 h261
-video/h263 h263
-video/h263-1998
-video/h263-2000
-video/h264 h264
-video/jpeg jpgv
-video/jpm jpm jpgm
-video/mj2 mj2 mjp2
-video/mp1s
-video/mp2p
-video/mp2t
-video/mp4 mp4 mp4v mpg4 m4v
-video/mp4v-es
-video/mpeg mpeg mpg mpe m1v m2v
-video/mpeg4-generic
-video/mpv
-video/nv
-video/parityfec
-video/pointer
-video/quicktime qt mov
-video/raw
-video/rtp-enc-aescm128
-video/rtx
-video/smpte292m
-video/vc1
-video/vnd.dlna.mpeg-tts
-video/vnd.fvt fvt
-video/vnd.hns.video
-video/vnd.motorola.video
-video/vnd.motorola.videop
-video/vnd.mpegurl mxu m4u
-video/vnd.nokia.interleaved-multimedia
-video/vnd.nokia.videovoip
-video/vnd.objectvideo
-video/vnd.sealed.mpeg1
-video/vnd.sealed.mpeg4
-video/vnd.sealed.swf
-video/vnd.sealedmedia.softseal.mov
-video/vnd.vivo viv
-video/x-dv dv dif
-video/x-fli fli
-video/x-ms-asf asf asx
-video/x-ms-wm wm
-video/x-ms-wmv wmv
-video/x-ms-wmx wmx
-video/x-ms-wvx wvx
-video/x-msvideo avi
-video/x-sgi-movie movie
-x-conference/x-cooltalk ice
--- /dev/null
+Doug Coleman
--- /dev/null
+USING: accessors io io.streams.string kernel mime.multipart
+tools.test make multiline strings ;
+IN: mime.multipart.tests
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+
+[ { "a" "a" f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+
+
+[ { "a" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "zz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" "zz" } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "az" "zb" "zz" "cz" "zd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "a" "zzb" "zzc" "zzd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "az" "zbzz" "czzd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+[ { "azz" "bzzcz" "zd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-step-loop drop
+ ] { } make
+] unit-test
+
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+
+[ { "a" "a" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+ [
+ "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+
+
+[ { "a" f "b" f "c" f "d" f } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "zz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" "zz" } ] [
+ [
+ "azzbzzczzdzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "az" "zb" "zz" "cz" "zd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 2 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "a" "zzb" "zzc" "zzd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 3 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "az" "zbzz" "czzd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 4 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+[ { "azz" "bzzcz" "zd" f } ] [
+ [
+ "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 5 >>n
+ [ , ] [ ] multipart-loop-all
+ ] { } make
+] unit-test
+
+
+: dog-upload ( -- string )
+ B{
+ 45 45 45 45 45 45 87 101 98 75 105 116 70 111 114 109 66
+ 111 117 110 100 97 114 121 115 105 103 113 43 53 113 87 116
+ 54 79 114 122 56 76 79 13 10 67 111 110 116 101 110 116 45
+ 68 105 115 112 111 115 105 116 105 111 110 58 32 102 111
+ 114 109 45 100 97 116 97 59 32 110 97 109 101 61 34 102 105
+ 108 101 34 59 32 102 105 108 101 110 97 109 101 61 34 100
+ 111 103 46 106 112 103 34 13 10 67 111 110 116 101 110 116
+ 45 84 121 112 101 58 32 105 109 97 103 101 47 106 112 101
+ 103 13 10 13 10 253 253 253 253 0 16 74 70 73 70 0 1 1 0 0
+ 1 0 1 0 0 253 253 0 67 0 5 3 4 4 4 3 5 4 4 4 5 5 5 6 7 12 8
+ 7 7 7 7 15 11 11 9 12 17 15 18 18 17 15 17 17 19 22 28 23
+ 19 20 26 21 17 17 24 33 24 26 29 29 31 31 31 19 23 34 36 34
+ 30 36 28 30 31 30 253 253 0 67 1 5 5 5 7 6 7 14 8 8 14 30
+ 20 17 20 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
+ 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
+ 30 30 30 30 30 30 30 30 30 30 30 30 30 253 253 0 17 8 1 49
+ 1 64 3 1 34 0 2 17 1 3 17 1 253 253 0 29 0 0 2 2 3 1 1 1 0
+ 0 0 0 0 0 0 0 0 4 5 6 7 2 3 8 0 1 9 253 253 0 74 16 0 2 1 3
+ 3 2 4 4 3 4 5 10 5 3 5 1 1 2 3 0 4 17 5 18 33 6 49 19 34 65
+ 81 7 50 97 113 20 35 253 21 51 66 82 36 52 253 253 253 8 53
+ 83 98 114 115 253 253 253 253 22 37 67 116 253 99 253 253
+ 23 68 84 100 253 253 253 253 0 25 1 0 3 1 1 1 0 0 0 0 0 0 0
+ 0 0 0 0 1 2 3 0 4 5 253 253 0 39 17 0 2 2 2 2 3 0 2 1 5 1 0
+ 0 0 0 0 0 1 2 17 3 33 18 49 34 50 65 19 81 4 5 20 35 66 97
+ 82 253 253 0 12 3 1 0 2 17 3 17 0 63 0 253 253 253 253 253
+ 253 253 253 253 68 253 253 112 60 21 45 253 91 253 57 253
+ 253 253 75 56 95 111 253 253 51 253 253 11 253 253 14 118
+ 253 22 253 253 104 253 118 82 46 253 45 253 98 79 253 102
+ 253 38 253 98 253 64 253 253 72 253 49 46 104 11 8 253 111
+ 253 253 253 253 70 253 12 253 112 61 253 57 36 253 31 82 7
+ 253 253 78 253 253 253 253 0 253 41 100 253 76 15 253 253
+ 118 60 31 253 85 253 126 253 253 253 253 253 253 113 253 66
+ 253 253 253 82 74 49 45 253 253 42 49 253 253 253 108 253
+ 99 21 68 253 88 116 253 83 17 253 253 253 253 109 253 253
+ 253 6 253 83 253 109 1 253 115 253 10 253 90 106 23 106 253
+ 95 59 73 253 253 77 44 111 89 79 253 24 253 253 253 253 86
+ 253 253 71 253 20 52 253 253 253 24 253 253 253 253 61 253
+ 66 253 65 253 253 253 64 253 5 253 127 253 45 3 99 42 253
+ 42 253 253 79 253 83 253 38 86 92 21 57 20 76 253 253 78
+ 253 98 88 31 253 253 125 253 253 45 108 253 253 97 253 0
+ 253 44 253 0 253 45 22 253 253 253 253 99 88 74 98 77 99 78
+ 253 69 111 14 253 253 23 28 253 48 15 253 253 30 253 21 253
+ 105 8 253 253 103 253 253 253 253 121 253 127 253 87 253
+ 253 253 253 31 253 253 253 253 253 28 88 253 253 120 99 253
+ 52 100 253 0 253 253 253 253 108 109 11 103 253 253 127 253
+ 253 118 82 71 253 47 253 253 253 11 253 30 74 81 253 102
+ 253 253 35 253 97 104 62 253 46 104 41 45 109 119 127 86
+ 253 253 21 48 253 253 9 253 104 105 253 24 118 53 76 77 81
+ 253 73 105 109 253 253 253 127 253 21 253 89 253 110 63 253
+ 97 253 0 253 69 65 253 110 15 39 253 253 253 253 253 41 6
+ 253 102 5 22 54 253 114 109 45 253 123 24 253 53 253 45 44
+ 253 253 79 253 253 253 253 253 118 101 112 253 253 253 102
+ 253 253 253 35 253 99 95 253 253 119 253 253 253 253 253 21
+ 18 253 125 253 92 253 2 253 253 16 253 15 253 253 253 71 46
+ 253 253 106 253 78 253 40 253 253 109 83 33 45 253 253 253
+ 253 253 253 253 253 30 253 253 69 45 37 253 253 253 253 12
+ 253 253 253 253 253 253 253 8 75 123 253 15 69 96 7 253 253
+ 253 253 253 31 253 253 253 253 253 102 120 253 0 68 253 253
+ 253 253 12 15 253 253 253 253 253 253 253 253 253 253 253
+ 253 7 253 123 80 253 253 253 118 253 66 253 253 118 62 253
+ 253 253 38 91 55 253 253 253 253 60 253 22 96 14 253 253
+ 107 84 253 69 253 253 253 253 100 253 0 65 18 253 43 253 82
+ 105 253 253 108 64 253 31 102 253 253 253 253 253 253 253
+ 39 253 73 38 50 84 253 253 112 253 19 253 4 118 54 253 253
+ 22 33 68 54 253 253 52 96 253 253 253 15 115 16 253 66 253
+ 253 77 253 253 40 115 253 90 253 91 73 253 116 253 29 253
+ 77 253 253 253 253 46 64 109 253 88 45 253 31 253 253 92
+ 127 253 253 19 97 99 253 16 253 125 253 253 63 253 20 100
+ 253 56 253 253 253 66 84 253 253 253 253 253 253 253 125 18
+ 253 125 253 253 108 72 7 253 125 253 63 253 45 109 253 77
+ 253 253 253 111 253 253 0 253 253 68 76 253 253 253 51 253
+ 103 43 0 253 253 253 253 72 253 253 54 113 253 5 91 120 50
+ 59 253 77 7 120 109 253 48 22 8 1 253 253 98 253 106 253
+ 253 253 45 253 253 253 93 41 97 253 253 73 97 253 96 19 253
+ 103 253 253 23 253 253 253 71 253 93 253 253 110 117 101 67
+ 90 253 253 253 55 253 97 253 253 37 122 124 253 253 48 118
+ 253 253 81 66 116 253 82 123 2 253 103 108 55 30 99 31 253
+ 253 253 253 63 56 253 253 253 253 26 90 253 253 56 20 109
+ 253 253 89 16 253 253 80 253 253 80 49 253 110 253 63 253
+ 253 253 107 74 62 44 253 36 253 253 17 253 253 253 253 26
+ 253 253 253 253 21 40 253 113 253 253 253 253 253 53 253
+ 253 63 253 57 253 253 85 55 253 34 5 87 126 124 253 123 26
+ 253 15 253 253 42 253 59 108 123 112 51 27 14 253 90 253 61
+ 68 253 253 253 253 58 35 7 253 253 57 253 253 253 91 25 82
+ 71 24 253 0 253 44 253 253 21 253 99 16 253 120 253 253 253
+ 97 253 253 99 81 253 5 253 74 253 253 29 253 253 253 99 121
+ 253 253 80 127 253 253 253 22 253 96 121 19 84 253 253 253
+ 253 77 106 61 62 253 25 35 114 253 253 1 253 43 253 253 253
+ 72 71 24 56 253 125 107 253 253 253 253 253 253 93 61 253
+ 35 76 253 42 43 253 253 253 253 253 58 123 85 253 9 37 67
+ 103 63 74 117 39 123 37 253 26 110 253 20 14 64 53 253 253
+ 253 253 22 253 21 253 253 111 83 69 22 80 72 253 89 253 103
+ 61 253 253 117 60 253 121 15 253 253 253 253 8 23 253 253
+ 253 253 253 253 36 253 11 253 253 28 85 123 253 253 93 64
+ 253 57 52 99 32 253 45 89 253 15 253 253 253 46 253 253 60
+ 253 253 48 43 69 253 253 24 253 109 253 61 253 21 57 118 96
+ 253 57 92 253 52 43 253 253 253 126 253 68 18 3 88 253 253
+ 253 253 108 253 253 8 107 64 62 65 253 253 253 253 91 25
+ 253 253 39 38 253 253 99 253 122 253 112 253 118 59 253 83
+ 253 114 54 59 46 253 253 89 39 253 90 93 89 88 115 253 110
+ 64 74 113 83 253 253 5 59 62 253 35 253 253 16 253 253 124
+ 109 253 123 253 253 19 13 253 35 38 253 253 69 62 253 105
+ 253 253 0 253 253 85 253 253 82 253 253 253 60 103 253 77
+ 253 253 253 66 253 98 253 253 82 253 73 24 253 45 34 81 253
+ 253 75 44 253 253 7 114 72 110 253 253 36 73 12 42 253 253
+ 253 253 73 52 253 253 253 253 253 253 253 253 113 253 253
+ 49 253 90 253 124 40 253 122 110 253 253 253 65 66 12 48
+ 253 253 253 94 54 253 61 253 253 94 28 123 10 253 10 78 59
+ 253 253 109 253 58 253 8 253 253 253 253 19 73 53 253 86 80
+ 253 253 253 1 253 107 253 253 77 101 105 103 51 253 253 36
+ 253 24 25 39 253 0 253 93 18 253 253 18 253 253 253 30 253
+ 253 85 253 253 109 39 253 253 253 253 110 8 253 253 253 253
+ 253 253 253 14 253 253 27 66 253 60 46 54 110 5 72 31 253
+ 82 253 57 253 72 253 253 253 64 253 70 127 253 13 253 253
+ 107 253 253 253 5 253 91 253 253 253 58 75 253 253 48 72 36
+ 47 117 253 71 39 113 4 23 253 253 253 253 96 100 114 107 24
+ 253 253 126 62 253 253 101 57 253 253 89 70 6 7 2 253 253
+ 35 253 71 102 253 84 40 253 253 110 57 38 253 253 3 253 86
+ 19 1 253 253 253 253 253 34 253 253 253 253 100 253 253 253
+ 52 121 77 253 253 253 67 117 253 253 253 253 253 17 253 81
+ 253 253 116 52 72 253 253 253 253 21 253 253 126 30 79 76
+ 46 253 62 253 16 27 253 7 34 55 253 55 63 253 116 253 253
+ 118 253 117 253 253 127 253 253 253 253 15 13 127 253 253
+ 16 10 253 253 253 69 43 253 253 253 88 23 253 71 70 32 110
+ 253 253 253 253 25 99 99 253 78 127 253 253 253 253 253 253
+ 253 253 86 35 253 253 42 253 253 253 253 50 65 253 253 53 9
+ 89 253 253 253 253 253 253 253 253 54 61 100 68 118 253 86
+ 253 89 253 253 121 253 72 1 2 253 253 253 253 253 253 70
+ 253 253 28 253 253 253 253 253 253 92 253 253 253 87 23 253
+ 92 253 253 253 253 253 121 253 253 107 253 253 103 253 253
+ 35 253 253 253 253 84 6 99 253 85 36 253 34 253 98 253 34
+ 100 89 89 253 43 6 97 253 35 253 253 95 94 86 17 2 253 56
+ 253 105 119 253 253 253 253 253 39 253 253 27 253 16 95 113
+ 79 95 253 16 253 30 253 253 253 11 253 60 253 59 253 75 253
+ 103 77 91 253 58 101 253 253 253 253 253 253 253 253 78 97
+ 253 253 253 253 253 10 31 65 253 253 253 100 253 21 253 253
+ 253 29 253 5 87 253 253 110 253 109 31 80 253 36 111 32 39
+ 57 253 57 253 77 253 253 92 69 253 253 49 253 126 253 105
+ 124 86 253 27 125 70 22 253 253 253 9 2 253 253 253 53 76
+ 66 38 253 253 65 109 48 111 8 253 18 123 81 253 20 253 253
+ 101 253 253 253 253 94 253 14 253 105 27 253 106 253 253 20
+ 11 253 125 51 253 253 253 70 253 253 104 253 87 28 85 117
+ 117 253 117 253 253 253 84 87 253 253 26 253 108 253 5 3
+ 253 77 253 78 253 74 253 253 253 7 253 115 18 253 253 253
+ 253 33 27 48 253 64 24 26 253 126 13 108 253 253 253 253 9
+ 253 79 106 26 92 253 253 253 253 253 93 253 124 253 48 107
+ 34 253 39 253 253 253 0 253 122 253 253 253 253 253 65 253
+ 253 27 253 24 253 101 253 40 253 253 253 49 253 90 109 85
+ 29 124 253 253 253 253 19 28 98 253 123 253 253 64 46 253
+ 13 122 22 253 39 28 253 253 86 253 253 4 19 90 1 253 253 50
+ 28 253 253 52 91 253 253 55 253 62 253 56 91 68 253 88 110
+ 253 30 253 37 253 49 253 253 106 58 253 51 73 253 253 119
+ 19 253 253 253 253 61 253 253 253 12 253 253 79 253 57 32
+ 253 253 51 253 253 90 253 65 253 253 253 8 253 0 51 104 46
+ 125 106 115 253 78 253 124 17 113 253 253 37 26 85 253 122
+ 109 253 113 68 253 96 49 253 253 125 253 253 85 59 90 64
+ 119 124 253 253 253 43 5 43 253 31 79 253 10 253 36 44 26
+ 70 253 253 253 30 253 253 253 253 253 253 253 10 253 98 253
+ 253 253 253 253 253 253 28 253 253 88 122 253 253 253 253
+ 253 52 253 253 88 98 253 253 253 253 36 46 112 15 53 253 56
+ 253 253 65 253 0 253 77 253 253 69 253 118 253 253 253 54
+ 118 253 253 253 116 73 72 253 253 253 253 253 253 253 31
+ 253 22 18 253 26 36 253 2 72 21 60 253 64 253 253 253 106
+ 253 253 67 38 253 37 36 253 253 51 90 91 253 253 104 253 13
+ 18 253 253 253 253 127 46 43 5 253 253 253 253 55 127 253
+ 253 253 43 85 253 100 253 253 253 94 71 20 253 253 103 23
+ 43 253 125 253 84 253 253 253 253 253 253 43 100 253 40 253
+ 9 22 253 253 45 253 253 253 253 253 253 40 93 79 253 67 62
+ 253 253 22 253 253 1 253 96 53 98 253 253 12 253 253 253
+ 253 3 253 102 81 253 71 82 41 99 12 59 253 74 117 91 114 45
+ 253 117 31 253 103 253 253 253 253 253 45 55 44 17 99 253
+ 29 23 12 253 28 6 3 20 20 19 127 71 253 253 253 42 253 28
+ 253 253 7 253 253 103 253 253 0 253 253 253 253 120 253 3
+ 12 12 253 69 111 253 253 253 253 66 253 36 253 90 253 253
+ 253 253 253 253 74 253 89 253 67 123 11 6 57 253 21 63 253
+ 253 253 68 253 253 110 253 102 253 253 253 253 253 253 60
+ 253 253 253 253 253 253 253 253 253 253 253 15 25 253 253
+ 253 39 253 43 63 15 79 19 76 7 253 253 253 253 253 30 253
+ 50 253 43 42 253 48 253 253 253 253 253 55 253 71 253 253
+ 97 253 253 28 99 253 253 69 117 30 253 31 105 30 253 253 46
+ 253 253 75 253 253 253 253 253 253 60 253 70 253 253 80 253
+ 253 75 253 34 253 101 253 54 253 25 102 253 55 70 35 3 253
+ 118 253 108 39 87 253 66 253 108 61 253 253 253 253 253 119
+ 82 49 253 253 253 123 10 253 253 82 89 36 88 253 253 38 253
+ 121 37 76 253 253 253 123 36 253 253 253 253 253 20 253 60
+ 61 253 253 72 253 253 127 253 23 70 253 253 253 253 253 253
+ 107 103 253 253 253 253 70 86 253 66 28 253 3 253 26 58 253
+ 253 43 253 66 92 66 253 79 253 115 253 108 56 253 253 105
+ 253 115 105 60 253 253 253 23 80 253 253 71 5 253 122 253
+ 253 253 253 29 253 42 253 22 253 253 253 253 253 253 253
+ 253 70 253 45 21 81 253 253 253 10 253 253 253 71 253 253
+ 77 253 49 8 253 84 253 253 35 253 93 112 253 253 253 253 60
+ 93 253 116 37 253 39 10 0 126 41 253 119 81 1 253 253 22
+ 120 253 35 92 253 253 253 253 253 253 33 253 253 65 87 253
+ 253 13 50 87 253 253 253 253 126 253 253 253 253 253 253 10
+ 253 46 253 253 115 253 72 253 253 253 41 253 253 253 67 253
+ 9 51 12 253 253 114 253 82 120 106 56 113 80 253 253 72 88
+ 5 76 31 253 20 253 253 253 253 253 253 253 50 102 37 118
+ 253 253 253 253 253 253 253 18 71 253 253 253 253 84 119
+ 253 1 73 253 49 253 253 253 253 110 253 253 106 253 253 104
+ 253 74 29 253 253 253 253 29 253 89 253 58 77 253 253 253
+ 253 20 112 253 253 125 253 6 253 253 253 75 253 253 65 36
+ 113 253 253 9 0 253 253 15 253 253 19 79 253 253 79 42 25
+ 253 253 253 31 74 76 253 253 71 84 49 253 253 253 253 68
+ 253 253 253 253 253 6 253 56 86 28 253 253 45 253 253 253
+ 253 66 253 30 61 253 253 253 253 253 253 26 15 40 39 253
+ 253 107 253 22 253 253 46 37 36 124 253 127 253 253 83 91
+ 118 86 253 253 253 14 253 253 253 103 253 253 253 253 253
+ 253 253 48 86 39 253 253 253 253 253 253 253 56 17 91 253
+ 253 81 253 17 88 53 253 253 253 28 114 56 92 122 253 253 27
+ 253 253 253 253 24 253 253 253 43 85 253 50 253 14 15 36
+ 253 87 109 34 253 27 253 121 253 54 108 253 253 12 118 253
+ 82 253 253 253 112 253 253 253 253 253 253 77 30 118 120
+ 253 253 253 253 122 253 48 107 54 253 103 253 253 253 253
+ 253 253 253 253 253 253 253 253 101 109 50 82 253 253 253
+ 253 253 115 71 253 11 55 253 253 253 88 253 17 253 253 1
+ 253 253 253 253 57 102 253 68 107 48 54 253 27 24 253 68 15
+ 114 49 253 253 253 253 19 37 253 253 38 253 253 120 10 253
+ 253 86 253 253 108 253 123 9 253 253 253 253 253 253 253
+ 253 59 253 253 70 49 253 73 253 253 91 80 99 253 253 62 253
+ 253 253 253 111 253 75 253 24 253 253 253 253 90 109 103 31
+ 253 97 253 115 84 253 28 253 40 253 253 117 253 100 12 118
+ 253 253 253 253 253 92 48 253 34 39 253 253 253 253 14 24
+ 253 49 64 253 253 253 78 253 87 253 253 61 43 84 253 253 94
+ 55 253 253 253 253 253 61 253 253 89 101 253 16 108 61 253
+ 253 253 253 253 253 11 253 253 253 253 91 253 253 253 100
+ 86 32 119 253 109 80 30 253 95 79 253 253 30 253 253 253
+ 253 127 18 253 0 101 110 253 23 253 43 253 253 107 253 5
+ 253 253 30 119 29 253 54 44 125 253 127 253 28 119 253 73
+ 72 253 253 40 253 60 31 122 253 253 253 253 38 253 253 3 32
+ 253 119 253 21 253 253 253 12 253 67 115 253 84 253 91 253
+ 253 97 89 64 253 32 253 84 253 253 119 67 253 253 53 253 38
+ 253 30 25 253 112 253 29 69 63 48 253 73 253 65 253 83 13
+ 65 48 37 1 124 253 253 253 55 61 253 40 20 109 253 253 90
+ 253 253 4 253 78 253 70 24 83 253 253 80 253 253 69 16 253
+ 14 14 87 253 104 11 253 104 253 90 118 5 84 253 253 125 253
+ 253 126 253 253 21 253 253 69 253 4 103 13 253 253 253 253
+ 253 70 55 253 38 88 253 39 253 13 253 253 34 253 33 253 253
+ 253 253 253 253 253 253 121 253 85 1 97 253 112 253 90 253
+ 90 253 253 253 64 27 45 253 253 127 253 253 253 253 253 98
+ 253 253 253 253 77 253 253 99 70 253 253 253 99 253 253 253
+ 43 123 77 62 84 37 70 88 253 53 253 253 20 122 253 253 253
+ 127 253 100 102 12 71 7 253 253 253 253 80 253 253 123 253
+ 93 92 253 90 92 48 253 126 11 3 85 253 253 52 253 72 253 36
+ 253 253 253 125 105 253 26 253 253 253 253 253 48 75 253 26
+ 50 253 31 253 253 86 253 253 253 120 114 70 67 253 253 253
+ 253 123 78 253 253 253 25 60 57 29 36 94 123 112 125 253 77
+ 253 116 253 253 253 253 92 70 3 69 253 253 14 72 30 253 94
+ 253 253 70 42 93 253 70 127 3 111 32 5 253 28 253 30 253
+ 253 13 46 253 253 24 7 253 106 253 253 253 39 253 253 25
+ 253 2 253 110 1 253 253 253 45 253 253 253 22 112 6 10 253
+ 253 253 253 25 79 253 83 113 90 253 43 253 253 253 253 253
+ 253 253 253 253 38 69 97 253 253 90 253 253 253 91 253 253
+ 85 253 18 253 103 7 253 253 253 253 253 68 74 253 253 104
+ 253 253 253 253 253 51 108 73 97 253 253 2 110 35 93 253
+ 253 253 253 253 253 22 253 253 75 253 79 49 253 253 253 76
+ 253 253 253 253 30 253 253 253 116 253 113 19 253 19 253
+ 253 87 118 253 253 66 253 253 113 253 253 0 84 123 26 253
+ 253 17 253 79 253 58 87 253 47 85 90 20 253 99 120 253 253
+ 48 253 7 253 253 44 253 72 110 33 115 28 253 253 253 107
+ 253 253 73 253 253 13 34 253 43 253 91 253 86 86 253 103
+ 253 43 253 253 21 117 253 253 253 253 253 52 253 253 253 42
+ 79 57 253 101 253 253 253 89 37 47 253 253 123 62 27 253
+ 253 66 253 253 253 253 87 72 253 253 253 253 31 253 253 83
+ 11 125 67 253 86 98 67 253 253 92 253 119 20 253 85 253 97
+ 108 253 253 253 124 118 253 253 253 7 253 53 253 253 77 253
+ 253 8 253 253 106 253 5 122 9 94 253 253 34 253 253 253 119
+ 94 29 253 113 253 108 89 253 253 11 127 16 253 111 253 21
+ 253 69 35 253 253 253 253 3 253 253 253 253 253 253 253 41
+ 253 253 109 86 72 253 253 99 253 32 253 21 50 253 67 51 13
+ 253 70 253 253 253 253 91 1 54 253 253 79 106 253 105 49 31
+ 46 253 1 253 253 91 125 253 253 253 253 114 253 253 87 253
+ 253 253 96 31 253 115 103 253 23 118 253 253 36 82 253 55
+ 253 253 90 253 47 253 253 253 39 25 59 121 253 253 109 253
+ 0 40 116 120 110 253 253 99 119 97 84 253 253 253 101 253
+ 253 88 15 19 77 12 127 74 253 28 124 80 253 50 40 253 253
+ 70 70 70 253 125 40 253 124 40 253 106 253 253 253 253 89
+ 109 253 34 93 253 253 112 118 10 12 51 23 28 26 253 253 16
+ 253 253 253 253 40 253 253 18 63 253 115 121 30 61 253 253
+ 253 253 69 44 253 124 253 41 253 253 253 54 253 55 253 49
+ 253 27 253 25 253 253 253 105 102 253 24 91 9 253 253 253
+ 63 20 253 94 35 253 253 5 253 47 253 9 253 0 253 61 43 70
+ 54 253 253 253 253 253 101 33 79 253 35 103 253 253 52 113
+ 253 253 253 253 253 37 253 253 253 253 22 253 26 253 108 64
+ 22 253 14 253 76 115 74 253 253 76 253 253 253 120 253 253
+ 25 116 253 30 253 114 253 253 115 253 253 103 253 2 69 22
+ 253 42 253 41 38 15 253 97 253 253 104 253 109 253 253 253
+ 70 52 253 253 83 253 253 253 73 253 253 103 65 124 33 253
+ 253 253 106 18 99 120 253 121 253 106 253 253 50 253 253
+ 103 80 95 24 21 0 253 17 121 29 253 79 253 27 253 253 7 253
+ 253 253 45 63 253 253 72 253 83 28 87 61 118 253 253 63 34
+ 5 253 47 253 253 113 35 253 123 82 11 253 21 253 11 24 253
+ 71 114 106 73 253 90 72 253 253 27 21 253 124 122 253 102
+ 253 53 253 253 253 253 0 61 253 37 89 253 29 253 53 75 253
+ 111 21 13 253 253 108 112 91 253 253 253 97 109 58 34 253
+ 18 253 253 97 253 25 253 253 253 253 126 253 253 82 253 33
+ 117 253 253 5 91 253 253 74 81 38 253 119 253 23 253 253 13
+ 36 64 111 253 253 120 107 68 253 77 253 59 253 253 99 253
+ 253 109 253 253 81 253 121 253 253 253 84 253 253 253 253
+ 55 119 18 90 253 253 253 253 253 253 107 253 79 253 32 253
+ 253 24 33 253 253 3 253 253 85 253 253 17 253 253 44 253
+ 116 39 42 87 253 253 106 253 77 253 83 253 61 31 45 253 253
+ 253 1 102 27 100 118 253 29 253 253 21 253 253 253 253 253
+ 117 88 99 32 253 102 0 253 79 253 253 253 114 253 253 91
+ 253 253 253 31 106 253 62 29 116 253 253 253 14 253 253 253
+ 115 253 253 253 79 253 253 85 23 253 253 40 253 116 253 93
+ 13 253 253 94 74 18 253 253 114 14 72 92 253 106 253 253 14
+ 253 253 253 253 253 49 253 253 72 253 253 253 48 253 30 253
+ 253 253 253 47 24 253 253 57 97 253 253 253 253 253 85 253
+ 253 100 34 253 253 57 28 122 253 102 253 253 58 97 20 253
+ 253 253 253 253 253 253 72 103 253 253 253 253 253 28 17 78
+ 83 253 253 253 4 253 96 7 111 126 253 58 253 108 253 90 253
+ 40 253 253 253 253 253 253 253 77 253 54 253 110 34 253 253
+ 113 123 101 115 115 253 253 253 101 253 253 113 81 253 106
+ 35 253 61 46 253 253 44 118 104 3 38 253 253 253 253 253
+ 253 253 45 253 101 119 0 9 35 253 41 14 253 104 253 73 101
+ 10 253 253 253 119 253 50 253 89 253 253 87 253 48 77 60
+ 253 253 110 253 253 253 253 1 253 253 253 253 253 253 253
+ 22 253 86 75 117 253 95 31 253 253 114 106 253 69 253 253
+ 52 71 111 57 46 113 253 253 253 253 253 253 253 253 110 90
+ 253 253 94 253 22 253 253 126 253 253 253 45 253 81 253 253
+ 253 253 105 35 253 253 253 41 67 253 122 15 253 253 253 253
+ 66 77 47 82 51 89 54 17 78 55 19 253 125 253 253 94 105 253
+ 253 253 22 253 16 253 44 124 64 125 90 253 253 253 253 253
+ 102 253 70 62 253 31 253 94 124 90 57 84 253 54 116 39 253
+ 253 253 253 253 78 253 124 92 52 99 12 24 253 84 253 125 74
+ 253 253 22 13 253 35 12 7 253 125 15 253 253 253 65 253 253
+ 253 253 253 12 253 253 253 253 253 253 30 253 253 66 253
+ 253 114 253 253 253 253 253 253 253 253 104 57 61 253 45
+ 253 253 48 52 253 253 253 34 253 37 253 67 26 253 81 253 61
+ 253 253 253 49 100 85 253 112 63 90 253 45 253 253 253 253
+ 79 82 37 80 253 253 102 253 26 9 253 67 120 253 72 85 91
+ 253 72 253 114 59 253 253 18 88 253 116 253 253 253 253 98
+ 253 253 66 253 253 253 253 31 74 253 253 253 253 253 35 253
+ 253 253 253 253 253 118 253 110 253 97 23 253 49 73 253 253
+ 54 253 29 92 253 253 253 109 253 115 253 253 253 87 51 253
+ 0 253 20 253 13 253 120 78 253 124 253 253 253 253 253 253
+ 27 123 23 50 76 82 69 253 253 253 92 253 253 253 253 253 93
+ 84 253 43 29 253 253 55 253 253 253 83 103 14 94 253 60 113
+ 50 75 18 253 79 253 253 52 94 253 2 253 253 253 253 84 253
+ 50 253 253 253 7 253 253 118 12 253 253 253 18 75 71 56 79
+ 253 25 101 81 253 99 253 253 253 253 253 27 253 253 253 74
+ 24 253 253 24 112 43 253 32 253 41 253 253 8 253 86 62 48
+ 253 253 253 253 93 253 45 3 253 253 253 253 253 90 105 253
+ 46 97 24 253 253 72 253 115 253 16 41 253 253 58 253 99 253
+ 93 28 124 253 57 31 253 76 253 70 35 253 64 253 8 253 253
+ 47 121 253 0 253 253 253 0 45 82 49 253 253 58 116 91 253
+ 253 253 253 253 253 253 53 35 105 60 253 253 71 253 59 111
+ 253 99 253 253 253 39 120 253 253 115 61 253 58 49 253 62
+ 253 27 106 40 253 11 253 253 253 253 90 52 110 112 15 124
+ 253 80 253 59 253 60 253 253 93 253 52 5 27 253 123 98 253
+ 253 253 253 121 123 23 111 253 253 25 19 253 253 253 25 253
+ 25 253 253 253 123 253 253 253 253 6 72 253 55 16 253 253
+ 253 253 61 253 253 253 253 253 76 253 12 22 253 253 49 99
+ 253 253 253 253 253 253 253 253 82 253 81 253 125 123 87 36
+ 253 253 117 253 253 96 58 253 253 253 59 253 253 20 253 253
+ 253 253 53 1 253 253 21 253 253 253 253 253 60 253 253 43
+ 87 94 253 125 253 253 20 253 73 17 253 118 25 253 253 253
+ 253 253 253 253 81 90 253 253 114 253 253 72 253 253 86 253
+ 91 253 253 34 253 253 51 253 253 253 253 86 120 81 64 43
+ 253 57 253 253 68 253 85 123 61 253 253 95 57 67 253 63 78
+ 253 253 26 107 253 12 253 253 253 253 253 61 253 1 113 118
+ 253 253 253 253 15 253 118 67 29 253 100 253 253 253 25 125
+ 127 253 37 253 253 253 253 253 15 253 39 253 59 88 253 96
+ 253 253 90 253 253 36 253 253 253 253 80 71 44 253 42 253
+ 253 102 56 81 253 253 253 253 253 87 119 100 253 253 253
+ 253 38 253 253 70 24 253 11 24 253 253 253 253 39 253 253
+ 253 253 13 253 114 107 91 40 63 18 33 253 114 253 253 72
+ 253 253 125 126 253 76 253 0 253 253 253 253 90 253 29 253
+ 253 253 92 253 253 253 253 253 118 253 29 253 253 57 31 95
+ 253 253 253 67 253 253 19 79 111 28 23 17 253 94 51 253 21
+ 253 0 10 253 253 253 253 14 42 253 253 253 51 253 56 253
+ 253 253 76 253 253 60 52 109 25 57 253 62 253 253 23 253 18
+ 93 21 253 101 66 253 253 253 253 253 253 60 62 42 253 253
+ 253 253 253 111 253 253 78 253 253 101 253 253 77 253 91 97
+ 53 253 253 56 86 253 19 253 253 253 253 0 253 253 99 253
+ 253 88 253 34 253 11 253 253 253 95 72 74 253 253 99 70 54
+ 96 118 28 10 87 127 110 100 253 112 118 47 115 77 253 253
+ 253 80 119 253 253 253 42 253 15 253 253 253 119 253 104 57
+ 39 253 37 117 96 85 253 253 253 51 253 125 105 102 253 253
+ 69 54 253 34 253 46 253 253 30 253 0 74 253 93 253 101 253
+ 35 47 253 253 33 253 65 253 111 61 253 253 253 253 253 70
+ 253 70 253 253 96 43 36 253 253 105 100 109 81 253 253 0 26
+ 122 94 253 253 119 19 36 253 69 30 60 253 32 36 253 253 0
+ 253 115 30 253 38 253 83 13 253 52 108 59 6 24 56 253 253
+ 63 253 253 253 92 105 253 21 253 253 253 19 103 253 21 87
+ 43 253 98 73 253 92 75 253 71 69 253 253 122 253 253 253
+ 109 253 104 253 35 253 24 32 125 72 253 253 253 253 100 114
+ 69 253 22 253 253 253 121 78 1 253 253 253 70 253 115 107
+ 34 253 253 98 253 253 122 253 253 6 100 253 253 79 106 253
+ 5 253 253 253 47 98 49 85 253 22 46 253 97 69 253 51 92 95
+ 253 253 253 253 5 253 99 61 253 253 105 116 253 253 111 113
+ 98 30 50 253 84 253 7 61 253 253 115 253 253 253 253 253 88
+ 47 253 253 52 108 26 253 253 253 253 253 253 253 11 253 253
+ 253 0 253 77 35 253 253 253 253 57 18 253 103 91 253 253
+ 253 110 23 116 253 253 102 50 125 13 77 116 75 253 109 109
+ 253 33 103 25 253 253 253 253 253 253 253 34 36 253 8 253
+ 36 104 253 7 253 253 7 253 253 253 253 77 90 253 253 253 26
+ 9 55 2 61 253 253 253 101 253 253 74 107 253 77 121 113 115
+ 253 253 253 70 36 253 253 30 99 47 253 253 253 253 62 46 90
+ 90 253 253 34 77 104 253 54 253 0 253 253 253 91 253 253
+ 253 113 19 96 253 36 253 253 253 253 253 253 51 106 253 86
+ 112 70 253 253 253 84 253 53 100 253 105 82 35 18 57 99 90
+ 7 253 43 4 253 33 91 253 123 86 107 253 110 253 253 36 101
+ 253 19 253 0 253 253 21 253 253 121 39 253 253 253 253 253
+ 32 253 71 253 253 253 105 253 253 8 253 253 253 253 253 109
+ 253 253 253 253 253 51 253 85 253 253 74 87 253 61 69 29
+ 253 253 253 253 253 40 253 57 253 51 103 6 253 253 8 93 58
+ 253 60 127 71 127 253 104 253 62 253 22 253 253 253 101 253
+ 127 253 253 253 0 45 20 253 24 85 253 73 26 253 65 253 253
+ 18 86 70 100 50 253 253 90 89 104 253 253 86 253 253 63 253
+ 63 253 253 253 100 253 253 112 253 253 253 69 37 101 99 253
+ 116 253 253 253 253 42 253 50 31 8 253 253 253 253 253 127
+ 87 0 253 94 9 253 253 253 78 14 51 253 253 253 253 253 253
+ 39 127 8 122 253 253 253 253 253 253 253 54 253 253 113 253
+ 52 71 92 124 78 253 253 23 253 253 253 28 253 253 253 113
+ 253 253 88 253 253 253 253 44 80 253 253 253 253 253 253 38
+ 253 253 253 253 121 49 73 253 101 63 253 79 45 253 253 253
+ 253 73 78 253 107 253 29 90 253 92 253 101 113 39 253 253
+ 253 34 104 102 253 253 253 56 253 104 253 6 61 253 253 253
+ 107 11 253 118 253 253 115 52 123 72 253 117 42 253 253 253
+ 253 57 35 253 15 24 253 253 253 115 114 14 253 253 253 253
+ 18 48 253 23 253 122 253 18 51 72 253 253 253 253 124 253
+ 89 253 253 253 82 45 15 253 253 253 253 64 35 253 253 50 60
+ 253 253 60 253 253 122 253 34 253 253 253 105 22 52 83 253
+ 56 21 119 124 40 253 61 22 11 120 117 14 253 91 71 253 253
+ 253 253 253 253 253 253 253 76 253 253 253 63 253 253 18
+ 253 18 57 54 253 100 253 253 253 63 253 91 58 253 90 125
+ 107 82 253 0 253 61 62 253 253 253 253 253 253 120 253 253
+ 82 82 253 69 253 253 253 253 253 253 253 36 253 253 27 253
+ 53 90 60 43 62 253 253 253 253 253 253 124 122 30 253 253
+ 31 29 52 104 253 253 95 253 32 5 27 100 36 253 45 253 253
+ 10 253 253 62 14 116 119 78 253 49 106 29 125 253 253 6 78
+ 253 253 253 253 253 253 253 126 25 253 253 0 253 31 253 253
+ 111 253 253 253 253 75 11 33 253 58 253 253 253 253 253 111
+ 253 253 253 18 253 105 41 253 127 11 55 77 253 253 13 253
+ 253 52 253 253 62 32 50 253 253 57 253 253 253 71 253 253
+ 253 253 122 253 5 253 105 253 253 57 253 14 11 253 120 253
+ 63 253 253 92 19 253 253 53 253 80 253 253 253 253 37 96 36
+ 8 112 28 122 30 61 49 87 123 253 75 105 253 99 253 52 253
+ 69 118 253 26 0 16 253 253 74 253 104 10 253 71 82 105 125
+ 92 253 27 253 253 253 253 253 12 41 37 253 45 253 68 75 253
+ 79 115 253 253 5 253 253 253 253 84 103 253 253 253 253 253
+ 253 23 49 253 121 21 93 253 36 253 253 253 63 253 90 253
+ 115 72 253 28 109 253 86 95 48 30 253 253 46 253 68 253 62
+ 253 253 22 88 78 21 253 253 46 120 253 44 126 253 253 253
+ 253 72 124 104 253 253 79 13 253 39 0 253 253 253 55 253 64
+ 44 102 54 86 40 36 33 28 253 7 21 76 253 62 253 115 253 253
+ 253 253 30 37 253 253 49 253 253 253 62 253 88 253 253 253
+ 62 34 253 253 58 102 253 2 121 12 14 253 120 80 253 253 253
+ 253 253 54 253 253 253 78 253 253 253 253 253 253 110 253
+ 253 253 16 253 40 253 253 78 113 253 253 253 17 53 127 253
+ 104 253 75 123 253 253 74 17 20 253 253 63 253 253 0 62 253
+ 82 116 253 253 253 117 70 253 107 253 253 253 120 253 253
+ 79 253 253 253 253 253 253 111 253 28 253 97 20 253 253 253
+ 253 253 58 99 87 253 253 253 73 107 36 48 253 16 253 253 70
+ 253 253 77 253 62 253 253 253 253 253 63 253 253 13 253 253
+ 253 108 253 26 9 253 13 46 253 115 253 3 253 81 85 253 123
+ 253 253 79 253 58 54 253 253 253 253 253 96 36 253 110 10
+ 253 253 64 253 103 253 70 126 35 124 48 253 253 99 6 253
+ 253 253 253 253 253 253 70 253 7 2 253 253 55 41 69 121 116
+ 68 62 34 253 106 253 253 253 73 100 253 61 253 253 17 253
+ 66 253 253 80 253 253 39 253 253 28 253 253 105 253 105 253
+ 87 253 253 26 59 253 253 253 127 13 253 23 253 253 44 14
+ 253 253 253 253 68 106 253 61 253 107 110 253 253 30 119 14
+ 253 253 253 253 253 120 253 66 253 253 253 33 253 64 42 79
+ 57 253 253 253 81 253 67 28 108 18 34 253 27 253 115 75 253
+ 13 58 253 253 253 57 253 105 30 253 26 50 253 253 12 253
+ 106 111 253 100 253 253 14 110 45 100 30 29 253 108 93 253
+ 253 253 253 253 253 253 253 253 46 253 253 65 116 253 253
+ 253 253 14 56 39 253 253 253 253 253 253 102 114 65 253 253
+ 29 45 253 253 253 253 253 123 82 253 13 253 253 253 111 94
+ 253 127 103 35 13 253 89 59 103 253 253 30 253 253 55 253
+ 253 253 253 28 253 253 81 14 253 253 46 253 42 253 52 253
+ 253 253 3 253 253 253 55 121 253 253 253 253 62 253 62 253
+ 119 253 106 33 86 39 253 15 253 81 80 253 28 253 253 102 84
+ 57 35 253 81 91 33 60 96 253 253 42 253 253 253 77 253 45
+ 72 53 253 65 253 28 253 253 12 110 20 253 253 107 50 253
+ 253 253 253 97 14 253 253 100 253 253 253 26 88 99 0 35 253
+ 253 253 35 41 253 62 253 126 253 34 253 101 76 115 75 35 4
+ 253 124 253 43 70 253 253 253 122 63 253 253 253 0 253 71
+ 73 253 87 253 122 7 80 253 0 54 94 253 0 253 253 253 90 41
+ 42 48 253 253 253 61 253 13 253 34 76 10 253 4 91 101 25
+ 253 253 253 253 95 253 253 253 74 253 13 123 253 40 253 253
+ 55 56 253 115 92 253 71 24 253 253 77 103 253 253 29 253
+ 253 23 253 3 253 104 29 53 253 69 253 253 28 253 253 32 48
+ 31 122 253 253 253 253 253 253 107 253 77 85 253 253 253
+ 253 253 253 253 75 20 253 253 253 38 253 253 253 253 95 83
+ 57 253 253 0 123 28 253 97 253 253 23 119 6 86 113 253 3 28
+ 3 64 73 118 105 253 253 75 253 253 71 96 253 253 62 253 253
+ 43 30 253 253 253 90 68 253 253 69 24 253 76 56 253 101 82
+ 71 253 84 253 253 253 253 253 117 125 13 253 54 253 253 30
+ 253 253 253 253 253 50 61 253 253 17 93 253 253 19 50 253
+ 102 24 78 253 253 253 253 29 55 105 99 253 253 253 104 253
+ 253 253 253 1 35 253 5 253 253 253 116 95 253 91 125 52 67
+ 53 253 253 253 12 22 9 253 126 253 105 253 253 54 58 126
+ 253 27 253 253 253 60 253 253 115 253 84 253 100 101 253
+ 253 253 253 127 16 35 253 253 54 253 107 253 253 82 253 253
+ 102 43 28 64 121 253 253 126 253 253 253 253 253 253 110
+ 253 253 59 253 253 55 120 114 253 0 23 124 253 253 253 36
+ 90 253 253 253 253 46 104 35 253 4 39 108 253 60 253 253
+ 253 253 115 84 102 253 253 253 3 253 253 253 253 253 98 49
+ 253 253 65 253 66 253 253 253 86 253 41 73 81 57 253 22 75
+ 126 54 92 253 106 253 105 253 45 253 80 253 62 253 253 127
+ 20 127 74 19 253 253 253 253 253 253 38 253 113 253 69 121
+ 103 125 101 56 253 44 99 102 253 6 60 253 253 103 253 253
+ 253 20 253 253 253 253 0 253 55 87 253 253 253 106 38 253
+ 29 67 24 253 33 253 7 31 253 253 80 253 42 253 77 253 9 253
+ 253 253 34 120 116 93 253 60 253 253 253 253 253 253 253
+ 253 36 63 253 253 253 253 122 59 253 253 28 95 253 44 42 62
+ 68 123 253 116 253 33 117 253 20 71 109 12 253 51 36 95 253
+ 253 253 0 253 51 253 253 73 253 27 253 253 253 253 253 71
+ 253 61 253 2 56 253 253 253 253 35 253 77 93 99 94 75 88 99
+ 72 253 253 253 253 10 253 9 253 253 122 35 69 253 253 253
+ 113 253 112 23 253 91 253 105 61 253 122 116 253 109 253
+ 253 253 253 72 253 99 253 44 253 253 253 253 253 253 253
+ 253 10 253 84 253 37 105 49 49 72 253 127 253 253 20 253
+ 253 253 253 86 107 115 34 253 253 69 108 253 253 21 253 253
+ 126 90 40 253 92 115 82 253 253 76 73 253 23 253 253 253
+ 253 253 17 77 43 73 110 253 253 66 57 253 36 253 93 26 253
+ 253 253 253 3 92 253 253 253 253 253 49 86 11 61 253 253
+ 105 20 253 253 253 80 48 43 69 253 253 253 253 253 28 107
+ 27 24 253 253 127 95 253 253 253 61 28 253 253 253 253 88
+ 253 13 44 253 43 73 31 253 89 253 0 253 253 65 124 52 253
+ 253 253 253 253 253 34 253 253 37 253 253 253 253 253 20
+ 253 253 10 253 7 106 253 114 1 253 31 253 39 74 253 253 253
+ 68 82 126 72 47 253 253 253 253 66 44 253 253 125 107 79 75
+ 123 253 253 253 253 36 253 112 14 10 48 253 253 86 253 253
+ 9 78 253 253 253 28 253 253 109 253 111 109 253 253 253 6
+ 253 45 253 98 253 89 34 13 253 253 253 40 253 253 253 122
+ 253 253 253 253 253 253 253 123 92 253 253 15 253 253 253
+ 253 253 253 62 94 59 253 85 78 253 253 253 85 253 253 253
+ 253 44 253 29 51 80 253 76 59 253 253 253 253 253 110 121
+ 253 253 253 111 88 253 86 253 253 253 53 7 76 253 23 253 35
+ 72 253 37 121 34 253 50 125 253 8 97 253 95 43 61 95 253
+ 253 0 59 22 124 80 253 35 253 82 80 253 51 75 253 253 253
+ 253 253 25 31 253 17 253 17 253 111 253 253 253 253 253 253
+ 253 109 103 71 253 59 16 253 73 253 91 253 28 99 253 253
+ 253 15 58 89 110 253 4 253 253 39 113 32 253 253 93 114 253
+ 253 0 82 43 253 253 253 22 253 107 2 253 253 253 253 253
+ 253 64 7 253 253 253 35 253 253 103 18 253 111 253 253 126
+ 54 253 253 47 253 253 253 253 12 253 253 34 253 75 253 253
+ 86 62 11 7 25 253 43 253 58 253 253 44 253 120 36 73 6 253
+ 253 99 253 4 19 253 42 253 253 253 253 98 253 253 126 51 78
+ 18 73 30 114 253 87 3 253 40 253 253 83 253 78 253 44 103
+ 52 253 78 253 253 54 253 253 122 127 47 253 253 119 125 31
+ 117 14 253 39 253 60 72 6 74 253 253 253 106 253 9 109 91
+ 44 253 253 28 110 20 253 253 253 253 59 253 30 253 253 6 21
+ 253 9 253 123 253 117 19 21 253 101 35 253 68 58 114 253 52
+ 41 253 253 253 64 253 253 58 253 120 108 253 253 77 35 253
+ 22 8 253 253 98 253 16 253 21 112 8 253 15 63 253 253 6 112
+ 125 43 253 35 110 253 0 253 0 253 87 23 65 24 66 253 121
+ 253 253 109 253 253 21 253 15 42 121 253 28 253 253 59 253
+ 253 24 79 253 253 84 253 253 253 253 253 79 253 253 253 253
+ 253 253 253 17 253 115 69 105 35 49 45 99 12 253 253 253
+ 253 15 253 101 253 253 253 253 0 253 253 101 24 10 253 74
+ 11 81 253 77 253 253 0 253 253 253 253 253 66 253 253 253
+ 253 253 103 105 253 253 42 253 57 253 117 57 39 253 107 103
+ 110 253 253 253 10 63 253 253 126 253 253 98 253 253 20 10
+ 253 67 56 253 65 253 16 253 15 122 57 253 253 253 253 115
+ 64 88 253 124 49 253 27 28 101 92 253 114 41 253 253 27 43
+ 253 253 38 61 66 76 115 253 127 74 253 91 253 102 253 87
+ 253 88 253 253 253 253 111 253 6 253 126 253 253 253 253
+ 253 253 24 253 2 50 57 62 253 253 253 253 120 253 106 253
+ 253 253 59 253 94 38 253 22 253 116 100 87 253 253 80 70 49
+ 253 253 58 43 73 68 253 253 253 52 253 253 253 23 35 56 253
+ 58 34 72 253 253 58 47 54 253 253 253 24 253 253 253 79 253
+ 31 77 16 253 253 253 67 25 6 253 42 13 253 253 253 253 123
+ 253 253 253 13 253 26 253 253 253 57 253 0 26 95 253 86 253
+ 14 38 0 253 17 253 125 42 75 20 6 20 41 26 253 253 40 253
+ 253 253 253 253 24 60 253 78 89 87 253 253 253 253 253 253
+ 253 253 253 22 253 60 253 253 253 74 1 34 253 253 253 253
+ 253 253 253 253 79 253 47 72 111 89 117 61 99 84 253 253
+ 253 103 33 253 253 253 10 253 0 42 253 253 253 253 253 253
+ 253 253 50 253 253 77 44 253 253 54 8 65 253 36 253 40 253
+ 253 253 253 95 253 253 253 73 17 253 91 253 253 253 253 253
+ 253 253 253 253 253 6 253 55 37 118 253 124 253 253 253 253
+ 253 253 253 118 253 253 80 74 54 253 1 90 97 253 253 253
+ 253 3 81 253 253 253 91 125 63 77 88 108 253 70 21 97 253
+ 253 43 253 53 45 120 119 253 253 253 253 253 253 124 24 253
+ 10 1 96 59 253 253 116 253 76 253 104 253 253 253 253 4 101
+ 253 253 253 94 91 253 253 253 253 11 26 91 253 47 253 253
+ 26 52 117 23 55 18 44 253 253 32 253 253 126 253 97 105 253
+ 20 118 253 253 120 107 253 2 121 52 253 18 107 253 253 117
+ 35 253 17 70 253 66 107 125 253 253 253 253 59 119 1 253
+ 253 253 253 106 118 51 105 253 99 27 253 253 20 253 253 85
+ 51 253 90 253 253 253 27 36 55 253 253 253 253 253 3 253 57
+ 253 253 253 253 253 253 32 253 101 44 253 99 53 59 41 253
+ 253 20 253 253 41 119 253 56 253 253 31 105 121 29 253 42
+ 253 253 3 253 253 42 253 107 120 2 16 253 100 253 253 253
+ 253 253 253 13 20 253 253 253 253 50 86 9 53 123 50 253 11
+ 11 107 253 41 253 60 99 35 4 253 0 125 85 253 71 253 82 253
+ 87 15 123 4 253 253 49 253 32 28 15 92 253 86 253 120 253
+ 40 4 33 253 12 253 54 253 253 253 253 37 253 253 75 253 253
+ 70 253 253 38 80 59 12 253 253 19 253 75 253 77 117 119 76
+ 253 117 23 78 253 47 253 99 253 253 121 253 253 54 253 3
+ 253 253 253 253 253 29 51 253 253 253 122 253 95 27 104 110
+ 253 253 76 253 253 83 253 117 43 87 61 253 76 54 253 118
+ 253 89 253 81 68 91 43 253 95 113 253 124 253 116 253 59
+ 253 54 23 81 253 110 253 253 253 64 54 122 253 39 253 104
+ 114 98 73 253 91 253 125 35 253 105 98 107 75 29 66 7 253
+ 253 60 253 57 0 59 121 253 39 253 253 253 253 56 45 253 253
+ 253 253 36 253 253 44 253 253 253 253 253 253 253 253 106
+ 253 111 43 77 19 68 121 253 253 253 253 253 253 79 253 253
+ 93 253 253 253 253 253 253 106 253 64 48 87 253 30 253 253
+ 40 253 253 253 5 253 77 253 36 102 48 253 7 36 253 253 253
+ 253 253 27 70 253 253 41 253 253 253 253 105 253 253 10 22
+ 12 253 109 253 253 253 126 253 90 253 119 110 253 6 253 253
+ 253 253 253 72 45 253 253 69 253 75 253 125 121 61 253 100
+ 5 30 253 253 115 253 253 253 253 253 68 253 253 32 25 253
+ 83 253 98 7 34 253 253 88 253 253 79 253 23 253 253 253 253
+ 10 253 253 0 253 41 80 99 115 120 253 253 3 253 67 6 253 28
+ 253 253 117 84 253 79 253 121 253 253 253 123 26 253 3 253
+ 253 81 14 253 253 253 253 253 253 253 253 253 82 253 50 23
+ 253 76 253 253 79 253 31 83 253 62 113 253 253 69 69 10 17
+ 253 56 253 66 70 253 20 253 115 68 71 56 0 125 120 253 253
+ 253 253 253 49 253 253 86 74 25 125 43 253 28 14 56 253 101
+ 253 253 84 48 253 89 82 253 46 54 253 253 109 253 253 49
+ 125 253 29 96 253 253 121 253 253 253 253 253 71 21 253 53
+ 253 253 253 253 29 253 109 70 54 253 253 120 253 253 54 253
+ 253 0 45 18 119 46 57 253 253 117 94 116 59 253 253 253 253
+ 0 253 107 24 253 89 51 27 24 6 15 253 253 253 253 13 253
+ 100 103 53 253 253 15 253 253 253 253 253 253 253 253 253
+ 253 110 253 253 99 253 109 59 253 127 253 22 85 73 60 253
+ 90 110 68 32 253 122 34 114 253 253 253 253 253 253 117 29
+ 89 39 253 16 253 253 54 253 253 6 253 54 101 29 253 54 9
+ 253 107 111 65 52 119 55 253 253 14 253 253 253 123 253 120
+ 253 111 253 253 253 1 253 76 253 33 253 253 113 71 253 41
+ 88 253 0 104 253 36 253 253 253 100 253 253 253 79 84 58
+ 126 71 78 253 253 67 253 91 71 31 38 76 42 17 253 86 253 71
+ 253 253 40 253 253 253 104 3 30 253 85 116 253 107 47 253
+ 253 253 26 121 253 106 253 253 253 68 253 253 253 253 103
+ 118 253 253 253 253 253 253 253 52 74 253 101 92 7 94 113
+ 81 253 253 253 253 65 45 253 115 0 66 253 253 253 13 253 85
+ 253 253 48 60 253 253 253 92 118 253 253 253 253 253 118 96
+ 253 253 63 253 253 125 0 253 253 253 107 253 26 41 253 253
+ 105 32 81 253 100 67 37 253 104 253 62 253 253 44 37 253
+ 253 253 127 253 93 253 253 253 253 34 85 253 107 253 253
+ 253 9 27 121 253 56 253 107 55 45 34 253 114 253 253 47 4
+ 253 9 253 10 253 253 79 89 253 97 27 94 77 34 253 47 253 51
+ 30 13 9 253 253 253 253 253 24 80 18 253 253 253 61 69 71
+ 253 253 253 88 253 88 85 21 45 253 60 5 39 253 51 80 253
+ 253 65 253 73 37 253 54 253 70 253 4 14 70 59 81 76 106 253
+ 253 23 55 253 91 253 127 253 105 253 48 253 48 253 253 3
+ 253 0 253 253 58 253 253 6 253 253 253 253 69 253 123 253
+ 84 253 253 253 253 11 85 101 253 47 253 53 30 253 253 253
+ 40 100 123 125 56 54 253 253 253 111 46 51 253 253 106 53
+ 253 253 253 253 253 253 15 253 70 43 253 7 253 100 15 253
+ 93 115 122 253 253 111 115 4 1 253 253 98 253 3 253 91 253
+ 253 253 253 253 44 117 253 23 112 253 17 66 253 253 253 9
+ 253 58 253 253 253 53 93 29 113 253 5 35 43 253 0 253 81
+ 127 253 253 68 15 253 0 253 47 253 86 253 118 253 253 76 23
+ 253 28 113 253 253 253 124 105 253 91 59 253 253 87 253 253
+ 253 253 99 253 35 253 62 253 116 253 76 126 31 253 253 44
+ 57 253 253 119 85 253 118 253 253 74 40 12 79 4 253 20 90
+ 111 253 27 253 46 253 253 253 253 19 253 253 109 253 253
+ 253 253 253 61 253 253 253 79 253 126 253 34 253 21 253 41
+ 26 253 253 253 253 8 253 253 253 29 253 253 253 100 253 41
+ 36 253 88 253 253 120 253 253 253 253 123 253 253 253 253
+ 253 253 253 253 19 76 253 36 253 253 253 253 253 9 253 253
+ 253 253 118 253 73 253 93 58 63 80 253 253 35 105 23 253
+ 108 253 46 6 253 253 253 253 253 253 253 89 253 65 27 74
+ 253 38 253 15 253 253 253 253 253 122 253 253 253 253 55 80
+ 253 253 20 253 18 47 253 253 253 253 117 111 253 67 253 253
+ 18 5 253 78 3 10 91 12 83 110 253 253 85 253 253 110 90 253
+ 68 253 6 95 253 42 60 253 253 79 253 72 253 125 111 38 253
+ 53 253 253 253 118 124 253 253 253 26 253 115 253 253 253 0
+ 88 253 88 253 85 253 253 68 116 253 253 34 119 253 253 69
+ 109 253 113 253 253 108 253 75 31 72 253 120 253 48 25 4
+ 253 12 253 43 116 253 253 253 15 13 99 98 8 253 253 105 253
+ 91 96 253 253 43 97 253 30 253 253 106 253 253 253 98 253
+ 253 253 253 253 253 91 36 253 58 43 253 253 253 72 46 32
+ 253 67 253 13 253 253 85 31 25 253 253 253 253 85 253 253
+ 21 253 253 253 253 30 61 69 91 253 94 127 21 104 95 4 253
+ 121 126 253 89 253 117 253 87 90 116 126 59 253 27 105 92
+ 253 64 21 37 26 118 91 253 253 253 253 62 253 253 53 16 253
+ 103 28 110 78 73 253 253 47 253 0 253 253 55 253 253 37 253
+ 70 61 57 253 29 89 253 92 104 253 253 253 253 253 34 124
+ 253 122 99 253 253 253 253 253 74 253 114 64 253 86 82 100
+ 253 253 67 34 108 46 115 69 71 38 253 253 41 100 47 253 122
+ 54 253 253 253 253 253 253 45 58 24 253 253 253 62 253 253
+ 253 103 253 253 68 253 253 94 253 96 20 14 106 253 34 97 0
+ 253 121 25 29 253 124 253 37 111 8 253 59 26 253 253 6 77
+ 253 253 123 253 122 253 70 253 253 121 253 253 253 253 253
+ 21 253 84 35 253 77 253 253 17 57 63 109 253 65 27 87 60 80
+ 253 253 253 0 253 111 127 253 253 253 24 253 253 38 21 253
+ 253 253 253 253 253 253 127 253 110 4 9 121 25 253 108 37
+ 85 253 253 95 85 253 110 253 253 253 253 253 36 7 253 26
+ 253 41 30 253 253 25 253 78 71 253 109 253 64 16 253 95 65
+ 253 88 90 16 109 253 253 28 86 253 253 119 253 60 253 253
+ 107 124 73 253 121 16 253 253 95 26 80 23 253 253 253 253
+ 253 9 253 121 253 253 253 253 51 57 39 253 253 253 253 253
+ 253 105 82 253 253 253 253 253 11 253 110 53 253 253 23 253
+ 253 253 122 44 81 253 48 253 253 0 61 49 74 24 253 14 122
+ 66 253 253 94 48 253 253 80 63 253 253 88 90 72 96 253 54
+ 56 253 105 7 78 88 253 31 52 253 253 94 88 253 253 79 253
+ 74 32 253 75 123 116 253 68 253 118 110 253 253 253 46 253
+ 253 58 65 18 253 74 253 253 112 59 84 115 253 46 253 253
+ 253 95 121 44 62 81 253 253 253 253 253 119 81 253 108 253
+ 253 42 25 253 90 253 253 253 102 93 253 253 119 96 41 253
+ 42 253 253 29 253 107 71 253 87 35 253 99 253 106 35 253 90
+ 253 78 5 253 253 22 99 253 41 253 253 253 44 26 83 52 101
+ 76 44 48 54 118 53 26 253 109 253 253 253 33 253 253 12 12
+ 253 25 253 253 47 12 111 76 253 124 53 253 253 16 45 253
+ 253 110 64 114 115 253 84 253 253 253 101 78 253 123 102
+ 253 26 56 253 253 102 253 123 67 253 75 123 51 101 8 13 253
+ 12 127 253 253 92 107 253 253 27 253 126 253 253 98 253 253
+ 253 124 253 253 105 253 28 253 253 68 253 52 253 12 48 44
+ 118 253 253 253 253 253 37 15 253 62 253 253 53 63 1 253 60
+ 39 253 253 84 253 253 46 253 253 253 109 62 253 253 51 92
+ 54 12 253 7 253 253 253 87 82 89 54 253 36 87 22 253 253 62
+ 94 59 85 34 253 253 253 110 253 97 124 56 253 45 253 8 28
+ 253 12 253 253 253 86 5 253 253 253 75 113 12 108 253 77
+ 253 110 56 253 35 253 13 253 91 253 38 53 253 253 111 253
+ 253 123 253 253 84 91 253 104 17 253 65 24 17 253 15 253
+ 116 66 105 253 113 67 109 70 91 88 253 253 118 0 253 5 72
+ 81 253 253 78 253 253 56 127 27 45 253 253 253 55 253 49
+ 253 253 110 253 253 29 58 101 253 42 5 253 253 66 12 122
+ 123 253 62 253 253 253 253 253 0 253 116 60 92 49 253 253
+ 253 253 253 55 72 253 80 93 253 253 50 8 253 253 253 253
+ 253 110 5 49 253 253 0 253 253 97 24 23 253 28 40 253 253
+ 127 253 107 253 253 73 119 50 253 253 253 253 253 114 121
+ 253 125 93 62 253 113 253 25 253 29 253 253 65 253 253 253
+ 253 12 253 114 253 253 73 69 253 253 95 8 26 253 253 253 54
+ 104 253 253 35 68 72 81 253 21 27 253 77 54 125 23 88 18
+ 253 253 253 253 69 51 253 0 37 253 27 253 253 253 253 74
+ 253 253 66 253 95 114 123 253 253 253 94 253 253 253 253
+ 253 42 36 98 114 19 253 126 253 25 253 40 253 50 46 64 61
+ 45 117 107 253 89 51 69 38 14 57 7 253 109 253 111 253 253
+ 10 13 253 46 60 253 253 25 253 15 76 253 92 88 253 70 5 5
+ 73 60 113 253 82 253 253 51 126 253 112 34 19 99 253 253
+ 119 30 253 253 0 253 104 116 52 253 79 69 253 109 119 253
+ 17 22 66 87 119 13 253 253 35 83 11 253 253 253 253 253 106
+ 45 253 253 120 253 36 253 25 253 253 81 75 253 40 88 253
+ 253 253 74 253 115 53 253 70 253 253 253 253 117 253 64 253
+ 253 53 93 253 253 253 52 253 23 253 62 14 0 95 253 253 90
+ 253 253 56 253 49 253 253 253 75 118 6 253 253 253 48 253
+ 253 253 105 24 253 48 71 253 253 36 55 39 253 253 127 20 33
+ 253 253 253 101 79 6 102 89 24 46 253 62 82 113 253 84 6 88
+ 22 44 52 44 253 253 94 253 253 253 253 58 47 253 104 38 253
+ 101 253 71 253 81 253 6 83 253 253 83 54 30 42 72 253 253
+ 253 3 253 48 253 110 126 253 64 253 104 253 253 253 253 253
+ 253 253 64 57 110 107 102 253 110 253 9 253 65 30 253 253
+ 253 104 253 35 253 253 42 253 253 253 100 253 46 99 63 253
+ 95 39 253 99 253 115 72 34 253 253 253 99 253 253 253 253
+ 67 253 106 87 20 253 253 253 253 253 253 30 253 253 253 253
+ 253 253 253 253 253 125 253 2 84 253 253 253 100 5 253 253
+ 0 53 40 7 253 253 44 80 90 253 253 253 122 114 127 253 61
+ 109 253 253 46 87 253 253 26 253 101 109 34 253 253 253 112
+ 126 253 253 70 253 253 52 253 111 253 91 253 28 253 253 253
+ 118 114 121 253 253 116 253 253 24 71 111 253 253 253 253
+ 253 253 5 98 253 253 89 253 253 115 253 253 66 253 99 5 253
+ 253 63 253 62 106 105 99 25 48 42 253 253 39 253 104 253
+ 253 29 253 253 1 21 83 112 253 253 111 253 253 37 48 14 253
+ 253 253 109 107 253 253 253 50 46 253 253 99 253 13 116 78
+ 253 56 253 253 20 253 81 253 80 13 253 253 253 85 253 253
+ 94 253 59 253 253 99 12 253 253 253 21 108 90 253 253 36 79
+ 10 30 0 253 88 253 253 253 253 23 253 253 253 96 253 253
+ 126 253 253 253 12 253 34 253 253 253 63 253 35 253 253 88
+ 80 35 67 253 79 253 15 253 253 41 253 55 50 71 3 253 253
+ 253 63 59 253 253 253 86 20 253 253 9 49 253 253 75 253 7
+ 14 59 26 253 122 253 101 253 253 253 253 70 253 79 57 253
+ 19 90 253 253 253 253 253 253 253 60 253 85 91 253 91 79
+ 121 123 35 126 42 20 85 57 253 253 253 253 39 253 52 59 21
+ 95 71 52 120 85 253 253 19 24 253 61 253 253 38 253 109 62
+ 56 84 95 120 253 52 253 12 70 23 253 253 253 8 45 33 102 62
+ 35 69 113 253 253 43 28 253 253 253 28 253 53 1 12 253 109
+ 253 56 69 30 253 90 89 71 253 87 58 90 44 253 253 253 108
+ 45 112 24 253 64 59 253 35 39 253 253 63 253 253 253 253
+ 110 35 77 90 16 253 253 71 31 253 253 118 63 253 253 0 95
+ 253 253 59 76 253 101 45 113 253 67 10 253 253 34 253 253
+ 57 253 253 95 116 253 253 253 109 253 19 66 253 32 253 253
+ 14 8 253 253 93 81 253 66 253 253 109 253 253 253 253 38
+ 253 125 253 92 253 253 82 120 115 253 3 253 253 253 253 81
+ 253 253 253 253 114 253 76 253 253 52 253 64 253 253 57 63
+ 83 79 253 108 253 58 51 253 102 253 72 93 32 119 36 100 119
+ 25 253 72 253 109 109 253 43 253 253 253 253 119 83 253 253
+ 81 83 253 116 253 253 43 253 253 253 253 253 53 87 253 109
+ 253 20 253 8 29 253 253 253 0 253 117 88 99 253 18 253 121
+ 75 253 112 15 253 10 115 253 253 104 253 253 109 253 47 253
+ 3 24 253 70 253 34 35 253 50 253 74 253 79 253 253 23 76 95
+ 253 68 253 87 253 37 253 253 26 53 97 28 253 253 253 253 0
+ 102 42 253 253 253 111 253 101 123 253 50 253 19 253 35 253
+ 253 84 253 68 104 4 253 253 98 112 6 125 253 84 82 27 253
+ 253 253 253 97 253 253 56 253 253 77 253 113 118 65 83 78
+ 253 58 253 253 36 253 253 253 253 121 253 253 253 253 253
+ 253 253 253 253 80 253 253 253 253 97 8 253 48 253 253 106
+ 253 253 117 11 77 19 76 125 54 253 30 57 82 9 28 3 79 253 0
+ 253 253 253 253 253 253 51 253 253 70 35 253 27 10 253 14
+ 59 253 253 70 9 253 253 101 20 253 116 253 253 61 10 253 71
+ 253 107 107 59 21 100 11 15 253 61 253 253 253 253 71 12 97
+ 253 253 253 1 253 253 253 83 13 26 253 43 88 253 75 108 35
+ 253 110 253 57 253 253 253 38 253 253 253 253 253 101 253
+ 48 253 253 253 253 253 253 98 56 253 253 253 253 75 3 103
+ 126 253 13 253 69 253 253 73 253 253 253 67 20 99 253 253
+ 253 102 253 13 27 253 253 28 253 18 77 53 253 93 253 253 79
+ 106 16 88 52 253 253 111 32 12 253 253 253 253 0 106 253
+ 253 59 253 253 97 116 84 108 85 3 72 36 56 253 34 253 80 70
+ 253 253 253 81 253 253 24 61 253 253 253 253 253 253 253
+ 253 101 45 253 253 253 253 88 253 95 93 44 106 253 81 253
+ 31 50 253 253 253 253 253 105 253 108 253 253 31 16 253 253
+ 51 27 253 253 253 74 253 94 253 25 253 253 253 22 94 114 87
+ 52 253 253 105 35 117 104 83 45 253 27 253 253 119 253 253
+ 19 253 62 25 85 110 253 253 52 76 85 253 0 17 253 253 253
+ 253 37 253 253 46 20 21 7 110 253 125 253 253 253 79 253 60
+ 253 39 32 253 79 253 107 253 122 253 68 253 75 86 253 25 92
+ 100 253 59 26 253 253 253 253 38 253 88 253 253 253 119 28
+ 30 107 24 253 253 14 253 44 253 253 79 253 253 99 75 110 45
+ 85 253 253 83 62 253 253 253 253 108 253 18 253 125 253 34
+ 253 110 253 92 253 86 17 253 71 37 253 0 253 253 253 253
+ 253 82 48 253 253 124 253 253 37 253 253 92 253 253 253 105
+ 253 253 253 19 33 253 127 109 63 253 253 253 253 253 253
+ 253 253 253 253 253 85 10 78 40 253 15 8 59 113 253 120 253
+ 96 253 253 50 29 253 26 253 253 68 19 72 253 62 253 11 253
+ 253 253 253 15 253 253 253 21 253 84 253 0 50 253 55 24 107
+ 119 24 253 97 14 253 36 102 253 32 253 253 253 116 253 253
+ 253 87 83 253 253 253 81 107 253 253 53 253 18 7 35 253 253
+ 253 44 253 37 105 17 119 28 253 253 82 28 253 253 82 253 18
+ 49 253 69 79 253 253 75 121 32 92 253 73 28 253 253 68 69
+ 253 65 253 106 253 253 253 36 49 253 38 61 87 253 253 253
+ 253 253 94 68 253 95 253 66 253 253 253 253 253 253 97 253
+ 72 253 106 109 6 103 93 253 253 253 253 253 58 110 253 253
+ 2 36 4 1 253 253 253 253 15 253 44 108 253 253 124 25 253
+ 127 253 253 71 253 82 107 123 49 34 253 113 253 253 71 253
+ 253 65 253 88 87 42 6 22 110 1 253 253 253 92 121 84 253
+ 253 253 5 253 253 253 88 253 84 19 253 93 253 65 111 103
+ 253 84 253 104 253 253 65 253 253 82 253 42 66 253 41 31
+ 253 253 17 253 253 44 28 253 92 253 109 253 253 113 110 253
+ 74 253 253 30 253 84 253 253 127 253 253 253 253 3 253 4
+ 253 253 253 253 108 253 253 14 114 49 253 95 253 253 127
+ 253 72 253 253 53 41 87 12 253 253 253 39 253 83 253 253
+ 253 253 253 253 26 253 253 253 11 253 253 16 82 114 78 78
+ 106 95 253 253 17 253 253 69 253 253 253 31 253 84 253 106
+ 253 253 253 27 98 253 253 102 10 87 29 253 106 99 253 253
+ 50 71 253 253 253 253 253 73 253 253 31 90 253 253 100 73
+ 45 23 31 79 253 253 253 104 84 253 253 253 120 253 253 71
+ 253 83 253 66 55 75 114 253 253 253 43 253 0 25 253 21 16
+ 253 253 18 107 104 253 110 11 55 0 15 253 123 84 253 253
+ 120 253 253 253 253 253 253 253 8 25 253 118 65 253 60 253
+ 253 119 253 253 253 49 253 36 253 253 253 92 253 253 253
+ 253 44 85 253 253 253 94 42 253 253 253 90 253 105 253 56
+ 253 253 253 253 253 253 253 117 253 253 9 253 123 253 253
+ 105 34 104 253 253 253 253 253 127 253 84 31 89 91 253 253
+ 253 99 253 30 82 55 40 29 253 253 253 253 23 253 41 112 253
+ 253 253 253 103 253 102 123 253 95 57 253 33 24 3 253 42 61
+ 253 120 51 36 69 109 119 3 47 253 61 78 15 21 33 253 253
+ 253 253 253 9 70 84 15 54 125 253 116 253 253 24 93 253 253
+ 253 6 6 59 26 253 17 253 72 253 253 253 98 108 27 117 4 253
+ 253 92 253 111 253 65 253 64 98 75 43 87 17 253 253 44 56
+ 253 253 253 3 107 110 99 99 52 253 50 253 56 99 253 253 123
+ 253 253 77 38 253 37 101 253 31 253 253 70 43 253 110 82 10
+ 253 253 253 253 53 253 71 253 87 253 28 253 88 121 125 43
+ 253 253 26 253 50 253 22 253 111 253 16 253 42 253 253 253
+ 9 253 253 253 253 126 10 253 13 109 253 115 253 31 253 253
+ 42 253 253 253 253 11 77 253 25 36 73 90 110 253 15 57 253
+ 253 253 25 253 84 55 253 253 97 21 253 74 253 253 15 54 253
+ 121 53 5 253 9 86 253 105 118 253 253 119 253 33 253 84 253
+ 253 21 253 253 253 253 35 253 253 0 49 253 56 253 253 253
+ 110 253 253 253 253 253 253 253 253 90 253 99 253 9 14 253
+ 90 57 49 253 253 111 253 87 253 253 79 4 253 52 253 43 253
+ 253 253 253 124 12 253 122 253 253 6 253 253 110 1 253 103
+ 63 253 253 81 253 94 253 253 25 253 40 87 70 253 127 81 253
+ 253 103 45 29 253 28 253 48 253 15 253 27 253 253 18 27 119
+ 253 2 63 76 85 253 253 89 253 73 26 42 253 253 28 253 85
+ 253 253 29 42 75 253 253 253 253 24 253 253 253 0 15 30 253
+ 113 253 253 55 16 253 253 253 253 60 253 123 85 99 253 114
+ 253 253 253 1 29 253 9 253 253 87 9 253 253 253 253 253 54
+ 73 253 76 253 253 253 121 119 112 64 253 42 68 34 23 10 4
+ 109 253 253 76 253 253 54 110 253 87 253 43 32 253 253 7
+ 253 253 62 104 253 107 26 118 99 253 253 253 253 14 121 253
+ 86 125 99 253 253 253 5 105 110 23 96 62 102 65 87 101 253
+ 253 101 30 59 253 121 253 253 51 70 50 13 67 253 253 46 253
+ 253 253 253 253 53 253 253 74 7 6 253 253 253 68 117 253 48
+ 8 253 72 253 50 38 253 33 116 108 253 253 19 253 253 62 59
+ 253 113 87 71 94 253 47 38 253 253 253 253 43 97 86 253 253
+ 253 253 34 253 253 48 85 253 253 253 43 2 74 253 253 253
+ 103 253 253 101 39 253 25 53 253 253 253 253 253 253 115 85
+ 64 52 253 22 80 253 24 56 253 253 78 253 8 0 119 253 23 253
+ 253 27 113 253 75 253 10 253 253 2 253 105 253 253 24 105
+ 58 110 10 253 74 18 253 0 63 253 110 253 253 253 253 253
+ 253 253 99 11 253 72 253 117 31 253 85 253 61 253 78 15 253
+ 253 253 253 253 90 253 116 253 76 50 253 253 253 253 21 253
+ 8 253 109 253 18 57 24 253 253 124 253 253 109 253 253 253
+ 22 253 20 253 253 253 118 253 253 29 253 253 35 253 62 253
+ 253 63 253 253 85 109 253 253 253 253 125 253 253 253 87
+ 253 98 253 117 42 253 113 253 90 253 253 253 253 77 253 110
+ 253 109 253 14 253 253 95 13 253 45 253 81 90 100 44 23 253
+ 253 253 127 253 253 253 91 253 68 45 106 253 253 253 24 253
+ 253 253 253 253 253 253 93 253 253 253 253 253 253 122 65
+ 253 25 253 95 253 253 16 51 253 79 27 105 253 253 253 253
+ 121 253 39 60 39 253 105 253 253 13 253 8 84 102 112 4 112
+ 253 253 253 52 108 80 71 23 253 253 253 253 253 253 253 32
+ 81 253 82 62 253 253 253 80 253 114 126 253 253 253 38 253
+ 59 17 121 1 113 253 118 253 253 253 253 107 253 253 36 105
+ 253 253 253 253 94 57 82 119 47 253 253 253 253 253 253 6
+ 72 31 253 35 253 253 106 253 253 253 5 253 124 86 101 12
+ 253 253 253 24 57 253 253 20 253 96 253 62 69 19 13 253 253
+ 253 71 253 120 253 102 52 253 253 105 253 253 61 253 253
+ 253 253 18 253 50 12 125 90 253 253 19 103 253 120 18 253
+ 96 253 0 125 104 103 253 253 101 253 106 253 27 79 111 74
+ 253 105 253 119 57 114 90 45 126 253 253 86 253 102 55 40 8
+ 253 253 78 253 31 60 86 95 253 107 253 253 253 111 47 36
+ 253 253 253 27 253 253 253 253 41 253 253 81 253 112 123
+ 253 253 253 253 253 253 253 253 253 253 253 253 56 99 253
+ 43 253 30 95 253 253 253 253 253 67 62 253 253 0 22 88 89
+ 78 253 89 253 24 85 62 253 68 253 253 20 253 253 120 253 15
+ 39 253 253 253 253 253 253 21 100 253 93 81 253 253 253 253
+ 121 253 253 27 253 9 24 97 75 253 109 253 123 253 253 118
+ 253 72 253 21 59 6 6 11 55 106 253 82 253 57 41 69 21 69
+ 253 107 60 253 93 253 253 253 253 75 55 4 26 2 253 55 93
+ 253 253 253 91 253 253 253 120 75 253 253 29 253 253 75 118
+ 30 253 100 81 28 253 253 253 70 72 253 253 253 0 76 253 124
+ 23 81 107 2 253 70 253 7 253 253 253 253 253 253 253 73 100
+ 253 253 253 253 35 12 21 253 253 9 253 51 253 105 253 253
+ 53 253 47 106 253 55 253 81 38 253 29 253 253 92 253 253
+ 253 253 93 2 253 253 253 55 27 253 253 97 253 253 15 253 0
+ 253 15 107 253 253 127 107 93 71 0 253 253 253 97 253 253
+ 253 113 30 18 114 86 36 253 253 253 253 253 253 253 20 15
+ 253 253 27 253 253 253 95 61 33 125 253 253 99 253 94 2 253
+ 115 73 32 253 253 253 84 253 253 253 253 253 253 253 253
+ 253 253 253 4 253 0 253 253 82 24 253 253 56 253 36 253 253
+ 113 253 253 37 253 31 253 36 253 253 26 253 253 53 253 253
+ 37 253 47 13 253 65 72 33 253 61 253 253 253 89 253 253 76
+ 97 253 43 49 253 10 253 127 253 253 61 253 48 253 93 253
+ 124 253 17 253 253 253 253 253 253 253 4 253 253 41 253 39
+ 253 253 87 62 73 253 253 98 253 253 77 70 253 105 110 253
+ 253 253 50 89 41 253 0 253 31 106 9 108 115 118 253 36 98
+ 88 253 253 95 253 13 31 102 253 253 253 253 35 60 253 253
+ 253 83 253 253 253 253 253 253 253 253 108 253 253 0 253
+ 253 53 72 253 121 20 116 253 19 253 253 253 253 12 107 17
+ 119 253 253 253 253 253 0 10 253 253 253 253 253 40 253 253
+ 253 81 253 253 253 253 253 253 253 18 40 253 82 0 5 253 253
+ 253 22 253 118 253 113 253 59 26 253 253 93 108 253 253 92
+ 253 253 53 253 127 253 253 78 87 253 30 253 253 253 253 25
+ 253 48 24 118 49 253 113 76 253 89 99 56 253 67 253 20 120
+ 253 253 125 13 55 16 8 111 253 76 253 253 37 39 25 253 14
+ 253 1 253 117 1 253 101 253 74 96 55 253 88 23 253 19 70
+ 253 253 253 253 253 62 253 21 253 72 253 54 253 70 253 84
+ 253 253 253 63 253 253 18 253 119 253 253 253 107 253 253
+ 101 112 48 74 253 253 253 253 55 253 21 253 101 109 253 118
+ 253 49 87 253 253 11 59 89 253 253 253 253 253 86 11 253 86
+ 253 253 7 253 41 253 253 253 13 253 119 119 20 253 31 26 4
+ 253 53 253 253 114 56 253 35 253 253 99 16 93 253 253 253
+ 10 253 253 253 51 11 253 253 253 253 253 253 253 253 253
+ 253 97 117 253 31 253 45 253 253 253 87 253 253 82 14 253
+ 253 253 65 253 103 253 40 13 74 48 116 253 253 28 253 0 70
+ 122 48 73 253 67 52 22 253 253 88 93 253 60 253 56 20 89
+ 253 253 253 33 253 253 253 253 253 253 25 98 253 253 55 122
+ 253 90 253 99 38 253 253 63 253 253 253 253 10 48 53 33 253
+ 253 36 17 76 55 59 253 28 253 86 253 253 253 82 71 253 85
+ 253 86 253 253 253 253 253 253 253 73 66 253 253 28 253 253
+ 253 57 253 253 253 83 71 253 72 253 97 253 39 106 253 58
+ 253 67 121 30 253 68 253 253 34 103 253 57 60 49 253 84 253
+ 253 253 59 114 253 42 253 28 253 2 7 97 80 110 253 253 5
+ 253 253 18 27 253 57 60 113 253 126 253 55 253 253 253 66
+ 38 253 253 253 253 120 57 63 253 89 253 253 57 253 253 35
+ 72 23 119 0 253 253 253 35 81 253 253 253 13 8 118 33 253
+ 253 253 253 101 253 32 253 253 6 62 50 253 119 99 253 253
+ 74 122 253 253 110 253 253 253 11 253 29 253 253 72 253 114
+ 71 21 253 48 253 10 253 253 83 253 253 65 253 45 20 253 88
+ 253 52 253 91 27 253 104 80 253 18 119 122 253 253 253 11
+ 253 123 253 110 31 78 253 93 253 67 253 123 87 79 107 253
+ 53 253 253 253 43 75 17 253 253 253 125 253 253 253 253 253
+ 73 114 100 84 96 253 253 13 253 126 253 25 70 253 253 253
+ 253 253 35 253 116 253 253 253 16 52 253 42 253 253 253 253
+ 253 253 253 54 253 253 105 90 253 253 61 253 253 11 28 253
+ 83 253 253 253 83 253 253 253 253 253 253 253 100 253 253
+ 253 67 96 114 61 253 253 253 52 253 117 253 17 90 56 253
+ 253 12 253 35 56 21 60 77 73 253 83 253 253 253 72 253 253
+ 45 112 253 253 26 86 59 20 253 4 253 22 253 52 253 98 253
+ 253 253 253 253 62 57 253 18 54 253 253 3 253 253 83 78 253
+ 253 112 99 253 253 253 45 13 253 32 253 116 125 253 253 121
+ 253 104 253 253 101 253 253 0 253 253 253 5 116 62 253 120
+ 253 82 123 39 58 253 88 253 117 253 253 253 253 75 124 86
+ 253 24 253 253 70 253 253 7 253 53 60 253 253 43 117 253
+ 253 75 253 253 253 253 18 89 253 253 44 253 253 253 253 21
+ 253 10 123 253 51 253 253 115 253 107 253 36 253 253 253
+ 253 253 253 253 253 82 109 7 253 31 89 104 253 71 109 109
+ 253 94 4 253 253 253 253 50 8 253 54 253 253 17 253 253 253
+ 88 87 253 253 31 253 253 253 126 253 253 43 13 48 94 88 61
+ 253 70 63 26 253 88 253 33 125 253 253 51 253 253 106 29
+ 253 253 103 253 58 253 253 253 253 253 253 83 35 32 88 253
+ 253 32 47 114 126 253 19 253 253 253 253 117 253 33 253 81
+ 253 253 253 253 253 12 80 120 253 110 253 253 253 71 253
+ 253 66 44 55 19 90 71 253 75 253 253 25 253 115 90 253 73
+ 46 253 253 253 53 67 253 78 253 95 20 253 77 253 50 121 253
+ 104 253 253 75 253 253 34 253 253 253 253 3 16 253 3 253 47
+ 67 253 253 253 64 253 253 253 71 35 253 253 14 253 253 106
+ 253 62 27 253 16 253 253 61 253 105 48 253 18 253 96 22 95
+ 253 253 253 253 4 253 253 253 7 253 29 47 125 30 253 53 253
+ 253 253 253 253 253 253 30 64 253 253 253 253 103 28 123
+ 100 253 253 253 120 84 110 253 253 83 126 253 253 253 253
+ 253 37 253 253 116 44 56 85 36 55 24 253 253 253 253 83 123
+ 118 94 66 67 19 253 106 253 116 253 253 73 18 94 253 253
+ 253 83 95 253 76 253 76 46 112 253 31 253 87 31 73 116 253
+ 253 253 49 253 253 14 1 253 253 111 253 23 11 20 34 8 35
+ 253 253 56 253 3 21 104 90 90 27 93 253 36 126 35 253 253
+ 253 79 31 74 253 253 7 86 253 60 253 97 118 253 253 77 253
+ 118 253 253 253 91 90 53 253 28 125 253 21 253 60 50 253
+ 253 253 253 119 253 253 42 53 58 253 253 51 42 253 253 65
+ 253 23 94 12 69 100 253 35 253 123 253 60 253 253 253 20 27
+ 253 71 253 253 62 253 90 1 35 253 115 43 40 113 32 253 55
+ 124 84 47 253 100 253 49 253 253 253 253 65 253 124 91 253
+ 253 85 253 98 253 253 253 103 42 253 121 253 253 253 253
+ 253 253 253 253 253 253 253 90 125 253 91 107 253 105 7 253
+ 253 253 53 253 68 253 253 47 107 253 95 253 253 49 253 253
+ 48 28 73 25 253 253 253 253 87 253 0 253 253 253 51 100 253
+ 110 253 87 94 106 67 88 253 55 253 253 253 31 92 113 253 14
+ 73 253 85 87 253 82 4 253 253 124 253 253 253 253 253 68 52
+ 89 253 73 52 2 253 253 121 253 109 253 50 253 253 253 88 17
+ 102 253 253 253 35 253 75 253 27 110 253 76 253 20 96 253
+ 253 253 253 85 253 253 14 54 253 253 26 253 253 61 41 102
+ 253 41 253 21 253 253 253 39 253 50 253 48 253 253 253 253
+ 253 63 5 63 253 253 253 253 17 253 102 122 48 63 253 253
+ 253 253 253 43 126 71 253 253 90 253 72 79 253 253 253 253
+ 253 36 253 18 45 253 75 17 81 101 253 253 253 253 253 61 77
+ 15 111 122 253 87 65 253 118 253 253 30 253 253 253 253 253
+ 253 57 253 90 253 253 121 34 110 71 40 7 56 28 253 253 253
+ 40 253 47 99 253 126 4 117 253 253 253 253 253 63 253 44
+ 253 120 24 253 253 78 253 65 81 253 253 253 118 253 115 28
+ 0 107 253 253 28 89 253 253 253 77 54 89 34 32 253 105 56
+ 39 253 253 253 253 253 253 253 84 87 102 17 76 253 48 6 9
+ 253 253 253 14 60 65 253 51 253 45 102 103 1 100 253 253
+ 121 5 78 69 99 253 253 54 253 253 253 253 253 253 253 77 11
+ 253 253 39 17 71 112 253 23 28 253 35 253 253 62 253 53 253
+ 253 253 253 45 33 253 253 253 0 44 253 98 253 253 19 36 117
+ 72 253 253 253 42 72 253 38 120 62 253 112 27 80 5 35 111
+ 253 253 118 19 120 253 1 96 253 253 1 253 253 44 253 80 110
+ 253 253 253 105 253 64 253 30 253 21 253 25 100 25 82 48 69
+ 84 253 0 18 122 82 19 35 253 101 32 253 100 10 253 3 46 56
+ 96 104 109 66 253 27 253 253 253 253 253 253 253 40 253 27
+ 28 253 253 253 91 253 253 253 91 253 43 63 253 20 71 60 253
+ 253 0 74 125 253 93 69 117 98 88 93 253 22 253 92 4 253 253
+ 253 91 253 253 76 108 253 72 253 80 51 253 253 106 253 253
+ 253 41 68 253 111 29 253 8 253 253 253 253 113 253 124 37
+ 103 124 36 253 42 253 44 121 46 108 53 253 253 253 69 253
+ 108 253 65 253 253 253 119 253 253 23 253 253 104 37 253
+ 253 10 63 253 253 253 253 253 37 253 253 58 253 112 253 253
+ 64 253 48 79 253 89 90 93 253 253 253 253 89 253 103 253
+ 253 253 123 15 113 253 253 71 43 253 103 52 253 46 52 253
+ 27 93 253 99 116 253 253 44 86 253 253 69 253 44 253 253
+ 253 84 30 253 64 107 107 253 253 253 56 31 46 7 253 118 253
+ 253 253 90 253 253 93 253 54 253 118 57 42 57 253 253 253
+ 106 125 33 253 253 120 100 88 86 104 253 96 101 107 253 50
+ 253 37 105 28 253 253 253 116 14 253 253 253 253 253 55 51
+ 49 253 253 253 253 253 125 55 253 253 54 253 45 253 253 72
+ 253 253 70 55 15 122 253 52 46 253 253 253 253 55 253 253
+ 20 253 253 99 253 83 253 90 104 253 84 253 97 253 86 49 253
+ 36 96 253 53 253 253 253 37 253 253 253 110 253 253 116 79
+ 10 253 121 20 253 253 253 4 124 253 107 253 253 253 253 253
+ 54 253 105 24 72 253 55 253 253 253 253 53 253 253 253 253
+ 109 253 36 253 112 30 68 114 253 253 114 77 87 253 73 121
+ 253 91 253 253 87 46 253 121 71 253 253 73 101 116 253 253
+ 253 253 51 45 96 106 26 253 253 253 122 253 99 253 45 253 5
+ 54 253 30 253 253 253 253 253 253 253 3 20 253 253 253 253
+ 253 30 40 253 253 253 253 70 25 253 26 253 253 111 253 99
+ 253 253 60 253 70 37 3 253 92 80 79 108 76 253 56 253 25
+ 116 63 79 253 253 253 253 253 79 253 125 79 253 74 23 253
+ 25 253 28 115 88 253 253 12 33 19 253 119 253 253 58 38 55
+ 56 31 90 253 253 253 105 253 99 58 253 46 253 96 253 118
+ 253 253 253 52 67 253 102 253 48 253 253 51 69 253 44 126
+ 25 60 253 253 14 253 253 253 96 84 253 253 253 5 253 32 253
+ 69 103 253 40 114 26 253 15 253 253 81 253 253 253 253 80
+ 83 95 73 253 253 33 56 253 0 91 253 253 253 29 68 108 99 48
+ 253 9 253 0 124 253 24 63 110 106 11 253 117 110 253 53 253
+ 253 253 253 253 253 253 112 114 253 253 88 253 44 46 253
+ 253 33 253 79 253 253 73 85 84 16 253 253 253 87 37 124 96
+ 253 11 91 253 78 75 11 75 253 21 253 19 253 70 56 253 39 86
+ 253 53 253 70 57 32 253 253 82 253 14 28 13 253 87 253 253
+ 253 69 253 58 29 253 253 253 42 67 113 123 118 92 253 253 0
+ 99 253 107 112 79 253 106 253 45 253 37 253 105 14 112 123
+ 31 122 33 253 253 253 60 55 108 125 40 253 99 104 81 97 112
+ 253 253 253 253 65 22 96 73 253 253 74 253 253 27 60 53 9
+ 253 43 43 104 253 112 57 253 21 253 33 253 253 253 98 253
+ 253 13 32 12 253 65 7 253 74 253 253 253 57 253 111 83 253
+ 253 73 38 127 24 71 253 60 69 253 25 253 253 49 253 120 253
+ 253 103 117 253 253 253 253 113 253 253 253 253 253 31 106
+ 22 253 40 253 253 253 253 253 62 105 253 25 253 30 109 42
+ 253 113 253 253 253 253 253 57 253 44 44 48 59 119 253 52
+ 103 85 253 44 253 253 76 8 127 93 253 85 253 253 253 253 42
+ 71 74 116 70 253 2 253 94 14 113 253 97 253 253 87 65 253
+ 36 253 253 253 40 253 8 253 47 113 253 253 253 109 253 107
+ 253 37 60 253 253 253 83 253 253 253 253 39 87 0 110 35 253
+ 253 253 253 253 102 253 253 253 253 253 58 103 253 253 35
+ 48 52 114 32 24 253 253 253 253 91 107 253 253 253 5 253 4
+ 24 253 56 253 253 77 253 253 89 68 253 55 253 83 253 76 14
+ 126 253 52 253 253 55 253 253 76 253 253 126 87 3 253 90 82
+ 85 70 74 253 44 116 24 253 253 78 119 103 253 253 48 71 253
+ 253 92 104 253 253 253 17 76 111 253 253 253 253 109 38 72
+ 100 253 6 253 253 253 118 253 123 253 253 253 11 109 9 28
+ 253 253 253 32 100 84 69 110 253 253 253 253 66 253 111 253
+ 253 253 47 253 78 114 5 72 45 253 86 253 253 253 114 40 93
+ 253 253 57 253 41 93 253 81 253 127 253 15 253 38 120 34
+ 253 253 106 64 58 253 28 121 80 57 111 115 72 60 23 253 253
+ 29 74 89 38 86 253 45 253 253 253 253 253 253 253 121 8 5
+ 253 64 9 253 72 253 253 55 48 253 4 253 253 253 49 30 104
+ 253 111 253 253 253 253 253 19 253 253 253 124 39 95 253
+ 253 78 76 87 75 253 253 253 113 121 98 20 253 253 57 35 253
+ 253 253 93 11 13 253 253 253 54 84 253 253 80 7 38 253 58
+ 35 53 253 253 93 253 104 253 253 73 253 1 253 108 253 253
+ 253 253 253 253 69 41 253 253 5 253 253 37 253 253 253 253
+ 17 59 84 14 253 253 81 253 253 109 67 78 253 253 11 34 253
+ 253 253 253 253 253 101 253 253 49 253 253 253 73 253 104
+ 253 253 105 253 253 253 253 113 72 253 253 253 253 103 253
+ 253 253 253 46 253 253 56 253 78 253 253 253 253 253 101
+ 107 253 23 37 89 253 253 70 77 253 78 15 53 53 253 253 108
+ 253 253 253 107 120 253 42 253 253 65 65 253 253 104 253 54
+ 107 253 253 88 253 36 82 253 253 125 253 111 253 53 101 253
+ 127 253 40 122 253 253 253 86 41 3 253 253 15 106 253 125
+ 123 253 253 253 253 109 253 54 3 253 253 253 74 253 253 253
+ 53 75 253 109 97 70 253 253 253 253 253 105 90 109 253 111
+ 253 253 9 253 253 253 41 253 253 105 253 78 253 21 78 253
+ 253 55 253 72 253 33 98 31 253 253 253 15 253 75 116 79 253
+ 114 8 253 111 35 253 123 118 253 119 31 90 253 52 253 54 27
+ 24 253 253 125 253 253 253 113 84 73 62 253 253 253 18 122
+ 100 95 253 253 102 29 46 97 253 64 253 23 253 253 253 253
+ 253 83 253 28 108 25 253 31 111 122 253 43 108 253 71 253
+ 253 253 80 109 253 109 77 253 253 17 30 121 25 253 77 72
+ 253 83 126 253 253 23 107 26 253 60 253 253 40 24 111 253
+ 253 111 14 8 253 253 78 75 103 253 253 87 50 5 253 253 2 59
+ 253 79 21 253 11 103 110 253 18 6 62 253 253 105 28 253 10
+ 253 85 123 38 253 45 253 88 253 81 253 67 32 30 253 253 253
+ 253 253 80 253 114 253 22 10 253 108 30 62 253 253 79 46 46
+ 86 123 98 100 102 253 7 30 94 253 253 26 28 69 253 52 56 95
+ 109 253 109 253 108 51 253 253 23 253 104 253 253 25 13 31
+ 253 253 253 253 253 27 253 6 56 84 253 253 46 120 12 253 2
+ 253 115 20 110 253 110 19 253 253 110 21 62 253 253 253 253
+ 52 101 253 43 64 253 253 253 253 104 69 127 74 253 80 253
+ 253 253 253 253 51 253 253 14 15 253 106 253 253 253 39 75
+ 253 253 253 253 253 21 253 112 126 84 98 23 253 253 39 87
+ 253 253 253 49 71 82 114 25 71 106 253 122 253 37 253 40 50
+ 77 55 253 64 0 15 253 86 253 53 20 87 81 74 253 253 253 35
+ 67 39 101 253 36 99 253 104 9 50 253 54 253 253 35 253 13
+ 19 253 45 36 96 65 27 253 253 57 253 253 253 253 253 253 20
+ 4 73 253 103 24 253 20 253 122 116 122 47 253 253 253 9 253
+ 253 72 253 253 253 32 3 253 122 253 63 53 253 253 253 253
+ 34 253 253 60 253 253 61 253 253 253 253 12 102 253 69 26
+ 253 253 253 253 253 253 253 92 5 253 253 253 70 253 105 11
+ 47 253 253 253 80 87 253 0 253 253 63 253 253 253 86 253
+ 253 253 3 253 253 253 99 253 41 253 253 0 253 122 253 17 92
+ 253 118 127 253 253 253 1 253 30 18 86 253 51 253 253 253
+ 87 253 253 13 50 12 253 64 27 31 253 76 253 253 253 253 253
+ 253 120 123 80 41 253 115 253 106 40 253 98 43 123 253 111
+ 55 253 253 113 253 253 86 7 70 253 76 253 253 31 253 68 253
+ 253 253 253 253 96 62 253 253 253 253 90 28 253 253 99 253
+ 253 253 59 253 0 253 15 253 253 83 110 253 253 9 102 253 45
+ 253 253 102 253 39 28 253 253 253 98 41 253 253 39 68 253 0
+ 253 253 253 253 58 253 253 73 253 253 253 253 73 253 1 30
+ 253 97 104 253 253 253 253 253 103 118 253 253 71 253 25
+ 253 253 253 63 70 253 253 62 253 253 253 21 253 118 253 70
+ 253 253 27 99 71 253 253 253 65 53 34 253 253 77 74 253 47
+ 253 114 58 253 68 253 253 31 99 89 253 11 253 253 253 253
+ 99 253 30 56 253 54 253 74 253 102 50 61 253 253 253 253
+ 120 56 63 32 61 253 78 23 253 53 94 105 26 253 253 253 34
+ 65 253 88 253 66 253 253 253 253 253 63 92 122 84 253 253
+ 253 75 253 253 68 253 34 253 79 253 1 253 253 74 70 19 118
+ 253 11 253 67 44 253 253 18 6 253 253 253 75 253 90 253 71
+ 102 253 253 124 253 253 64 253 253 253 253 97 253 253 50
+ 253 253 82 7 96 253 253 91 106 39 253 253 253 253 253 253
+ 253 253 253 71 253 35 84 253 21 253 253 253 49 34 253 13
+ 253 24 253 103 45 29 253 253 82 84 253 253 56 81 69 253 110
+ 49 40 48 52 89 28 253 19 253 21 253 253 253 73 253 104 253
+ 253 125 8 28 253 253 108 77 38 107 71 120 253 109 66 69 16
+ 38 82 253 253 28 253 80 86 73 58 66 99 117 124 253 57 70
+ 253 0 253 100 253 60 78 89 81 253 49 253 8 114 63 253 253
+ 116 48 99 44 253 63 45 253 123 253 253 253 253 120 253 253
+ 97 102 63 253 69 97 52 253 253 253 68 253 253 57 253 109
+ 253 0 106 85 253 92 92 253 21 69 112 253 253 32 253 22 253
+ 24 41 50 63 253 253 253 253 253 87 118 253 253 73 27 253
+ 253 101 126 253 253 122 253 93 117 30 253 38 253 253 94 253
+ 253 253 19 253 109 30 48 78 61 8 253 253 253 253 253 92 25
+ 97 105 87 253 253 253 253 85 253 17 253 3 72 253 125 66 13
+ 98 253 253 253 253 71 112 23 37 99 32 78 61 73 24 253 79 39
+ 25 253 120 253 253 253 253 1 253 55 105 253 17 253 253 253
+ 253 253 50 253 52 253 253 7 253 23 253 0 253 253 253 253 66
+ 253 253 52 253 253 253 253 253 28 253 253 104 115 253 97
+ 103 13 253 253 96 253 28 40 253 253 253 253 253 63 253 52
+ 253 46 47 253 253 48 50 253 253 253 253 253 71 81 68 114 91
+ 118 253 97 253 253 253 85 49 253 102 253 253 67 253 110 96
+ 88 253 77 109 119 50 253 253 24 253 45 253 71 109 24 101
+ 102 64 253 57 11 253 253 73 253 73 79 253 253 37 253 253
+ 253 253 40 14 253 253 115 253 7 253 7 113 54 253 48 253 253
+ 85 126 253 253 71 11 42 110 109 253 253 0 253 108 127 253
+ 105 72 101 253 253 253 253 88 253 253 2 54 15 253 83 59 253
+ 85 5 105 253 55 253 93 253 253 118 52 46 253 34 67 3 253
+ 253 93 253 101 3 36 83 68 253 84 92 253 100 125 253 38 253
+ 36 253 4 253 253 108 253 30 253 253 253 94 253 253 12 253
+ 253 90 253 253 99 86 111 12 54 91 105 253 21 39 253 85 253
+ 253 98 82 253 253 6 60 79 253 82 253 46 253 253 253 104 12
+ 1 253 78 253 114 104 253 253 253 253 253 57 60 253 6 101
+ 253 253 253 253 81 253 62 94 77 44 253 253 83 42 23 253 253
+ 253 253 21 29 253 253 34 253 253 253 253 69 1 3 45 52 253
+ 103 31 65 253 0 106 47 91 253 45 44 81 253 95 21 253 29 253
+ 26 33 44 253 253 21 16 253 126 253 253 8 253 109 13 253 253
+ 253 253 253 99 113 253 253 253 41 1 253 62 253 253 104 253
+ 69 36 253 49 42 23 253 52 253 253 99 253 61 253 253 253 53
+ 253 37 34 253 253 253 253 253 253 60 253 253 76 125 9 253
+ 86 14 253 253 114 73 40 253 253 54 109 253 45 253 72 253
+ 253 253 253 117 47 253 253 253 253 93 78 253 76 35 253 253
+ 253 253 253 253 79 21 253 253 253 253 58 253 253 253 39 253
+ 64 253 43 3 253 34 253 253 253 16 253 70 253 253 253 253 69
+ 75 117 253 253 253 253 253 253 37 253 253 15 253 253 112
+ 253 61 253 71 36 253 44 93 253 85 69 253 253 85 253 3 253
+ 253 253 253 96 253 253 253 253 253 63 74 253 29 253 53 253
+ 102 73 6 253 253 253 253 253 0 253 106 85 253 253 99 253 79
+ 45 253 38 30 253 253 253 253 253 120 253 253 64 8 253 15
+ 253 1 253 70 11 124 253 253 253 35 20 253 9 35 116 37 90
+ 253 5 253 29 253 65 253 18 253 0 67 253 253 0 116 253 90 41
+ 16 1 253 253 253 253 106 24 253 61 253 110 27 253 54 253 61
+ 253 78 253 253 110 34 253 47 253 55 253 253 253 253 253 253
+ 253 85 253 253 73 118 116 253 253 109 63 253 253 83 53 253
+ 253 126 253 253 253 80 80 253 253 253 15 253 122 95 253 253
+ 253 122 253 88 253 253 253 253 95 253 253 253 107 86 253
+ 253 253 253 253 87 253 31 253 253 77 253 121 253 0 253 253
+ 49 127 90 95 253 253 122 253 74 253 253 99 253 253 104 22
+ 253 253 125 253 253 253 253 69 126 253 253 253 253 253 79
+ 253 253 94 253 80 8 60 253 253 95 253 100 253 253 74 253
+ 122 253 253 62 46 253 26 253 253 253 79 253 253 94 253 47
+ 30 253 253 126 253 81 253 253 253 253 253 253 100 253 253
+ 63 45 125 253 253 253 253 0 109 122 253 80 253 253 51 91
+ 253 253 253 253 253 94 253 85 95 253 253 253 253 253 126
+ 253 111 253 63 253 94 253 83 46 253 253 253 253 253 253 91
+ 117 15 253 253 253 122 253 253 58 253 253 253 111 253 253
+ 253 127 253 39 253 85 253 253 17 88 116 253 253 253 253 253
+ 253 253 253 87 253 253 16 77 109 253 105 105 76 253 253 253
+ 253 94 253 253 253 87 253 0 50 253 0 253 88 71 253 10 253
+ 122 253 64 253 253 253 253 253 253 85 253 0 106 253 94 253
+ 125 253 35 47 253 58 105 99 253 68 253 0 253 253 87 253 253
+ 253 63 253 253 13 10 45 45 45 45 45 45 87 101 98 75 105 116
+ 70 111 114 109 66 111 117 110 100 97 114 121 115 105 103
+ 113 43 53 113 87 116 54 79 114 122 56 76 79 45 45 13 10
+ } >string ;
+
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators io kernel locals math multiline
+sequences splitting prettyprint ;
+IN: mime.multipart
+
+TUPLE: multipart-stream stream n leftover separator ;
+
+: <multipart-stream> ( stream separator -- multipart-stream )
+ multipart-stream new
+ swap >>separator
+ swap >>stream
+ 16 2^ >>n ;
+
+<PRIVATE
+
+: ?append ( seq1 seq2 -- newseq/seq2 )
+ over [ append ] [ nip ] if ;
+
+: ?cut* ( seq n -- before after )
+ over length over <= [ drop f swap ] [ cut* ] if ;
+
+: read-n ( stream -- bytes end-stream? )
+ [ f ] change-leftover
+ [ n>> ] [ stream>> ] bi stream-read [ ?append ] keep not ;
+
+: multipart-split ( bytes separator -- before after seq=? )
+ 2dup sequence= [ 2drop f f t ] [ split1 f ] if ;
+
+:: multipart-step-found ( bytes stream quot -- ? )
+ bytes [
+ quot unless-empty
+ ] [
+ stream (>>leftover)
+ quot unless-empty
+ ] if-empty f quot call f ;
+
+:: multipart-step-not-found ( stream end-stream? separator quot -- ? )
+ end-stream? [
+ quot unless-empty f
+ ] [
+ separator length 1- ?cut* stream (>>leftover)
+ quot unless-empty t
+ ] if ;
+
+:: multipart-step ( stream bytes end-stream? separator quot: ( bytes -- ) -- ? end-stream? )
+ #! return t to loop again
+ bytes separator multipart-split
+ [ 2drop f quot call f ]
+ [
+ [ stream quot multipart-step-found ]
+ [ stream end-stream? separator quot multipart-step-not-found ] if*
+ ] if stream leftover>> end-stream? not or ;
+
+PRIVATE>
+
+:: multipart-step-loop ( stream quot1: ( bytes -- ) quot2: ( -- ) -- ? )
+ stream dup [ read-n ] [ separator>> ] bi quot1 multipart-step
+ swap [ drop stream quot1 quot2 multipart-step-loop ] quot2 if ;
+
+: multipart-loop-all ( stream quot1: ( bytes -- ) quot2: ( -- ) -- )
+ 3dup multipart-step-loop
+ [ multipart-loop-all ] [ 3drop ] if ;
--- /dev/null
+Slava Pestov
--- /dev/null
+# This is a comment. I love comments.
+
+# This file controls what Internet media types are sent to the client for
+# given file extension(s). Sending the correct media type to the client
+# is important so they know how to handle the content of the file.
+# Extra types can either be added here or by using an AddType directive
+# in your config files. For more information about Internet media types,
+# please read RFC 2045, 2046, 2047, 2048, and 2077. The Internet media type
+# registry is at <http://www.iana.org/assignments/media-types/>.
+
+# MIME type Extensions
+application/activemessage
+application/andrew-inset ez
+application/applefile
+application/atom+xml atom
+application/atomcat+xml atomcat
+application/atomicmail
+application/atomsvc+xml atomsvc
+application/auth-policy+xml
+application/batch-smtp
+application/beep+xml
+application/cals-1840
+application/ccxml+xml ccxml
+application/cellml+xml
+application/cnrp+xml
+application/commonground
+application/conference-info+xml
+application/cpl+xml
+application/csta+xml
+application/cstadata+xml
+application/cybercash
+application/davmount+xml davmount
+application/dca-rft
+application/dec-dx
+application/dialog-info+xml
+application/dicom
+application/dns
+application/dvcs
+application/ecmascript ecma
+application/edi-consent
+application/edi-x12
+application/edifact
+application/epp+xml
+application/eshop
+application/fastinfoset
+application/fastsoap
+application/fits
+application/font-tdpfr pfr
+application/h224
+application/http
+application/hyperstudio stk
+application/iges
+application/im-iscomposing+xml
+application/index
+application/index.cmd
+application/index.obj
+application/index.response
+application/index.vnd
+application/iotp
+application/ipp
+application/isup
+application/javascript js
+application/json json
+application/kpml-request+xml
+application/kpml-response+xml
+application/mac-binhex40 hqx
+application/mac-compactpro cpt
+application/macwriteii
+application/marc mrc
+application/mathematica ma nb mb
+application/mathml+xml mathml
+application/mbms-associated-procedure-description+xml
+application/mbms-deregister+xml
+application/mbms-envelope+xml
+application/mbms-msk+xml
+application/mbms-msk-response+xml
+application/mbms-protection-description+xml
+application/mbms-reception-report+xml
+application/mbms-register+xml
+application/mbms-register-response+xml
+application/mbms-user-service-description+xml
+application/mbox mbox
+application/mediaservercontrol+xml mscml
+application/mikey
+application/mp4 mp4s
+application/mpeg4-generic
+application/mpeg4-iod
+application/mpeg4-iod-xmt
+application/msword doc dot
+application/mxf mxf
+application/nasdata
+application/news-message-id
+application/news-transmission
+application/nss
+application/ocsp-request
+application/ocsp-response
+application/octet-stream bin dms lha lzh class so iso dmg dist distz pkg bpk dump elc scpt
+application/oda oda
+application/oebps-package+xml
+application/ogg ogg
+application/parityfec
+application/pdf pdf
+application/pgp-encrypted pgp
+application/pgp-keys
+application/pgp-signature asc sig
+application/pics-rules prf
+application/pidf+xml
+application/pkcs10 p10
+application/pkcs7-mime p7m p7c
+application/pkcs7-signature p7s
+application/pkix-cert cer
+application/pkix-crl crl
+application/pkix-pkipath pkipath
+application/pkixcmp pki
+application/pls+xml pls
+application/poc-settings+xml
+application/postscript ai eps ps
+application/prs.alvestrand.titrax-sheet
+application/prs.cww cww
+application/prs.nprend
+application/prs.plucker
+application/qsig
+application/rdf+xml rdf
+application/reginfo+xml rif
+application/relax-ng-compact-syntax rnc
+application/remote-printing
+application/resource-lists+xml rl
+application/riscos
+application/rlmi+xml
+application/rls-services+xml rs
+application/rsd+xml rsd
+application/rss+xml rss
+application/rtf rtf
+application/rtx
+application/samlassertion+xml
+application/samlmetadata+xml
+application/sbml+xml sbml
+application/sdp sdp
+application/set-payment
+application/set-payment-initiation setpay
+application/set-registration
+application/set-registration-initiation setreg
+application/sgml
+application/sgml-open-catalog
+application/shf+xml shf
+application/sieve
+application/simple-filter+xml
+application/simple-message-summary
+application/simplesymbolcontainer
+application/slate
+application/smil
+application/smil+xml smi smil
+application/soap+fastinfoset
+application/soap+xml
+application/spirits-event+xml
+application/srgs gram
+application/srgs+xml grxml
+application/ssml+xml ssml
+application/timestamp-query
+application/timestamp-reply
+application/tve-trigger
+application/vemmi
+application/vividence.scriptfile
+application/vnd.3gpp.bsf+xml
+application/vnd.3gpp.pic-bw-large plb
+application/vnd.3gpp.pic-bw-small psb
+application/vnd.3gpp.pic-bw-var pvb
+application/vnd.3gpp.sms
+application/vnd.3gpp2.bcmcsinfo+xml
+application/vnd.3gpp2.sms
+application/vnd.3m.post-it-notes pwn
+application/vnd.accpac.simply.aso aso
+application/vnd.accpac.simply.imp imp
+application/vnd.acucobol acu
+application/vnd.acucorp atc acutc
+application/vnd.adobe.xdp+xml xdp
+application/vnd.adobe.xfdf xfdf
+application/vnd.aether.imp
+application/vnd.amiga.ami ami
+application/vnd.anser-web-certificate-issue-initiation cii
+application/vnd.anser-web-funds-transfer-initiation fti
+application/vnd.antix.game-component atx
+application/vnd.apple.installer+xml mpkg
+application/vnd.audiograph aep
+application/vnd.autopackage
+application/vnd.avistar+xml
+application/vnd.blueice.multipass mpm
+application/vnd.bmi bmi
+application/vnd.businessobjects rep
+application/vnd.cab-jscript
+application/vnd.canon-cpdl
+application/vnd.canon-lips
+application/vnd.cendio.thinlinc.clientconf
+application/vnd.chemdraw+xml cdxml
+application/vnd.chipnuts.karaoke-mmd mmd
+application/vnd.cinderella cdy
+application/vnd.cirpack.isdn-ext
+application/vnd.claymore cla
+application/vnd.clonk.c4group c4g c4d c4f c4p c4u
+application/vnd.commerce-battelle
+application/vnd.commonspace csp cst
+application/vnd.contact.cmsg cdbcmsg
+application/vnd.cosmocaller cmc
+application/vnd.crick.clicker clkx
+application/vnd.crick.clicker.keyboard clkk
+application/vnd.crick.clicker.palette clkp
+application/vnd.crick.clicker.template clkt
+application/vnd.crick.clicker.wordbank clkw
+application/vnd.criticaltools.wbs+xml wbs
+application/vnd.ctc-posml pml
+application/vnd.cups-pdf
+application/vnd.cups-postscript
+application/vnd.cups-ppd ppd
+application/vnd.cups-raster
+application/vnd.cups-raw
+application/vnd.curl curl
+application/vnd.cybank
+application/vnd.data-vision.rdz rdz
+application/vnd.denovo.fcselayout-link fe_launch
+application/vnd.dna dna
+application/vnd.dolby.mlp mlp
+application/vnd.dpgraph dpg
+application/vnd.dreamfactory dfac
+application/vnd.dvb.esgcontainer
+application/vnd.dvb.ipdcesgaccess
+application/vnd.dxr
+application/vnd.ecdis-update
+application/vnd.ecowin.chart mag
+application/vnd.ecowin.filerequest
+application/vnd.ecowin.fileupdate
+application/vnd.ecowin.series
+application/vnd.ecowin.seriesrequest
+application/vnd.ecowin.seriesupdate
+application/vnd.enliven nml
+application/vnd.epson.esf esf
+application/vnd.epson.msf msf
+application/vnd.epson.quickanime qam
+application/vnd.epson.salt slt
+application/vnd.epson.ssf ssf
+application/vnd.ericsson.quickcall
+application/vnd.eszigno3+xml es3 et3
+application/vnd.eudora.data
+application/vnd.ezpix-album ez2
+application/vnd.ezpix-package ez3
+application/vnd.fdf fdf
+application/vnd.ffsns
+application/vnd.fints
+application/vnd.flographit gph
+application/vnd.fluxtime.clip ftc
+application/vnd.framemaker fm frame maker
+application/vnd.frogans.fnc fnc
+application/vnd.frogans.ltf ltf
+application/vnd.fsc.weblaunch fsc
+application/vnd.fujitsu.oasys oas
+application/vnd.fujitsu.oasys2 oa2
+application/vnd.fujitsu.oasys3 oa3
+application/vnd.fujitsu.oasysgp fg5
+application/vnd.fujitsu.oasysprs bh2
+application/vnd.fujixerox.art-ex
+application/vnd.fujixerox.art4
+application/vnd.fujixerox.hbpl
+application/vnd.fujixerox.ddd ddd
+application/vnd.fujixerox.docuworks xdw
+application/vnd.fujixerox.docuworks.binder xbd
+application/vnd.fut-misnet
+application/vnd.fuzzysheet fzs
+application/vnd.genomatix.tuxedo txd
+application/vnd.google-earth.kml+xml kml
+application/vnd.google-earth.kmz kmz
+application/vnd.grafeq gqf gqs
+application/vnd.gridmp
+application/vnd.groove-account gac
+application/vnd.groove-help ghf
+application/vnd.groove-identity-message gim
+application/vnd.groove-injector grv
+application/vnd.groove-tool-message gtm
+application/vnd.groove-tool-template tpl
+application/vnd.groove-vcard vcg
+application/vnd.handheld-entertainment+xml zmm
+application/vnd.hbci hbci
+application/vnd.hcl-bireports
+application/vnd.hhe.lesson-player les
+application/vnd.hp-hpgl hpgl
+application/vnd.hp-hpid hpid
+application/vnd.hp-hps hps
+application/vnd.hp-jlyt jlt
+application/vnd.hp-pcl pcl
+application/vnd.hp-pclxl pclxl
+application/vnd.httphone
+application/vnd.hzn-3d-crossword x3d
+application/vnd.ibm.afplinedata
+application/vnd.ibm.electronic-media
+application/vnd.ibm.minipay mpy
+application/vnd.ibm.modcap afp listafp list3820
+application/vnd.ibm.rights-management irm
+application/vnd.ibm.secure-container sc
+application/vnd.igloader igl
+application/vnd.immervision-ivp ivp
+application/vnd.immervision-ivu ivu
+application/vnd.informedcontrol.rms+xml
+application/vnd.intercon.formnet xpw xpx
+application/vnd.intertrust.digibox
+application/vnd.intertrust.nncp
+application/vnd.intu.qbo qbo
+application/vnd.intu.qfx qfx
+application/vnd.ipunplugged.rcprofile rcprofile
+application/vnd.irepository.package+xml irp
+application/vnd.is-xpr xpr
+application/vnd.jam jam
+application/vnd.japannet-directory-service
+application/vnd.japannet-jpnstore-wakeup
+application/vnd.japannet-payment-wakeup
+application/vnd.japannet-registration
+application/vnd.japannet-registration-wakeup
+application/vnd.japannet-setstore-wakeup
+application/vnd.japannet-verification
+application/vnd.japannet-verification-wakeup
+application/vnd.jcp.javame.midlet-rms rms
+application/vnd.jisp jisp
+application/vnd.kahootz ktz ktr
+application/vnd.kde.karbon karbon
+application/vnd.kde.kchart chrt
+application/vnd.kde.kformula kfo
+application/vnd.kde.kivio flw
+application/vnd.kde.kontour kon
+application/vnd.kde.kpresenter kpr kpt
+application/vnd.kde.kspread ksp
+application/vnd.kde.kword kwd kwt
+application/vnd.kenameaapp htke
+application/vnd.kidspiration kia
+application/vnd.kinar kne knp
+application/vnd.koan skp skd skt skm
+application/vnd.liberty-request+xml
+application/vnd.llamagraphics.life-balance.desktop lbd
+application/vnd.llamagraphics.life-balance.exchange+xml lbe
+application/vnd.lotus-1-2-3 123
+application/vnd.lotus-approach apr
+application/vnd.lotus-freelance pre
+application/vnd.lotus-notes nsf
+application/vnd.lotus-organizer org
+application/vnd.lotus-screencam scm
+application/vnd.lotus-wordpro lwp
+application/vnd.macports.portpkg portpkg
+application/vnd.marlin.drm.actiontoken+xml
+application/vnd.marlin.drm.conftoken+xml
+application/vnd.marlin.drm.mdcf
+application/vnd.mcd mcd
+application/vnd.medcalcdata mc1
+application/vnd.mediastation.cdkey cdkey
+application/vnd.meridian-slingshot
+application/vnd.mfer mwf
+application/vnd.mfmp mfm
+application/vnd.micrografx.flo flo
+application/vnd.micrografx.igx igx
+application/vnd.mif mif
+application/vnd.minisoft-hp3000-save
+application/vnd.mitsubishi.misty-guard.trustweb
+application/vnd.mobius.daf daf
+application/vnd.mobius.dis dis
+application/vnd.mobius.mbk mbk
+application/vnd.mobius.mqy mqy
+application/vnd.mobius.msl msl
+application/vnd.mobius.plc plc
+application/vnd.mobius.txf txf
+application/vnd.mophun.application mpn
+application/vnd.mophun.certificate mpc
+application/vnd.motorola.flexsuite
+application/vnd.motorola.flexsuite.adsi
+application/vnd.motorola.flexsuite.fis
+application/vnd.motorola.flexsuite.gotap
+application/vnd.motorola.flexsuite.kmr
+application/vnd.motorola.flexsuite.ttc
+application/vnd.motorola.flexsuite.wem
+application/vnd.mozilla.xul+xml xul
+application/vnd.ms-artgalry cil
+application/vnd.ms-asf asf
+application/vnd.ms-cab-compressed cab
+application/vnd.ms-excel xls xlm xla xlc xlt xlw
+application/vnd.ms-fontobject eot
+application/vnd.ms-htmlhelp chm
+application/vnd.ms-ims ims
+application/vnd.ms-lrm lrm
+application/vnd.ms-playready.initiator+xml
+application/vnd.ms-powerpoint ppt pps pot
+application/vnd.ms-project mpp mpt
+application/vnd.ms-tnef
+application/vnd.ms-wmdrm.lic-chlg-req
+application/vnd.ms-wmdrm.lic-resp
+application/vnd.ms-wmdrm.meter-chlg-req
+application/vnd.ms-wmdrm.meter-resp
+application/vnd.ms-works wps wks wcm wdb
+application/vnd.ms-wpl wpl
+application/vnd.ms-xpsdocument xps
+application/vnd.mseq mseq
+application/vnd.msign
+application/vnd.music-niff
+application/vnd.musician mus
+application/vnd.ncd.control
+application/vnd.nervana
+application/vnd.netfpx
+application/vnd.neurolanguage.nlu nlu
+application/vnd.noblenet-directory nnd
+application/vnd.noblenet-sealer nns
+application/vnd.noblenet-web nnw
+application/vnd.nokia.catalogs
+application/vnd.nokia.conml+wbxml
+application/vnd.nokia.conml+xml
+application/vnd.nokia.isds-radio-presets
+application/vnd.nokia.iptv.config+xml
+application/vnd.nokia.landmark+wbxml
+application/vnd.nokia.landmark+xml
+application/vnd.nokia.landmarkcollection+xml
+application/vnd.nokia.n-gage.ac+xml
+application/vnd.nokia.n-gage.data ngdat
+application/vnd.nokia.n-gage.symbian.install n-gage
+application/vnd.nokia.ncd
+application/vnd.nokia.pcd+wbxml
+application/vnd.nokia.pcd+xml
+application/vnd.nokia.radio-preset rpst
+application/vnd.nokia.radio-presets rpss
+application/vnd.novadigm.edm edm
+application/vnd.novadigm.edx edx
+application/vnd.novadigm.ext ext
+application/vnd.oasis.opendocument.chart odc
+application/vnd.oasis.opendocument.chart-template otc
+application/vnd.oasis.opendocument.formula odf
+application/vnd.oasis.opendocument.formula-template otf
+application/vnd.oasis.opendocument.graphics odg
+application/vnd.oasis.opendocument.graphics-template otg
+application/vnd.oasis.opendocument.image odi
+application/vnd.oasis.opendocument.image-template oti
+application/vnd.oasis.opendocument.presentation odp
+application/vnd.oasis.opendocument.presentation-template otp
+application/vnd.oasis.opendocument.spreadsheet ods
+application/vnd.oasis.opendocument.spreadsheet-template ots
+application/vnd.oasis.opendocument.text odt
+application/vnd.oasis.opendocument.text-master otm
+application/vnd.oasis.opendocument.text-template ott
+application/vnd.oasis.opendocument.text-web oth
+application/vnd.obn
+application/vnd.olpc-sugar xo
+application/vnd.oma-scws-config
+application/vnd.oma-scws-http-request
+application/vnd.oma-scws-http-response
+application/vnd.oma.bcast.associated-procedure-parameter+xml
+application/vnd.oma.bcast.drm-trigger+xml
+application/vnd.oma.bcast.imd+xml
+application/vnd.oma.bcast.notification+xml
+application/vnd.oma.bcast.sgboot
+application/vnd.oma.bcast.sgdd+xml
+application/vnd.oma.bcast.sgdu
+application/vnd.oma.bcast.simple-symbol-container
+application/vnd.oma.bcast.smartcard-trigger+xml
+application/vnd.oma.bcast.sprov+xml
+application/vnd.oma.dd2+xml dd2
+application/vnd.oma.drm.risd+xml
+application/vnd.oma.group-usage-list+xml
+application/vnd.oma.poc.groups+xml
+application/vnd.oma.xcap-directory+xml
+application/vnd.omads-email+xml
+application/vnd.omads-file+xml
+application/vnd.omads-folder+xml
+application/vnd.omaloc-supl-init
+application/vnd.openofficeorg.extension oxt
+application/vnd.osa.netdeploy
+application/vnd.osgi.dp dp
+application/vnd.otps.ct-kip+xml
+application/vnd.palm prc pdb pqa oprc
+application/vnd.paos.xml
+application/vnd.pg.format str
+application/vnd.pg.osasli ei6
+application/vnd.piaccess.application-licence
+application/vnd.picsel efif
+application/vnd.poc.group-advertisement+xml
+application/vnd.pocketlearn plf
+application/vnd.powerbuilder6 pbd
+application/vnd.powerbuilder6-s
+application/vnd.powerbuilder7
+application/vnd.powerbuilder7-s
+application/vnd.powerbuilder75
+application/vnd.powerbuilder75-s
+application/vnd.preminet
+application/vnd.previewsystems.box box
+application/vnd.proteus.magazine mgz
+application/vnd.publishare-delta-tree qps
+application/vnd.pvi.ptid1 ptid
+application/vnd.pwg-multiplexed
+application/vnd.pwg-xhtml-print+xml
+application/vnd.qualcomm.brew-app-res
+application/vnd.quark.quarkxpress qxd qxt qwd qwt qxl qxb
+application/vnd.rapid
+application/vnd.recordare.musicxml mxl
+application/vnd.recordare.musicxml+xml
+application/vnd.renlearn.rlprint
+application/vnd.rn-realmedia rm
+application/vnd.ruckus.download
+application/vnd.s3sms
+application/vnd.scribus
+application/vnd.sealed.3df
+application/vnd.sealed.csf
+application/vnd.sealed.doc
+application/vnd.sealed.eml
+application/vnd.sealed.mht
+application/vnd.sealed.net
+application/vnd.sealed.ppt
+application/vnd.sealed.tiff
+application/vnd.sealed.xls
+application/vnd.sealedmedia.softseal.html
+application/vnd.sealedmedia.softseal.pdf
+application/vnd.seemail see
+application/vnd.sema sema
+application/vnd.semd semd
+application/vnd.semf semf
+application/vnd.shana.informed.formdata ifm
+application/vnd.shana.informed.formtemplate itp
+application/vnd.shana.informed.interchange iif
+application/vnd.shana.informed.package ipk
+application/vnd.simtech-mindmapper twd twds
+application/vnd.smaf mmf
+application/vnd.solent.sdkm+xml sdkm sdkd
+application/vnd.spotfire.dxp dxp
+application/vnd.spotfire.sfs sfs
+application/vnd.sss-cod
+application/vnd.sss-dtf
+application/vnd.sss-ntf
+application/vnd.street-stream
+application/vnd.sun.wadl+xml
+application/vnd.sus-calendar sus susp
+application/vnd.svd svd
+application/vnd.swiftview-ics
+application/vnd.syncml+xml xsm
+application/vnd.syncml.dm+wbxml bdm
+application/vnd.syncml.dm+xml xdm
+application/vnd.syncml.ds.notification
+application/vnd.tao.intent-module-archive tao
+application/vnd.tmobile-livetv tmo
+application/vnd.trid.tpt tpt
+application/vnd.triscape.mxs mxs
+application/vnd.trueapp tra
+application/vnd.truedoc
+application/vnd.ufdl ufd ufdl
+application/vnd.uiq.theme utz
+application/vnd.umajin umj
+application/vnd.unity unityweb
+application/vnd.uoml+xml uoml
+application/vnd.uplanet.alert
+application/vnd.uplanet.alert-wbxml
+application/vnd.uplanet.bearer-choice
+application/vnd.uplanet.bearer-choice-wbxml
+application/vnd.uplanet.cacheop
+application/vnd.uplanet.cacheop-wbxml
+application/vnd.uplanet.channel
+application/vnd.uplanet.channel-wbxml
+application/vnd.uplanet.list
+application/vnd.uplanet.list-wbxml
+application/vnd.uplanet.listcmd
+application/vnd.uplanet.listcmd-wbxml
+application/vnd.uplanet.signal
+application/vnd.vcx vcx
+application/vnd.vd-study
+application/vnd.vectorworks
+application/vnd.vidsoft.vidconference
+application/vnd.visio vsd vst vss vsw
+application/vnd.visionary vis
+application/vnd.vividence.scriptfile
+application/vnd.vsf vsf
+application/vnd.wap.sic
+application/vnd.wap.slc
+application/vnd.wap.wbxml wbxml
+application/vnd.wap.wmlc wmlc
+application/vnd.wap.wmlscriptc wmlsc
+application/vnd.webturbo wtb
+application/vnd.wfa.wsc
+application/vnd.wordperfect wpd
+application/vnd.wqd wqd
+application/vnd.wrq-hp3000-labelled
+application/vnd.wt.stf stf
+application/vnd.wv.csp+wbxml
+application/vnd.wv.csp+xml
+application/vnd.wv.ssp+xml
+application/vnd.xara xar
+application/vnd.xfdl xfdl
+application/vnd.xmpie.cpkg
+application/vnd.xmpie.dpkg
+application/vnd.xmpie.plan
+application/vnd.xmpie.ppkg
+application/vnd.xmpie.xlim
+application/vnd.yamaha.hv-dic hvd
+application/vnd.yamaha.hv-script hvs
+application/vnd.yamaha.hv-voice hvp
+application/vnd.yamaha.smaf-audio saf
+application/vnd.yamaha.smaf-phrase spf
+application/vnd.yellowriver-custom-menu cmp
+application/vnd.zzazz.deck+xml zaz
+application/voicexml+xml vxml
+application/watcherinfo+xml
+application/whoispp-query
+application/whoispp-response
+application/winhlp hlp
+application/wita
+application/wordperfect5.1
+application/wsdl+xml wsdl
+application/wspolicy+xml wspolicy
+application/x-ace-compressed ace
+application/x-bcpio bcpio
+application/x-bittorrent torrent
+application/x-bzip bz
+application/x-bzip2 bz2 boz
+application/x-cdlink vcd
+application/x-chat chat
+application/x-chess-pgn pgn
+application/x-compress
+application/x-cpio cpio
+application/x-csh csh
+application/x-director dcr dir dxr fgd
+application/x-dvi dvi
+application/x-futuresplash spl
+application/x-gtar gtar
+application/x-gzip
+application/x-hdf hdf
+application/x-java-jnlp-file jnlp
+application/x-latex latex
+application/x-ms-wmd wmd
+application/x-ms-wmz wmz
+application/x-msaccess mdb
+application/x-msbinder obd
+application/x-mscardfile crd
+application/x-msclip clp
+application/x-msdownload exe dll com bat msi
+application/x-msmediaview mvb m13 m14
+application/x-msmetafile wmf
+application/x-msmoney mny
+application/x-mspublisher pub
+application/x-msschedule scd
+application/x-msterminal trm
+application/x-mswrite wri
+application/x-netcdf nc cdf
+application/x-pkcs12 p12 pfx
+application/x-pkcs7-certificates p7b spc
+application/x-pkcs7-certreqresp p7r
+application/x-rar-compressed rar
+application/x-sh sh
+application/x-shar shar
+application/x-shockwave-flash swf
+application/x-stuffit sit
+application/x-stuffitx sitx
+application/x-sv4cpio sv4cpio
+application/x-sv4crc sv4crc
+application/x-tar tar
+application/x-tcl tcl
+application/x-tex tex
+application/x-texinfo texinfo texi
+application/x-ustar ustar
+application/x-wais-source src
+application/x-x509-ca-cert der crt
+application/x400-bp
+application/xcap-att+xml
+application/xcap-caps+xml
+application/xcap-el+xml
+application/xcap-error+xml
+application/xcap-ns+xml
+application/xenc+xml xenc
+application/xhtml+xml xhtml xht
+application/xml xml xsl
+application/xml-dtd dtd
+application/xml-external-parsed-entity
+application/xmpp+xml
+application/xop+xml xop
+application/xslt+xml xslt
+application/xspf+xml xspf
+application/xv+xml mxml xhvml xvml xvm
+application/zip zip
+audio/32kadpcm
+audio/3gpp
+audio/3gpp2
+audio/ac3
+audio/amr
+audio/amr-wb
+audio/amr-wb+
+audio/asc
+audio/basic au snd
+audio/bv16
+audio/bv32
+audio/clearmode
+audio/cn
+audio/dat12
+audio/dls
+audio/dsr-es201108
+audio/dsr-es202050
+audio/dsr-es202211
+audio/dsr-es202212
+audio/dvi4
+audio/eac3
+audio/evrc
+audio/evrc-qcp
+audio/evrc0
+audio/evrc1
+audio/evrcb
+audio/evrcb0
+audio/evrcb1
+audio/g722
+audio/g7221
+audio/g723
+audio/g726-16
+audio/g726-24
+audio/g726-32
+audio/g726-40
+audio/g728
+audio/g729
+audio/g7291
+audio/g729d
+audio/g729e
+audio/gsm
+audio/gsm-efr
+audio/ilbc
+audio/l16
+audio/l20
+audio/l24
+audio/l8
+audio/lpc
+audio/midi mid midi kar rmi
+audio/mobile-xmf
+audio/mp4 mp4a
+audio/mp4a-latm m4a m4p
+audio/mpa
+audio/mpa-robust
+audio/mpeg mpga mp2 mp2a mp3 m2a m3a
+audio/mpeg4-generic
+audio/parityfec
+audio/pcma
+audio/pcmu
+audio/prs.sid
+audio/qcelp
+audio/red
+audio/rtp-enc-aescm128
+audio/rtp-midi
+audio/rtx
+audio/smv
+audio/smv0
+audio/smv-qcp
+audio/sp-midi
+audio/t140c
+audio/t38
+audio/telephone-event
+audio/tone
+audio/vdvi
+audio/vmr-wb
+audio/vnd.3gpp.iufp
+audio/vnd.4sb
+audio/vnd.audiokoz
+audio/vnd.celp
+audio/vnd.cisco.nse
+audio/vnd.cmles.radio-events
+audio/vnd.cns.anp1
+audio/vnd.cns.inf1
+audio/vnd.digital-winds eol
+audio/vnd.dlna.adts
+audio/vnd.dolby.mlp
+audio/vnd.everad.plj
+audio/vnd.hns.audio
+audio/vnd.lucent.voice lvp
+audio/vnd.nokia.mobile-xmf
+audio/vnd.nortel.vbk
+audio/vnd.nuera.ecelp4800 ecelp4800
+audio/vnd.nuera.ecelp7470 ecelp7470
+audio/vnd.nuera.ecelp9600 ecelp9600
+audio/vnd.octel.sbc
+audio/vnd.qcelp
+audio/vnd.rhetorex.32kadpcm
+audio/vnd.sealedmedia.softseal.mpeg
+audio/vnd.vmx.cvsd
+audio/wav wav
+audio/x-aiff aif aiff aifc
+audio/x-mpegurl m3u
+audio/x-ms-wax wax
+audio/x-ms-wma wma
+audio/x-pn-realaudio ram ra
+audio/x-pn-realaudio-plugin rmp
+audio/x-wav wav
+chemical/x-cdx cdx
+chemical/x-cif cif
+chemical/x-cmdf cmdf
+chemical/x-cml cml
+chemical/x-csml csml
+chemical/x-pdb pdb
+chemical/x-xyz xyz
+image/bmp bmp
+image/cgm cgm
+image/fits
+image/g3fax g3
+image/gif gif
+image/ief ief
+image/jp2 jp2
+image/jpeg jpeg jpg jpe
+image/jpm
+image/jpx
+image/naplps
+image/pict pict pic pct
+image/png png
+image/prs.btif btif
+image/prs.pti
+image/svg+xml svg svgz
+image/t38
+image/tiff tiff tif
+image/tiff-fx
+image/vnd.adobe.photoshop psd
+image/vnd.cns.inf2
+image/vnd.djvu djvu djv
+image/vnd.dwg dwg
+image/vnd.dxf dxf
+image/vnd.fastbidsheet fbs
+image/vnd.fpx fpx
+image/vnd.fst fst
+image/vnd.fujixerox.edmics-mmr mmr
+image/vnd.fujixerox.edmics-rlc rlc
+image/vnd.globalgraphics.pgb
+image/vnd.microsoft.icon ico
+image/vnd.mix
+image/vnd.ms-modi mdi
+image/vnd.net-fpx npx
+image/vnd.sealed.png
+image/vnd.sealedmedia.softseal.gif
+image/vnd.sealedmedia.softseal.jpg
+image/vnd.svf
+image/vnd.wap.wbmp wbmp
+image/vnd.xiff xif
+image/x-cmu-raster ras
+image/x-cmx cmx
+image/x-icon
+image/x-macpaint pntg pnt mac
+image/x-pcx pcx
+image/x-pict pic pct
+image/x-portable-anymap pnm
+image/x-portable-bitmap pbm
+image/x-portable-graymap pgm
+image/x-portable-pixmap ppm
+image/x-quicktime qtif qti
+image/x-rgb rgb
+image/x-xbitmap xbm
+image/x-xpixmap xpm
+image/x-xwindowdump xwd
+message/cpim
+message/delivery-status
+message/disposition-notification
+message/external-body
+message/http
+message/news
+message/partial
+message/rfc822 eml mime
+message/s-http
+message/sip
+message/sipfrag
+message/tracking-status
+model/iges igs iges
+model/mesh msh mesh silo
+model/vnd.dwf dwf
+model/vnd.flatland.3dml
+model/vnd.gdl gdl
+model/vnd.gs.gdl
+model/vnd.gtw gtw
+model/vnd.moml+xml
+model/vnd.mts mts
+model/vnd.parasolid.transmit.binary
+model/vnd.parasolid.transmit.text
+model/vnd.vtu vtu
+model/vrml wrl vrml
+multipart/alternative
+multipart/appledouble
+multipart/byteranges
+multipart/digest
+multipart/encrypted
+multipart/form-data
+multipart/header-set
+multipart/mixed
+multipart/parallel
+multipart/related
+multipart/report
+multipart/signed
+multipart/voice-message
+text/calendar ics ifb
+text/css css
+text/csv csv
+text/directory
+text/dns
+text/enriched
+text/html html htm
+text/parityfec
+text/plain txt text conf def list log in
+text/prs.fallenstein.rst
+text/prs.lines.tag dsc
+text/red
+text/rfc822-headers
+text/richtext rtx
+text/rtf
+text/rtp-enc-aescm128
+text/rtx
+text/sgml sgml sgm
+text/t140
+text/tab-separated-values tsv
+text/troff t tr roff man me ms
+text/uri-list uri uris urls
+text/vnd.abc
+text/vnd.curl
+text/vnd.dmclientscript
+text/vnd.esmertec.theme-descriptor
+text/vnd.fly fly
+text/vnd.fmi.flexstor flx
+text/vnd.in3d.3dml 3dml
+text/vnd.in3d.spot spot
+text/vnd.iptc.newsml
+text/vnd.iptc.nitf
+text/vnd.latex-z
+text/vnd.motorola.reflex
+text/vnd.ms-mediapackage
+text/vnd.net2phone.commcenter.command
+text/vnd.sun.j2me.app-descriptor jad
+text/vnd.trolltech.linguist
+text/vnd.wap.si
+text/vnd.wap.sl
+text/vnd.wap.wml wml
+text/vnd.wap.wmlscript wmls
+text/x-asm s asm
+text/x-c c cc cxx cpp h hh dic
+text/x-fortran f for f77 f90
+text/x-pascal p pas
+text/x-java-source java
+text/x-setext etx
+text/x-uuencode uu
+text/x-vcalendar vcs
+text/x-vcard vcf
+text/xml
+text/xml-external-parsed-entity
+video/3gpp 3gp
+video/3gpp-tt
+video/3gpp2 3g2
+video/bmpeg
+video/bt656
+video/celb
+video/dv
+video/h261 h261
+video/h263 h263
+video/h263-1998
+video/h263-2000
+video/h264 h264
+video/jpeg jpgv
+video/jpm jpm jpgm
+video/mj2 mj2 mjp2
+video/mp1s
+video/mp2p
+video/mp2t
+video/mp4 mp4 mp4v mpg4 m4v
+video/mp4v-es
+video/mpeg mpeg mpg mpe m1v m2v
+video/mpeg4-generic
+video/mpv
+video/nv
+video/parityfec
+video/pointer
+video/quicktime qt mov
+video/raw
+video/rtp-enc-aescm128
+video/rtx
+video/smpte292m
+video/vc1
+video/vnd.dlna.mpeg-tts
+video/vnd.fvt fvt
+video/vnd.hns.video
+video/vnd.motorola.video
+video/vnd.motorola.videop
+video/vnd.mpegurl mxu m4u
+video/vnd.nokia.interleaved-multimedia
+video/vnd.nokia.videovoip
+video/vnd.objectvideo
+video/vnd.sealed.mpeg1
+video/vnd.sealed.mpeg4
+video/vnd.sealed.swf
+video/vnd.sealedmedia.softseal.mov
+video/vnd.vivo viv
+video/x-dv dv dif
+video/x-fli fli
+video/x-ms-asf asf asx
+video/x-ms-wm wm
+video/x-ms-wmv wmv
+video/x-ms-wmx wmx
+video/x-ms-wvx wvx
+video/x-msvideo avi
+video/x-sgi-movie movie
+x-conference/x-cooltalk ice
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs help.markup help.syntax io.streams.string sequences ;
+IN: mime.types
+
+HELP: mime-db
+{ $values
+
+ { "seq" sequence } }
+{ $description "Outputs an array where the first element is a MIME type and the rest of the array is file extensions that have that MIME type." } ;
+
+HELP: mime-type
+{ $values
+ { "filename" "a filename" }
+ { "mime-type" "a MIME type string" } }
+{ $description "Outputs the MIME type associtated with a path by parsing the path's file extension and looking it up in the table returned by " { $link mime-types } "." } ;
+
+HELP: mime-types
+{ $values
+
+ { "assoc" assoc } }
+{ $description "Outputs an " { $snippet "assoc" } " made from the data in the " { $link mime-db } " word where the keys are file extensions and the values are the corresponding MIME types." } ;
+
+HELP: nonstandard-mime-types
+{ $values
+
+ { "assoc" assoc } }
+{ $description "A list of Factor-specific MIME types that are added to the MIME database loaded from disk." } ;
+
+ARTICLE: "mime.types" "MIME types"
+"The " { $vocab-link "mime.types" } " vocabulary loads a file of MIME types and provides a word to look up the MIME type based on a file extension." $nl
+"Looking up a MIME type:"
+{ $subsection mime-type } ;
+
+ABOUT: "mime.types"
--- /dev/null
+IN: mime.types.tests
+USING: mime.types tools.test ;
+
+[ "application/postscript" ] [ "foo.ps" mime-type ] unit-test
+[ "application/octet-stream" ] [ "foo.ps.gz" mime-type ] unit-test
+[ "text/plain" ] [ "foo.factor" mime-type ] unit-test
--- /dev/null
+! Copyright (C) 2004, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.files io.encodings.ascii assocs sequences splitting
+kernel namespaces fry memoize ;
+IN: mime.types
+
+MEMO: mime-db ( -- seq )
+ "resource:basis/mime/types/mime.types" ascii file-lines
+ [ "#" head? not ] filter [ " \t" split harvest ] map harvest ;
+
+: nonstandard-mime-types ( -- assoc )
+ H{
+ { "factor" "text/plain" }
+ { "cgi" "application/x-cgi-script" }
+ { "fhtml" "application/x-factor-server-page" }
+ } ;
+
+MEMO: mime-types ( -- assoc )
+ [
+ mime-db [ unclip '[ [ _ ] dip set ] each ] each
+ ] H{ } make-assoc
+ nonstandard-mime-types assoc-union ;
+
+: mime-type ( filename -- mime-type )
+ file-extension mime-types at "application/octet-stream" or ;
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel debugger sequences namespaces math
-math.order combinators init alien alien.c-types alien.strings libc
-continuations destructors debugger summary splitting assocs
-random math.parser locals unicode.case
-openssl.libcrypto openssl.libssl
-io.backend io.ports io.files io.encodings.8-bit io.sockets.secure
-io.timeouts ;
+USING: init kernel namespaces openssl.libcrypto openssl.libssl
+sequences ;
IN: openssl
! This code is based on http://www.rtfm.com/openssl-examples/
SINGLETON: openssl
-GENERIC: ssl-method ( symbol -- method )
-
-M: SSLv2 ssl-method drop SSLv2_client_method ;
-M: SSLv23 ssl-method drop SSLv23_method ;
-M: SSLv3 ssl-method drop SSLv3_method ;
-M: TLSv1 ssl-method drop TLSv1_method ;
-
: (ssl-error-string) ( n -- string )
ERR_clear_error f ERR_error_string ;
] unless ;
[ f ssl-initialized? set-global ] "openssl" add-init-hook
-
-TUPLE: openssl-context < secure-context aliens sessions ;
-
-: set-session-cache ( ctx -- )
- handle>>
- [ SSL_SESS_CACHE_BOTH SSL_CTX_set_session_cache_mode ssl-error ]
- [ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
- bi ;
-
-: load-certificate-chain ( ctx -- )
- dup config>> key-file>> [
- [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
- SSL_CTX_use_certificate_chain_file
- ssl-error
- ] [ drop ] if ;
-
-: password-callback ( -- alien )
- "int" { "void*" "int" "bool" "void*" } "cdecl"
- [| buf size rwflag password! |
- password [ B{ 0 } password! ] unless
-
- [let | len [ password strlen ] |
- buf password len 1+ size min memcpy
- len
- ]
- ] alien-callback ;
-
-: default-pasword ( ctx -- alien )
- [ config>> password>> latin1 malloc-string ] [ aliens>> ] bi
- [ push ] [ drop ] 2bi ;
-
-: set-default-password ( ctx -- )
- [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
- [
- [ handle>> ] [ default-pasword ] bi
- SSL_CTX_set_default_passwd_cb_userdata
- ] bi ;
-
-: use-private-key-file ( ctx -- )
- dup config>> key-file>> [
- [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
- SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
- ssl-error
- ] [ drop ] if ;
-
-: load-verify-locations ( ctx -- )
- dup config>> [ ca-file>> ] [ ca-path>> ] bi or [
- [ handle>> ]
- [
- config>>
- [ ca-file>> dup [ (normalize-path) ] when ]
- [ ca-path>> dup [ (normalize-path) ] when ] bi
- ] bi
- SSL_CTX_load_verify_locations
- ] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;
-
-: set-verify-depth ( ctx -- )
- dup config>> verify-depth>> [
- [ handle>> ] [ config>> verify-depth>> ] bi
- SSL_CTX_set_verify_depth
- ] [ drop ] if ;
-
-TUPLE: bio handle disposed ;
-
-: <bio> ( handle -- bio ) f bio boa ;
-
-M: bio dispose* handle>> BIO_free ssl-error ;
-
-: <file-bio> ( path -- bio )
- normalize-path "r" BIO_new_file dup ssl-error <bio> ;
-
-: load-dh-params ( ctx -- )
- dup config>> dh-file>> [
- [ handle>> ] [ config>> dh-file>> ] bi <file-bio> &dispose
- handle>> f f f PEM_read_bio_DHparams dup ssl-error
- SSL_CTX_set_tmp_dh ssl-error
- ] [ drop ] if ;
-
-TUPLE: rsa handle disposed ;
-
-: <rsa> ( handle -- rsa ) f rsa boa ;
-
-M: rsa dispose* handle>> RSA_free ;
-
-: generate-eph-rsa-key ( ctx -- )
- [ handle>> ]
- [
- config>> ephemeral-key-bits>> RSA_F4 f f RSA_generate_key
- dup ssl-error <rsa> &dispose handle>>
- ] bi
- SSL_CTX_set_tmp_rsa ssl-error ;
-
-: <openssl-context> ( config ctx -- context )
- openssl-context new
- swap >>handle
- swap >>config
- V{ } clone >>aliens
- H{ } clone >>sessions ;
-
-M: openssl <secure-context> ( config -- context )
- maybe-init-ssl
- [
- dup method>> ssl-method SSL_CTX_new
- dup ssl-error <openssl-context> |dispose
- {
- [ set-session-cache ]
- [ load-certificate-chain ]
- [ set-default-password ]
- [ use-private-key-file ]
- [ load-verify-locations ]
- [ set-verify-depth ]
- [ load-dh-params ]
- [ generate-eph-rsa-key ]
- [ ]
- } cleave
- ] with-destructors ;
-
-M: openssl-context dispose*
- [ aliens>> [ free ] each ]
- [ sessions>> values [ SSL_SESSION_free ] each ]
- [ handle>> SSL_CTX_free ]
- tri ;
-
-TUPLE: ssl-handle file handle connected disposed ;
-
-SYMBOL: default-secure-context
-
-: context-expired? ( context -- ? )
- dup [ handle>> expired? ] [ drop t ] if ;
-
-: current-secure-context ( -- ctx )
- secure-context get [
- default-secure-context get dup context-expired? [
- drop
- <secure-config> <secure-context> default-secure-context set-global
- current-secure-context
- ] when
- ] unless* ;
-
-: <ssl-handle> ( fd -- ssl )
- current-secure-context handle>> SSL_new dup ssl-error
- f f ssl-handle boa ;
-
-M: ssl-handle dispose*
- [ handle>> SSL_free ] [ file>> dispose ] bi ;
-
-: check-verify-result ( ssl-handle -- )
- SSL_get_verify_result dup X509_V_OK =
- [ drop ] [ verify-message certificate-verify-error ] if ;
-
-: common-name ( certificate -- host )
- X509_get_subject_name
- NID_commonName 256 <byte-array>
- [ 256 X509_NAME_get_text_by_NID ] keep
- swap -1 = [ drop f ] [ latin1 alien>string ] if ;
-
-: common-names-match? ( expected actual -- ? )
- [ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
-
-: check-common-name ( host ssl-handle -- )
- SSL_get_peer_certificate common-name
- 2dup common-names-match?
- [ 2drop ] [ common-name-verify-error ] if ;
-
-M: openssl check-certificate ( host ssl -- )
- current-secure-context config>> verify>> [
- handle>>
- [ nip check-verify-result ]
- [ check-common-name ]
- 2bi
- ] [ 2drop ] if ;
-
-: get-session ( addrspec -- session/f )
- current-secure-context sessions>> at
- dup expired? [ drop f ] when ;
-
-: save-session ( session addrspec -- )
- current-secure-context sessions>> set-at ;
-
-openssl secure-socket-backend set-global
! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces make math assocs
-shuffle vectors arrays math.parser accessors unicode.categories
+vectors arrays math.parser accessors unicode.categories
sequences.deep peg peg.private peg.search math.ranges words ;
IN: peg.parsers
! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings fry namespaces make math assocs
-shuffle debugger io vectors arrays math.parser math.order
+debugger io vectors arrays math.parser math.order
vectors combinators classes sets unicode.categories
compiler.units parser words quotations effects memoize accessors
locals effects splitting combinators.short-circuit
M: vector pprint* pprint-object ;
M: byte-vector pprint* pprint-object ;
M: hashtable pprint* pprint-object ;
-
-M: curry pprint*
- dup quot>> callable? [ pprint-object ] [
- "( invalid curry )" swap present-text
- ] if ;
-
-M: compose pprint*
- dup [ first>> callable? ] [ second>> callable? ] bi and
- [ pprint-object ] [
- "( invalid compose )" swap present-text
- ] if ;
+M: curry pprint* pprint-object ;
+M: compose pprint* pprint-object ;
M: wrapper pprint*
dup wrapped>> word? [
"Prettyprinting any stack:"
{ $subsection stack. }
"Prettyprinting any call stack:"
-{ $subsection callstack. } ;
+{ $subsection callstack. }
+"Note that calls to " { $link .s } " can also be included inside words as a debugging aid, however a more convenient way to achieve this is to use the annotation facility. See " { $link "tools.annotations" } "." ;
ARTICLE: "prettyprint-variables" "Prettyprint control variables"
"The following variables affect the " { $link . } " and " { $link pprint } " words if set in the current dynamic scope:"
[ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
-[ ] [ 1 \ + curry unparse drop ] unit-test
-
-[ ] [ 1 \ + compose unparse drop ] unit-test
-
GENERIC: generic-see-test-with-f ( obj -- obj )
M: f generic-see-test-with-f ;
definitions effects classes.builtin classes.tuple io.files
classes continuations hashtables classes.mixin classes.union
classes.intersection classes.predicate classes.singleton
-combinators quotations sets accessors colors ;
+combinators quotations sets accessors colors parser ;
IN: prettyprint
: make-pprint ( obj quot -- block in use )
] with-pprint nl
] unless-empty ;
-: vocabs. ( in use -- )
+: use/in. ( in use -- )
dupd remove [ { "syntax" "scratchpad" } member? not ] filter
use. in. ;
+: vocab-names ( words -- vocabs )
+ dictionary get
+ [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
+
+: prelude. ( -- )
+ in get use get vocab-names use/in. ;
+
+[
+ nl
+ "Restarts were invoked adding vocabularies to the search path." print
+ "To avoid doing this in the future, add the following USING:" print
+ "and IN: forms at the top of the source file:" print nl
+ prelude.
+ nl
+] print-use-hook set-global
+
: with-use ( obj quot -- )
- make-pprint vocabs. do-pprint ; inline
+ make-pprint use/in. do-pprint ; inline
: with-in ( obj quot -- )
make-pprint drop [ write-in bl ] when* do-pprint ; inline
#! Syntax: QUALIFIED-WITH: vocab prefix
scan scan define-qualified ; parsing
-: expect=> ( -- ) scan "=>" assert= ;
-
: partial-vocab ( words vocab -- assoc )
'[ dup _ lookup [ no-word-error ] unless* ]
{ } map>assoc ;
: FROM:
#! Syntax: FROM: vocab => words... ;
- scan dup load-vocab drop expect=>
+ scan dup load-vocab drop "=>" expect
";" parse-tokens swap partial-vocab use get push ; parsing
: partial-vocab-excluding ( words vocab -- assoc )
: EXCLUDE:
#! Syntax: EXCLUDE: vocab => words ... ;
- scan expect=>
+ scan "=>" expect
";" parse-tokens swap partial-vocab-excluding use get push ; parsing
: RENAME:
#! Syntax: RENAME: word vocab => newname
scan scan dup load-vocab drop
dupd lookup [ ] [ no-word-error ] ?if
- expect=>
+ "=>" expect
scan associate use get push ; parsing
M: any-char class-member? ( obj class -- ? )
2drop t ;
+
+M: any-char-no-nl class-member? ( obj class -- ? )
+ drop CHAR: \n = not ;
M: letter-class class-member? ( obj class -- ? )
drop letter? ;
TUPLE: character-class-range from to ; INSTANCE: character-class-range node
SINGLETON: epsilon INSTANCE: epsilon node
SINGLETON: any-char INSTANCE: any-char node
+SINGLETON: any-char-no-nl INSTANCE: any-char-no-nl node
SINGLETON: front-anchor INSTANCE: front-anchor node
SINGLETON: back-anchor INSTANCE: back-anchor node
[ drop1 (parse-special-group) ]
[ capture-group f nested-parse-regexp ] if ;
-: handle-dot ( -- ) any-char push-stack ;
+: handle-dot ( -- ) get-dotall any-char any-char-no-nl ? push-stack ;
: handle-pipe ( -- ) pipe push-stack ;
: (handle-star) ( obj -- kleene-star )
peek1 {
first|concatenation
] if-empty ;
-ERROR: unrecognized-escape char ;
-
: parse-escaped ( -- obj )
read1
{
- { CHAR: \ [ CHAR: \ <constant> ] }
- { CHAR: / [ CHAR: / <constant> ] }
- { CHAR: ^ [ CHAR: ^ <constant> ] }
- { CHAR: $ [ CHAR: $ <constant> ] }
- { CHAR: - [ CHAR: - <constant> ] }
- { CHAR: { [ CHAR: { <constant> ] }
- { CHAR: } [ CHAR: } <constant> ] }
- { CHAR: [ [ CHAR: [ <constant> ] }
- { CHAR: ] [ CHAR: ] <constant> ] }
- { CHAR: ( [ CHAR: ( <constant> ] }
- { CHAR: ) [ CHAR: ) <constant> ] }
- { CHAR: @ [ CHAR: @ <constant> ] }
- { CHAR: * [ CHAR: * <constant> ] }
- { CHAR: + [ CHAR: + <constant> ] }
- { CHAR: ? [ CHAR: ? <constant> ] }
- { CHAR: . [ CHAR: . <constant> ] }
- { CHAR: : [ CHAR: : <constant> ] }
{ CHAR: t [ CHAR: \t <constant> ] }
{ CHAR: n [ CHAR: \n <constant> ] }
{ CHAR: r [ CHAR: \r <constant> ] }
! { CHAR: 9 [ CHAR: 9 <constant> ] }
{ CHAR: Q [ parse-escaped-literals ] }
- [ unrecognized-escape ]
+ [ <constant> ]
} case ;
: handle-escape ( -- ) parse-escaped push-stack ;
USING: regexp tools.test kernel sequences regexp.parser
-regexp.traversal eval ;
+regexp.traversal eval strings ;
IN: regexp-tests
\ <regexp> must-infer
[ f ] [ "" "." <regexp> matches? ] unit-test
[ t ] [ "a" "." <regexp> matches? ] unit-test
[ t ] [ "." "." <regexp> matches? ] unit-test
-! [ f ] [ "\n" "." <regexp> matches? ] unit-test
+
+! Dotall mode -- when on, . matches newlines.
+! Off by default.
+[ f ] [ "\n" "." <regexp> matches? ] unit-test
+[ t ] [ "\n" "(?s)." <regexp> matches? ] unit-test
+[ f ] [ "\n\n" "(?s).(?-s)." <regexp> matches? ] unit-test
[ f ] [ "" ".+" <regexp> matches? ] unit-test
[ t ] [ "a" ".+" <regexp> matches? ] unit-test
[ f ] [ "ABC" "\\p{Lower}{3}" <regexp> matches? ] unit-test
[ t ] [ "ABC" "\\p{Upper}{3}" <regexp> matches? ] unit-test
[ f ] [ "abc" "\\p{Upper}{3}" <regexp> matches? ] unit-test
-!
[ f ] [ "abc" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
[ t ] [ "ABC" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
! Comment
[ t ] [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test
+[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test
+
+[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test
+
+[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test
+
+[ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
+[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
+
+[ "ab" ] [ "ab" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
+[ "abc" ] [ "abc" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
+
+[ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
+
+[ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
+
+[ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
+
+[ { "1" "2" "3" "4" } ]
+[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
+
+[ { "1" "2" "3" "4" } ]
+[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
+
+[ { "ABC" "DEF" "GHI" } ]
+[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test
+[ "1.2.3.4" ]
+[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
+
+[ f ] [ "ab" "a(?!b)" <regexp> first-match ] unit-test
+[ "a" ] [ "ab" "a(?=b)(?=b)" <regexp> first-match >string ] unit-test
+[ "a" ] [ "ba" "a(?<=b)(?<=b)" <regexp> first-match >string ] unit-test
+[ "a" ] [ "cab" "a(?=b)(?<=c)" <regexp> first-match >string ] unit-test
! [ "{Lower}" <regexp> ] [ invalid-range? ] must-fail-with
! [ t ] [ "fooxbar" "foo\\Bxbar" <regexp> matches? ] unit-test
! [ f ] [ "foo" "foo\\Bbar" <regexp> matches? ] unit-test
-[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test
-
-[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test
-
-[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test
! Bug in parsing word
! [ t ] [ "a" R' a' matches? ] unit-test
-! ((A)(B(C)))
-! 1. ((A)(B(C)))
-! 2. (A)
-! 3. (B(C))
-! 4. (C)
-
! clear "a(?=b*)" <regexp> "ab" over match
! clear "a(?=b*c)" <regexp> "abbbbbc" over match
! clear "a(?=b*)" <regexp> "ab" over match
! "a(?#bcdefg)bcd" <regexp> "abcdefg" over first-match
! "a(?:bcdefg)" <regexp> "abcdefg" over first-match
-[ { 0 1 } ] [ "ac" "a(?!b)" <regexp> first-match ] unit-test
-[ f ] [ "ab" "a(?!b)" <regexp> first-match ] unit-test
+[ "a" ] [ "ac" "a(?!b)" <regexp> first-match >string ] unit-test
! "a(?<=b)" <regexp> "caba" over first-match
-[ { 0 1 } ] [ "ab" "a(?=b)(?=b)" <regexp> first-match ] unit-test
-[ { 1 2 } ] [ "ba" "a(?<=b)(?<=b)" <regexp> first-match ] unit-test
-[ { 1 2 } ] [ "cab" "a(?=b)(?<=c)" <regexp> first-match ] unit-test
! capture group 1: "aaaa" 2: ""
! "aaaa" "(a*)(a*)" <regexp> match*
! "aaaa" "(a*)(a+)" <regexp> match*
-
-[ { 0 2 } ] [ "ab" "(a|ab)(bc)?" <regexp> first-match ] unit-test
-[ { 0 3 } ] [ "abc" "(a|ab)(bc)?" <regexp> first-match ] unit-test
-
-[ { 0 2 } ] [ "ab" "(ab|a)(bc)?" <regexp> first-match ] unit-test
-[ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
-
-[ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
-
-[ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
-
-[ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel math math.ranges sequences
+USING: accessors combinators kernel math sequences
sets assocs prettyprint.backend make lexer namespaces parser
arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
-regexp.dfa regexp.traversal regexp.transition-tables ;
+regexp.dfa regexp.traversal regexp.transition-tables splitting ;
IN: regexp
: default-regexp ( string -- regexp )
[ ]
} cleave ;
-: match ( string regexp -- pair )
- <dfa-traverser> do-match return-match ;
+: (match) ( string regexp -- dfa-traverser )
+ <dfa-traverser> do-match ; inline
-: match* ( string regexp -- pair captured-groups )
- <dfa-traverser> do-match [ return-match ] [ captured-groups>> ] bi ;
+: match ( string regexp -- slice/f )
+ (match) return-match ;
+
+: match* ( string regexp -- slice/f captured-groups )
+ (match) [ return-match ] [ captured-groups>> ] bi ;
: matches? ( string regexp -- ? )
dupd match
- [ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
+ [ [ length ] bi@ = ] [ drop f ] if* ;
-: match-head ( string regexp -- end/f ) match [ length>> 1- ] [ f ] if* ;
+: match-head ( string regexp -- end/f ) match [ length ] [ f ] if* ;
: match-at ( string m regexp -- n/f finished? )
[
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
] if ;
-: first-match ( string regexp -- pair/f )
- 0 swap match-range dup [ 2array ] [ 2drop f ] if ;
+: first-match ( string regexp -- slice/f )
+ dupd 0 swap match-range rot over [ <slice> ] [ 3drop f ] if ;
: re-cut ( string regexp -- end/f start )
dupd first-match
- [ [ second tail-slice ] [ first head ] 2bi ]
- [ "" like f swap ]
- if* ;
+ [ split1-slice swap ] [ "" like f swap ] if* ;
: re-split ( string regexp -- seq )
- [ dup ] swap '[ _ re-cut ] [ ] produce nip ;
+ [ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ;
: re-replace ( string regexp replacement -- result )
[ re-split ] dip join ;
: next-match ( string regexp -- end/f match/f )
dupd first-match dup
- [ [ second tail-slice ] keep ]
- [ 2drop f f ]
- if ;
+ [ [ split1-slice nip ] keep ] [ 2drop f f ] if ;
: all-matches ( string regexp -- seq )
- [ dup ] swap '[ _ next-match ] [ ] produce nip ;
+ [ dup ] swap '[ _ next-match ] [ ] produce nip harvest ;
: count-matches ( string regexp -- n )
all-matches length 1- ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators kernel math math.ranges
+USING: accessors assocs combinators kernel math
quotations sequences regexp.parser regexp.classes fry arrays
combinators.short-circuit regexp.utils prettyprint regexp.nfa
shuffle ;
[ increment-state do-match ] when*
] unless ;
-: return-match ( dfa-traverser -- interval/f )
+: return-match ( dfa-traverser -- slice/f )
dup matches>>
[ drop f ]
- [ [ start-index>> ] [ peek ] bi* 1 <range> ] if-empty ;
+ [
+ [ [ text>> ] [ start-index>> ] bi ]
+ [ peek ] bi* rot <slice>
+ ] if-empty ;
: extract-email ( recepient -- email )
! This could be much smarter.
- " " last-split1 swap or "<" ?head drop ">" ?tail drop ;
+ " " split1-last swap or "<" ?head drop ">" ?tail drop ;
: email>headers ( email -- hashtable )
[
M: object infer-call*
\ literal-expected inference-warning ;
+: infer-slip ( -- )
+ 1 infer->r pop-d infer-call 1 infer-r> ;
+
+: infer-2slip ( -- )
+ 2 infer->r pop-d infer-call 2 infer-r> ;
+
+: infer-3slip ( -- )
+ 3 infer->r pop-d infer-call 3 infer-r> ;
+
: infer-curry ( -- )
2 consume-d
dup first2 <curried> make-known
{ \ declare [ infer-declare ] }
{ \ call [ pop-d infer-call ] }
{ \ (call) [ pop-d infer-call ] }
+ { \ slip [ infer-slip ] }
+ { \ 2slip [ infer-2slip ] }
+ { \ 3slip [ infer-3slip ] }
{ \ curry [ infer-curry ] }
{ \ compose [ infer-compose ] }
{ \ execute [ infer-execute ] }
(( value -- )) apply-word/effect ;
{
- >r r> declare call (call) curry compose execute (execute) if
-dispatch <tuple-boa> (throw) load-locals get-local drop-locals
-do-primitive alien-invoke alien-indirect alien-callback
+ >r r> declare call (call) slip 2slip 3slip curry compose
+ execute (execute) if dispatch <tuple-boa> (throw)
+ load-locals get-local drop-locals do-primitive alien-invoke
+ alien-indirect alien-callback
} [ t "special" set-word-prop ] each
{ call execute dispatch load-locals get-local drop-locals }
\ spread [ spread>quot ] 1 define-transform
\ (call-next-method) [
- [ [ inlined-dependency depends-on ] bi@ ] [ next-method-quot ] 2bi
-] 2 define-transform
+ [
+ [ "method-class" word-prop ]
+ [ "method-generic" word-prop ] bi
+ [ inlined-dependency depends-on ] bi@
+ ] [ next-method-quot ] bi
+] 1 define-transform
! Constructors
\ boa [
] if ;
: string-completions ( short strs -- seq )
- [ dup ] { } map>assoc completions ;
+ dup zip completions ;
: limited-completions ( short candidates -- seq )
- completions dup length 1000 > [ drop f ] when ;
+ [ completions ] [ drop ] 2bi
+ 2dup [ length 50 > ] [ empty? ] bi* and
+ [ 2drop f ] [ drop 50 short head ] if ;
: staging-command-line ( profile -- flags )
[
+ "-staging" ,
+
dup empty? [
"-i=" my-boot-image-name append ,
] [
"tools.deploy.test.6" shake-and-bake\r
run-temp-image\r
] unit-test\r
+\r
+[ ] [\r
+ "tools.deploy.test.7" shake-and-bake\r
+ run-temp-image\r
+] unit-test\r
--- /dev/null
+USING: words ;
+IN: generic
+
+: next-method-quot ( method -- quot ) "next-method-quot" word-prop ;
tools.deploy.config vocabs sequences words words.private memory
kernel.private continuations io prettyprint vocabs.loader
debugger system strings sets vectors quotations byte-arrays
-sorting compiler.units definitions ;
+sorting compiler.units definitions generic generic.standard ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes
QUALIFIED: command-line
QUALIFIED: definitions
QUALIFIED: init
QUALIFIED: layouts
-QUALIFIED: listener
QUALIFIED: prettyprint.config
QUALIFIED: source-files
QUALIFIED: vocabs
: stripped-word-props ( -- seq )
[
- strip-dictionary? deploy-compiler? get and [
- {
- "combination"
- "members"
- "methods"
- } %
- ] when
-
strip-dictionary? [
{
"alias"
"boa-check"
"cannot-infer"
"coercer"
+ "combination"
"compiled-effect"
"compiled-generic-uses"
"compiled-uses"
"local-writer?"
"local?"
"macro"
+ "members"
"memo-quot"
+ "methods"
"mixin"
"method-class"
"method-generic"
: stripped-globals ( -- seq )
[
- "callbacks" "alien.compiler" lookup ,
-
"inspector-hook" "inspector" lookup ,
{
- bootstrap.stage2:bootstrap-time
continuations:error
continuations:error-continuation
continuations:error-thread
continuations:restarts
- listener:error-hook
init:init-hooks
source-files:source-files
input-stream
"tools"
"io.launcher"
"random"
+ "compiler"
+ "stack-checker"
+ "bootstrap"
+ "listener"
} strip-vocab-globals %
strip-dictionary? [
{
gensym
name>char-hook
+ classes:next-method-quot-cache
classes:class-and-cache
classes:class-not-cache
classes:class-or-cache
layouts:tag-numbers
layouts:type-numbers
lexer-factory
- listener:listener-hook
+ print-use-hook
root-cache
vocab-roots
vocabs:dictionary
"ui-error-hook" "ui.gadgets.worlds" lookup ,
] when
- "<value>" "stack-checker.state" lookup [ , ] when*
-
"windows-messages" "windows.messages" lookup [ , ] when*
-
] { } make ;
: strip-globals ( stripped-globals -- )
t "quiet" set-global
f output-stream set-global ;
+: compute-next-methods ( -- )
+ [ standard-generic? ] instances [
+ "methods" word-prop [
+ nip
+ dup next-method-quot "next-method-quot" set-word-prop
+ ] assoc-each
+ ] each
+ "resource:basis/tools/deploy/shaker/next-methods.factor" run-file ;
+
: strip ( -- )
init-stripper
strip-libc
strip-cocoa
strip-debugger
+ compute-next-methods
strip-init-hooks
strip-c-io
f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore
r> strip-words
compress-byte-arrays
compress-quotations
- compress-strings
- H{ } clone classes:next-method-quot-cache set-global ;
+ compress-strings ;
: (deploy) ( final-image vocab config -- )
#! Does the actual work of a deployment in the slave
USING: compiler.units words vocabs kernel threads.private ;
IN: debugger
-: print-error ( error -- ) die drop ;
+: consume ( error -- )
+ #! We don't want DCE to drop the error before the die call!
+ drop ;
-: error. ( error -- ) die drop ;
+: print-error ( error -- ) die consume ;
+
+: error. ( error -- ) die consume ;
"threads" vocab [
[
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math namespaces ;
+IN: tools.deploy.test.7
+
+SYMBOL: my-var
+
+GENERIC: my-generic ( x -- b )
+
+M: integer my-generic sq ;
+
+M: fixnum my-generic call-next-method my-var get call ;
+
+: test-7 ( -- )
+ [ 1 + ] my-var set-global
+ 12 my-generic 145 assert= ;
+
+MAIN: test-7
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-threads? t }
+ { deploy-word-props? f }
+ { deploy-ui? f }
+ { deploy-io 2 }
+ { deploy-math? t }
+ { "stop-after-last-window?" t }
+ { deploy-compiler? t }
+ { deploy-unicode? f }
+ { deploy-c-types? f }
+ { deploy-reflection 1 }
+ { deploy-word-defs? f }
+ { deploy-name "tools.deploy.test.7" }
+}
[ drop t ] must-fail-with ;
: (run-test) ( vocab -- )
- dup vocab-source-loaded? [
+ dup vocab source-loaded?>> [
vocab-tests [ run-file ] each
] [ drop ] if ;
Slava Pestov
+Eduardo Cavazos
USING: help.markup help.syntax io strings ;
IN: tools.vocabs.browser
+ARTICLE: "vocab-tags" "Vocabulary tags"
+{ $all-tags } ;
+
+ARTICLE: "vocab-authors" "Vocabulary authors"
+{ $all-authors } ;
+
ARTICLE: "vocab-index" "Vocabulary index"
-{ $tags }
-{ $authors }
+{ $subsection "vocab-tags" }
+{ $subsection "vocab-authors" }
{ $describe-vocab "" } ;
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators vocabs vocabs.loader
-tools.vocabs io io.files io.styles help.markup help.stylesheet
-sequences assocs help.topics namespaces prettyprint words
-sorting definitions arrays summary sets generic ;
+USING: accessors arrays assocs classes classes.builtin
+classes.intersection classes.mixin classes.predicate
+classes.singleton classes.tuple classes.union combinators
+definitions effects fry generic help help.markup
+help.stylesheet help.topics io io.files io.styles kernel macros
+make namespaces prettyprint sequences sets sorting summary
+tools.vocabs vocabs vocabs.loader words ;
IN: tools.vocabs.browser
: vocab-status-string ( vocab -- string )
: vocab. ( vocab -- )
[
- dup [ write-status ] with-cell
- dup [ ($link) ] with-cell
- [ vocab-summary write ] with-cell
+ [ [ write-status ] with-cell ]
+ [ [ ($link) ] with-cell ]
+ [ [ vocab-summary write ] with-cell ] tri
] with-row ;
: vocab-headings. ( -- )
[ "Children from " prepend ] [ "Children" ] if*
$heading ;
-: vocabs. ( assoc -- )
+: $vocabs ( assoc -- )
[
- [
- drop
- ] [
- swap root-heading.
- standard-table-style [
- vocab-headings. [ vocab. ] each
- ] ($grid)
+ [ drop ] [
+ [ root-heading. ]
+ [
+ standard-table-style [
+ vocab-headings. [ vocab. ] each
+ ] ($grid)
+ ] bi*
] if-empty
] assoc-each ;
-: describe-summary ( vocab -- )
- vocab-summary [
- "Summary" $heading print-element
- ] when* ;
-
TUPLE: vocab-tag name ;
INSTANCE: vocab-tag topic
C: <vocab-tag> vocab-tag
-: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
-
-: describe-tags ( vocab -- )
- vocab-tags f like [
- "Tags" $heading tags.
- ] when* ;
+: $tags ( seq -- ) [ <vocab-tag> ] map $links ;
TUPLE: vocab-author name ;
C: <vocab-author> vocab-author
-: authors. ( seq -- ) [ <vocab-author> ] map $links ;
-
-: describe-authors ( vocab -- )
- vocab-authors f like [
- "Authors" $heading authors.
- ] when* ;
+: $authors ( seq -- ) [ <vocab-author> ] map $links ;
: describe-help ( vocab -- )
- vocab-help [
- "Documentation" $heading ($link)
- ] when* ;
+ [
+ dup vocab-help
+ [ "Documentation" $heading ($link) ]
+ [ "Summary" $heading vocab-summary print-element ]
+ ?if
+ ] unless-empty ;
: describe-children ( vocab -- )
- vocab-name all-child-vocabs vocabs. ;
+ vocab-name all-child-vocabs $vocabs ;
: describe-files ( vocab -- )
vocab-files [ <pathname> ] map [
] with-nesting
] with-style
] ($block)
- ] when* ;
+ ] unless-empty ;
-: describe-words ( vocab -- )
- words [
- "Words" $heading
- natural-sort $links
+: describe-tuple-classes ( classes -- )
+ [
+ "Tuple classes" $subheading
+ [
+ [ <$link> ]
+ [ superclass <$link> ]
+ [ "slots" word-prop [ name>> ] map " " join \ $snippet swap 2array ]
+ tri 3array
+ ] map
+ { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
+ $table
+ ] unless-empty ;
+
+: describe-predicate-classes ( classes -- )
+ [
+ "Predicate classes" $subheading
+ [
+ [ <$link> ]
+ [ superclass <$link> ]
+ bi 2array
+ ] map
+ { { $strong "Class" } { $strong "Superclass" } } prefix
+ $table
+ ] unless-empty ;
+
+: (describe-classes) ( classes heading -- )
+ '[
+ _ $subheading
+ [ <$link> 1array ] map $table
+ ] unless-empty ;
+
+: describe-builtin-classes ( classes -- )
+ "Builtin classes" (describe-classes) ;
+
+: describe-singleton-classes ( classes -- )
+ "Singleton classes" (describe-classes) ;
+
+: describe-mixin-classes ( classes -- )
+ "Mixin classes" (describe-classes) ;
+
+: describe-union-classes ( classes -- )
+ "Union classes" (describe-classes) ;
+
+: describe-intersection-classes ( classes -- )
+ "Intersection classes" (describe-classes) ;
+
+: describe-classes ( classes -- )
+ [ builtin-class? ] partition
+ [ tuple-class? ] partition
+ [ singleton-class? ] partition
+ [ predicate-class? ] partition
+ [ mixin-class? ] partition
+ [ union-class? ] partition
+ [ intersection-class? ] filter
+ {
+ [ describe-builtin-classes ]
+ [ describe-tuple-classes ]
+ [ describe-singleton-classes ]
+ [ describe-predicate-classes ]
+ [ describe-mixin-classes ]
+ [ describe-union-classes ]
+ [ describe-intersection-classes ]
+ } spread ;
+
+: word-syntax ( word -- string/f )
+ \ $syntax swap word-help elements dup length 1 =
+ [ first second ] [ drop f ] if ;
+
+: describe-parsing ( words -- )
+ [
+ "Parsing words" $subheading
+ [
+ [ <$link> ]
+ [ word-syntax dup [ \ $snippet swap 2array ] when ]
+ bi 2array
+ ] map
+ { { $strong "Word" } { $strong "Syntax" } } prefix
+ $table
] unless-empty ;
-: vocab-xref ( vocab quot -- vocabs )
- >r dup vocab-name swap words [ generic? not ] filter r> map
- [ [ word? ] filter [ vocabulary>> ] map ] gather natural-sort
- remove sift ; inline
+: (describe-words) ( words heading -- )
+ '[
+ _ $subheading
+ [
+ [ <$link> ]
+ [ stack-effect dup [ effect>string \ $snippet swap 2array ] when ]
+ bi 2array
+ ] map
+ { { $strong "Word" } { $strong "Stack effect" } } prefix
+ $table
+ ] unless-empty ;
+
+: describe-generics ( words -- )
+ "Generic words" (describe-words) ;
+
+: describe-macros ( words -- )
+ "Macro words" (describe-words) ;
-: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
+: describe-primitives ( words -- )
+ "Primitives" (describe-words) ;
-: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
+: describe-compounds ( words -- )
+ "Ordinary words" (describe-words) ;
-: describe-uses ( vocab -- )
- vocab-uses [
- "Uses" $heading
- $vocab-links
+: describe-predicates ( words -- )
+ "Class predicate words" (describe-words) ;
+
+: describe-symbols ( words -- )
+ [
+ "Symbol words" $subheading
+ [ <$link> 1array ] map $table
] unless-empty ;
-: describe-usage ( vocab -- )
- vocab-usage [
- "Used by" $heading
- $vocab-links
+: describe-words ( vocab -- )
+ words [
+ "Words" $heading
+
+ natural-sort
+ [ [ class? ] filter describe-classes ]
+ [
+ [ [ class? ] [ symbol? ] bi and not ] filter
+ [ parsing-word? ] partition
+ [ generic? ] partition
+ [ macro? ] partition
+ [ symbol? ] partition
+ [ primitive? ] partition
+ [ predicate? ] partition swap
+ {
+ [ describe-parsing ]
+ [ describe-generics ]
+ [ describe-macros ]
+ [ describe-symbols ]
+ [ describe-primitives ]
+ [ describe-compounds ]
+ [ describe-predicates ]
+ } spread
+ ] bi
] unless-empty ;
+: words. ( vocab -- )
+ last-element off
+ vocab-name describe-words ;
+
+: describe-metadata ( vocab -- )
+ [
+ [ vocab-tags [ "Tags:" swap \ $tags prefix 2array , ] unless-empty ]
+ [ vocab-authors [ "Authors:" swap \ $authors prefix 2array , ] unless-empty ]
+ bi
+ ] { } make
+ [ "Meta-data" $heading $table ] unless-empty ;
+
: $describe-vocab ( element -- )
- first
- dup describe-children
- dup find-vocab-root [
- dup describe-summary
- dup describe-tags
- dup describe-authors
- dup describe-files
- ] when
- dup vocab [
- dup describe-help
- dup describe-words
- dup describe-uses
- dup describe-usage
- ] when drop ;
+ first {
+ [ describe-help ]
+ [ describe-metadata ]
+ [ describe-words ]
+ [ describe-files ]
+ [ describe-children ]
+ } cleave ;
: keyed-vocabs ( str quot -- seq )
all-vocabs [
[ vocab-authors ] keyed-vocabs ;
: $tagged-vocabs ( element -- )
- first tagged vocabs. ;
+ first tagged $vocabs ;
: $authored-vocabs ( element -- )
- first authored vocabs. ;
+ first authored $vocabs ;
-: $tags ( element -- )
- drop "Tags" $heading all-tags tags. ;
+: $all-tags ( element -- )
+ drop "Tags" $heading all-tags $tags ;
-: $authors ( element -- )
- drop "Authors" $heading all-authors authors. ;
+: $all-authors ( element -- )
+ drop "Authors" $heading all-authors $authors ;
INSTANCE: vocab topic
vocabs.loader vocabs sequences namespaces make math.parser\r
arrays hashtables assocs memoize summary sorting splitting\r
combinators source-files debugger continuations compiler.errors\r
-init checksums checksums.crc32 sets accessors ;\r
+init checksums checksums.crc32 sets accessors generic\r
+definitions words ;\r
IN: tools.vocabs\r
\r
+: vocab-xref ( vocab quot -- vocabs )\r
+ [ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map\r
+ [\r
+ [ [ word? ] [ generic? not ] bi and ] filter [\r
+ dup method-body?\r
+ [ "method-generic" word-prop ] when\r
+ vocabulary>>\r
+ ] map\r
+ ] gather natural-sort remove sift ; inline\r
+\r
+: vocabs. ( seq -- )\r
+ [ dup >vocab-link write-object nl ] each ;\r
+\r
+: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;\r
+\r
+: vocab-uses. ( vocab -- ) vocab-uses vocabs. ;\r
+\r
+: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;\r
+\r
+: vocab-usage. ( vocab -- ) vocab-usage vocabs. ;\r
+\r
: vocab-tests-file ( vocab -- path )\r
dup "-tests.factor" vocab-dir+ vocab-append-path dup\r
[ dup exists? [ drop f ] unless ] [ drop f ] if ;\r
[\r
[\r
[ modified-sources ]\r
- [ vocab-source-loaded? ]\r
+ [ vocab source-loaded?>> ]\r
[ vocab-source-path ]\r
tri (to-refresh)\r
] [\r
[ modified-docs ]\r
- [ vocab-docs-loaded? ]\r
+ [ vocab docs-loaded?>> ]\r
[ vocab-docs-path ]\r
tri (to-refresh)\r
] bi\r
: do-refresh ( modified-sources modified-docs unchanged -- )\r
unchanged-vocabs\r
[\r
- [ [ f swap set-vocab-source-loaded? ] each ]\r
- [ [ f swap set-vocab-docs-loaded? ] each ] bi*\r
+ [ [ vocab f >>source-loaded? drop ] each ]\r
+ [ [ vocab f >>docs-loaded? drop ] each ] bi*\r
]\r
[\r
append prune\r
: (step-into-continuation) ( -- )
continuation callstack >>call break ;
-: (step-into-call-next-method) ( class generic -- )
+: (step-into-call-next-method) ( method -- )
next-method-quot (step-into-quot) ;
! Messages sent to walker thread
SINGLETON: cocoa-ui-backend
M: cocoa-ui-backend do-events ( -- )
- [
- [ NSApp [ do-event ] curry loop ui-wait ] ui-try
- ] with-autorelease-pool ;
+ [ NSApp [ do-event ] curry loop ui-wait ] with-autorelease-pool ;
TUPLE: pasteboard handle ;
{
{ S+ HEX: 20000 }
{ C+ HEX: 40000 }
- { A+ HEX: 80000 }
- { M+ HEX: 100000 }
+ { A+ HEX: 100000 }
+ { M+ HEX: 80000 }
} ;
: key-codes
: key-event>gesture ( event -- modifiers keycode action? )
dup event-modifiers swap key-code ;
-: send-key-event ( view event quot -- ? )
- >r key-event>gesture r> call swap window-focus
- send-gesture ; inline
-
-: send-user-input ( view string -- )
- CF>string swap window-focus user-input ;
+: send-key-event ( view gesture -- )
+ swap window-focus propagate-gesture ;
: interpret-key-event ( view event -- )
NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
: send-key-down-event ( view event -- )
- 2dup [ <key-down> ] send-key-event
- [ interpret-key-event ] [ 2drop ] if ;
+ [ key-event>gesture <key-down> send-key-event ]
+ [ interpret-key-event ]
+ 2bi ;
: send-key-up-event ( view event -- )
- [ <key-up> ] send-key-event drop ;
+ key-event>gesture <key-up> send-key-event ;
: mouse-event>gesture ( event -- modifiers button )
dup event-modifiers swap button ;
: send-button-down$ ( view event -- )
- [ mouse-event>gesture <button-down> ] 2keep
- mouse-location rot window send-button-down ;
+ [ mouse-event>gesture <button-down> ]
+ [ mouse-location rot window send-button-down ] 2bi ;
: send-button-up$ ( view event -- )
[ mouse-event>gesture <button-up> ] 2keep
}
{ "mouseEntered:" "void" { "id" "SEL" "id" }
- [ [ nip send-mouse-moved ] ui-try ]
+ [ nip send-mouse-moved ]
}
{ "mouseExited:" "void" { "id" "SEL" "id" }
- [ [ 3drop forget-rollover ] ui-try ]
+ [ 3drop forget-rollover ]
}
{ "mouseMoved:" "void" { "id" "SEL" "id" }
- [ [ nip send-mouse-moved ] ui-try ]
+ [ nip send-mouse-moved ]
}
{ "mouseDragged:" "void" { "id" "SEL" "id" }
- [ [ nip send-mouse-moved ] ui-try ]
+ [ nip send-mouse-moved ]
}
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
- [ [ nip send-mouse-moved ] ui-try ]
+ [ nip send-mouse-moved ]
}
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
- [ [ nip send-mouse-moved ] ui-try ]
+ [ nip send-mouse-moved ]
}
{ "mouseDown:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-down$ ] ui-try ]
+ [ nip send-button-down$ ]
}
{ "mouseUp:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-up$ ] ui-try ]
+ [ nip send-button-up$ ]
}
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-down$ ] ui-try ]
+ [ nip send-button-down$ ]
}
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-up$ ] ui-try ]
+ [ nip send-button-up$ ]
}
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-down$ ] ui-try ]
+ [ nip send-button-down$ ]
}
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
- [ [ nip send-button-up$ ] ui-try ]
+ [ nip send-button-up$ ]
}
{ "scrollWheel:" "void" { "id" "SEL" "id" }
- [ [ nip send-wheel$ ] ui-try ]
+ [ nip send-wheel$ ]
}
{ "keyDown:" "void" { "id" "SEL" "id" }
- [ [ nip send-key-down-event ] ui-try ]
+ [ nip send-key-down-event ]
}
{ "keyUp:" "void" { "id" "SEL" "id" }
- [ [ nip send-key-up-event ] ui-try ]
+ [ nip send-key-up-event ]
}
{ "cut:" "id" { "id" "SEL" "id" }
- [ [ nip T{ cut-action } send-action$ ] ui-try ]
+ [ nip T{ cut-action } send-action$ ]
}
{ "copy:" "id" { "id" "SEL" "id" }
- [ [ nip T{ copy-action } send-action$ ] ui-try ]
+ [ nip T{ copy-action } send-action$ ]
}
{ "paste:" "id" { "id" "SEL" "id" }
- [ [ nip T{ paste-action } send-action$ ] ui-try ]
+ [ nip T{ paste-action } send-action$ ]
}
{ "delete:" "id" { "id" "SEL" "id" }
- [ [ nip T{ delete-action } send-action$ ] ui-try ]
+ [ nip T{ delete-action } send-action$ ]
}
{ "selectAll:" "id" { "id" "SEL" "id" }
- [ [ nip T{ select-all-action } send-action$ ] ui-try ]
+ [ nip T{ select-all-action } send-action$ ]
}
! Multi-touch gestures: this is undocumented.
! Text input
{ "insertText:" "void" { "id" "SEL" "id" }
- [ [ nip send-user-input ] ui-try ]
+ [ nip CF>string swap window-focus user-input ]
}
{ "hasMarkedText" "char" { "id" "SEL" }
! Initialization
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
- [
- [
- 2drop dup view-dim swap window (>>dim) yield
- ] ui-try
- ]
+ [ 2drop dup view-dim swap window (>>dim) yield ]
+}
+
+{ "doCommandBySelector:" "void" { "id" "SEL" "SEL" }
+ [ 3drop ]
}
{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
[ gesture>string , ]
[
[ command-name , ]
- [ command-word \ $link swap 2array , ]
+ [ command-word <$link> , ]
[ command-description , ]
tri
] bi*
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math models namespaces sequences
strings quotations assocs combinators classes colors
-classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
-ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
-ui.render math.geometry.rect locals alien.c-types ;
+classes.tuple locals alien.c-types fry opengl opengl.gl
+math.vectors ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.labels ui.gadgets.theme ui.gadgets.tracks
+ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.render
+math.geometry.rect ;
IN: ui.gadgets.buttons
TUPLE: button < border pressed? selected? quot ;
relayout-1 ;
: if-clicked ( button quot -- )
- >r dup button-update dup button-rollover? r> [ drop ] if ;
+ [ dup button-update dup button-rollover? ] dip [ drop ] if ;
: button-clicked ( button -- ) dup quot>> if-clicked ;
: roll-button-theme ( button -- button )
f black <solid> dup f <button-paint> >>boundary
+ f f pressed-gradient f <button-paint> >>interior
align-left ; inline
: <roll-button> ( label quot -- button )
over value>> = >>selected?
relayout-1 ;
-: <radio-controls> ( parent model assoc quot -- parent )
- #! quot has stack effect ( value model label -- )
- swapd [ swapd call add-gadget ] 2curry assoc-each ; inline
+: <radio-controls> ( assoc model parent quot: ( value model label -- ) -- parent )
+ '[ _ swap _ call add-gadget ] assoc-each ; inline
: radio-button-theme ( gadget -- gadget )
{ 5 5 } >>gap
: <radio-buttons> ( model assoc -- gadget )
<filled-pile>
- -rot
- [ <radio-button> ] <radio-controls>
+ spin [ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ;
: <toggle-button> ( value model label -- gadget )
: <toggle-buttons> ( model assoc -- gadget )
<shelf>
- -rot
- [ <toggle-button> ] <radio-controls> ;
+ spin [ <toggle-button> ] <radio-controls> ;
: command-button-quot ( target command -- quot )
- [ invoke-command drop ] 2curry ;
+ '[ _ _ invoke-command drop ] ;
: <command-button> ( target gesture command -- button )
- [ command-string ] keep
- swapd
- command-button-quot
- <bevel-button> ;
+ [ command-string swap ] keep command-button-quot <bevel-button> ;
: <toolbar> ( target -- toolbar )
<shelf>
swap
"toolbar" over class command-map commands>> swap
- [ -rot <command-button> add-gadget ] curry assoc-each ;
+ '[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
+
+: add-toolbar ( track -- track )
+ dup <toolbar> f track-add ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents io kernel math models
namespaces make opengl opengl.gl sequences strings io.styles
-math.vectors sorting colors combinators assocs math.order
-ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures
-math.geometry.rect ;
+math.vectors sorting colors combinators assocs math.order fry
+calendar alarms ui.clipboards ui.commands ui.gadgets
+ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.wrappers
+ui.render ui.gestures math.geometry.rect ;
IN: ui.gadgets.editors
TUPLE: editor < gadget
font color caret-color selection-color
caret mark
-focused? ;
+focused? blink blink-alarm ;
: <loc> ( -- loc ) { 0 0 } <model> ;
dup deactivate-model
swap model>> remove-loc ;
+: blink-caret ( editor -- )
+ [ not ] change-blink relayout-1 ;
+
+SYMBOL: blink-interval
+
+750 milliseconds blink-interval set-global
+
+: start-blinking ( editor -- )
+ t >>blink
+ dup '[ _ blink-caret ] blink-interval get every >>blink-alarm drop ;
+
+: stop-blinking ( editor -- )
+ [ [ cancel-alarm ] when* f ] change-blink-alarm drop ;
+
+: restart-blinking ( editor -- )
+ dup focused?>> [
+ [ stop-blinking ]
+ [ start-blinking ]
+ [ relayout-1 ]
+ tri
+ ] [ drop ] if ;
+
M: editor graft*
dup
dup caret>> activate-editor-model
M: editor ungraft*
dup
+ dup stop-blinking
dup caret>> deactivate-editor-model
dup mark>> deactivate-editor-model ;
caret>> set-model ;
: change-caret ( editor quot -- )
- over >r >r dup editor-caret* swap model>> r> call r>
+ [ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ drop ] 2bi
set-caret ; inline
: mark>caret ( editor -- )
- dup editor-caret* swap mark>> set-model ;
+ [ editor-caret* ] [ mark>> ] bi set-model ;
: change-caret&mark ( editor quot -- )
- over >r change-caret r> mark>caret ; inline
+ [ change-caret ] [ drop mark>caret ] 2bi ; inline
: editor-line ( n editor -- str ) control-value nth ;
: point>loc ( point editor -- loc )
[
- >r first2 r> tuck y>line dup ,
- >r dup editor-font* r>
+ [ first2 ] dip tuck y>line dup ,
+ [ dup editor-font* ] dip
rot editor-line x>offset ,
] { } make ;
[ hand-rel ] keep point>loc ;
: click-loc ( editor model -- )
- >r clicked-loc r> set-model ;
+ [ clicked-loc ] dip set-model ;
-: focus-editor ( editor -- ) t >>focused? relayout-1 ;
+: focus-editor ( editor -- )
+ dup start-blinking
+ t >>focused?
+ relayout-1 ;
-: unfocus-editor ( editor -- ) f >>focused? relayout-1 ;
+: unfocus-editor ( editor -- )
+ dup stop-blinking
+ f >>focused?
+ relayout-1 ;
: (offset>x) ( font col# str -- x )
swap head-slice string-width ;
: offset>x ( col# line# editor -- x )
[ editor-line ] keep editor-font* -rot (offset>x) ;
-: loc>x ( loc editor -- x ) >r first2 swap r> offset>x ;
+: loc>x ( loc editor -- x ) [ first2 swap ] dip offset>x ;
: line>y ( lines# editor -- y )
line-height * ;
: scroll>caret ( editor -- )
dup graft-state>> second [
- dup caret-loc over caret-dim <rect>
- over scroll>rect
- ] when drop ;
+ [
+ [ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
+ ] keep scroll>rect
+ ] [ drop ] if ;
: draw-caret ( -- )
- editor get focused?>> [
+ editor get [ focused?>> ] [ blink>> ] bi and [
editor get
[ caret-color>> gl-color ]
[
line-translation gl-translate ;
: draw-line ( editor str -- )
- >r font>> r> { 0 0 } draw-string ;
+ [ font>> ] dip { 0 0 } draw-string ;
: first-visible-line ( editor -- n )
clip get rect-loc second origin get second -
rot control-value <slice> ;
: with-editor-translation ( n quot -- )
- >r line-translation origin get v+ r> with-translation ;
+ [ line-translation origin get v+ ] dip with-translation ;
inline
: draw-lines ( -- )
editor get selection-start/end
over first [
2dup [
- >r 2dup r> draw-selected-line
+ [ 2dup ] dip draw-selected-line
1 translate-lines
] each-line 2drop
] with-editor-translation ;
drop relayout ;
: caret/mark-changed ( model editor -- )
- nip [ relayout-1 ] [ scroll>caret ] bi ;
+ nip [ restart-blinking ] [ scroll>caret ] bi ;
M: editor model-changed
{
M: editor gadget-text* editor-string % ;
: extend-selection ( editor -- )
- dup request-focus dup caret>> click-loc ;
+ dup request-focus
+ dup restart-blinking
+ dup caret>> click-loc ;
: mouse-elt ( -- element )
hand-click# get {
editor-mark* before? ;
: drag-selection-caret ( loc editor element -- loc )
- >r [ drag-direction? ] 2keep
- model>>
- r> prev/next-elt ? ;
+ [
+ [ drag-direction? ] 2keep model>>
+ ] dip prev/next-elt ? ;
: drag-selection-mark ( loc editor element -- loc )
- >r [ drag-direction? not ] 2keep
- nip dup editor-mark* swap model>>
- r> prev/next-elt ? ;
+ [
+ [ drag-direction? not ] keep
+ [ editor-mark* ] [ model>> ] bi
+ ] dip prev/next-elt ? ;
: drag-caret&mark ( editor -- caret mark )
dup clicked-loc swap mouse-elt
over gadget-selection? [
drop nip remove-selection
] [
- over >r >r dup editor-caret* swap model>>
- r> call r> model>> remove-doc-range
+ [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
+ [ drop model>> ]
+ 2bi remove-doc-range
] if ; inline
: editor-delete ( editor elt -- )
- swap [ over >r rot next-elt r> swap ] delete/backspace ;
+ swap [ over [ rot next-elt ] dip swap ] delete/backspace ;
: editor-backspace ( editor elt -- )
- swap [ over >r rot prev-elt r> ] delete/backspace ;
+ swap [ over [ rot prev-elt ] dip ] delete/backspace ;
: editor-select-prev ( editor elt -- )
swap [ rot prev-elt ] change-caret ;
tuck caret>> set-model mark>> set-model ;
: select-elt ( editor elt -- )
- over >r
- >r dup editor-caret* swap model>> r> prev/next-elt
- r> editor-select ;
+ [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi
+ editor-select ;
: start-of-document ( editor -- ) T{ doc-elt } editor-prev ;
[ drop dup extend-selection dup mark>> click-loc ]
[ select-elt ] if ;
-: insert-newline ( editor -- ) "\n" swap user-input ;
+: insert-newline ( editor -- ) "\n" swap user-input* drop ;
: delete-next-character ( editor -- )
T{ char-elt } editor-delete ;
T{ doc-elt } editor-select-next ;
editor "selection" f {
- { T{ button-down f { S+ } } extend-selection }
+ { T{ button-down f { S+ } 1 } extend-selection }
{ T{ drag } drag-selection }
{ T{ gain-focus } focus-editor }
{ T{ lose-focus } unfocus-editor }
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel math namespaces sequences words
splitting grouping math.vectors ui.gadgets.grids ui.gadgets
: <frame-grid> ( -- grid ) 9 [ <gadget> ] replicate 3 group ;
-: @center 1 1 ;
-: @left 0 1 ;
-: @right 2 1 ;
-: @top 1 0 ;
-: @bottom 1 2 ;
+: @center 1 1 ; inline
+: @left 0 1 ; inline
+: @right 2 1 ; inline
+: @top 1 0 ; inline
+: @bottom 1 2 ; inline
-: @top-left 0 0 ;
-: @top-right 2 0 ;
-: @bottom-left 0 2 ;
-: @bottom-right 2 2 ;
+: @top-left 0 0 ; inline
+: @top-right 2 0 ; inline
+: @bottom-left 0 2 ; inline
+: @bottom-right 2 2 ; inline
: new-frame ( class -- frame )
<frame-grid> swap new-grid ; inline
: <frame> ( -- frame )
frame new-frame ;
-: (fill-center) ( vec n -- )
- over first pick third v+ [v-] 1 rot set-nth ;
+: (fill-center) ( n vec -- )
+ [ [ first ] [ third ] bi v+ [v-] ] keep set-second ;
-: fill-center ( horiz vert dim -- )
- tuck (fill-center) (fill-center) ;
+: fill-center ( dim horiz vert -- )
+ [ over ] dip [ (fill-center) ] 2bi@ ;
M: frame layout*
dup compute-grid
- [ rot rect-dim fill-center ] 3keep
- grid-layout ;
+ [ [ rect-dim ] 2dip fill-center ] [ grid-layout ] 3bi ;
: notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ;
-TUPLE: gadget < rect
- pref-dim parent children orientation focus
- visible? root? clipped? layout-state graft-state graft-node
- interior boundary
- model ;
+TUPLE: gadget < rect pref-dim parent children orientation focus
+visible? root? clipped? layout-state graft-state graft-node
+interior boundary model ;
M: gadget equal? 2drop f ;
--- /dev/null
+USING: accessors tools.test ui.gadgets ui.gadgets.labels ;
+IN: ui.gadgets.labels.tests
+
+[ { 119 14 } ] [
+ <gadget> { 100 14 } >>dim
+ <gadget> { 14 14 } >>dim
+ label-on-right { 5 5 } >>gap
+ pref-dim
+] unit-test
[ t ] [ [ [ 1 2 3 ] pprint ] test-gadget-text ] unit-test
[ t ] [ [ \ + describe ] test-gadget-text ] unit-test
[ t ] [ [ \ = see ] test-gadget-text ] unit-test
-[ t ] [ [ \ = help ] test-gadget-text ] unit-test
+[ t ] [ [ \ = print-topic ] test-gadget-text ] unit-test
[ t ] [
[
[ t ] [ [ "test-article-1" $title ] test-gadget-text ] unit-test
-[ t ] [ [ "test-article-1" help ] test-gadget-text ] unit-test
+[ t ] [ [ "test-article-1" print-topic ] test-gadget-text ] unit-test
ARTICLE: "test-article-2" "This is a test article"
"Hello world, how are you today."
{ $table { "a" "b" } { "c" "d" } } ;
-[ t ] [ [ "test-article-2" help ] test-gadget-text ] unit-test
+[ t ] [ [ "test-article-2" print-topic ] test-gadget-text ] unit-test
<pane> [ \ = see ] with-pane
-<pane> [ \ = help ] with-pane
+<pane> [ \ = print-topic ] with-pane
[ ] [
\ = <model> [ see ] <pane-control> [ ] with-grafted-gadget
ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
classes.tuple models continuations destructors accessors
math.geometry.rect ;
-
IN: ui.gadgets.panes
TUPLE: pane < pack
dup hand-rel over sloppy-pick-up >>caret
dup relayout-1 ;
-: begin-selection ( pane -- ) move-caret f >>mark drop ;
+: begin-selection ( pane -- )
+ f >>selecting?
+ move-caret
+ f >>mark
+ drop ;
: extend-selection ( pane -- )
hand-moved? [
] if ;
: select-to-caret ( pane -- )
+ t >>selecting?
dup mark>> [ caret>mark ] unless
move-caret
dup request-focus
pane H{
{ T{ button-down } [ begin-selection ] }
{ T{ button-down f { S+ } 1 } [ select-to-caret ] }
- { T{ button-up f { S+ } 1 } [ drop ] }
+ { T{ button-up f { S+ } 1 } [ end-selection ] }
{ T{ button-up } [ end-selection ] }
{ T{ drag } [ extend-selection ] }
{ T{ copy-action } [ com-copy ] }
kernel models models.compose models.range ui.gadgets.viewports
ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
ui.gadgets.sliders math math.vectors arrays sequences
-tools.test.ui math.geometry.rect accessors ;
+tools.test.ui math.geometry.rect accessors ui.gadgets.buttons
+ui.gadgets.packs ;
IN: ui.gadgets.scrollers.tests
[ ] [
"g2" get scroll>gadget
"s" get layout
"s" get scroller-value
- ] map [ { 3 0 } = ] all?
+ ] map [ { 2 0 } = ] all?
] unit-test
[ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
[ t ] [ "s" get @right grid-child slider? ] unit-test
[ f ] [ "s" get @right grid-child find-scroller* ] unit-test
+[ ] [
+ "Click Me" [ [ scroll>gadget ] [ unparent ] bi ] <bevel-button>
+ [ <pile> swap add-gadget <scroller> ] keep
+ dup quot>> call
+ layout
+] unit-test
+
+[ t ] [
+ <gadget> { 200 200 } >>dim
+ [ [ scroll>gadget ] [ unparent ] bi ] <bevel-button>
+ dup
+ <pile> swap add-gadget <scroller> { 100 100 } >>dim dup layout
+ swap dup quot>> call
+ dup layout
+ model>> dependencies>> [ range-max value>> ] map
+ viewport-gap 2 v*n =
+] unit-test
+
\ <scroller> must-infer
USING: accessors arrays ui.gadgets ui.gadgets.viewports
ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme
ui.gadgets.sliders ui.gestures kernel math namespaces sequences
-models models.range models.compose
-combinators math.vectors classes.tuple math.geometry.rect
-combinators.short-circuit ;
+models models.range models.compose combinators math.vectors
+classes.tuple math.geometry.rect combinators.short-circuit ;
IN: ui.gadgets.scrollers
TUPLE: scroller < frame viewport x y follows ;
: scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ;
: do-mouse-scroll ( scroller -- )
- scroll-direction get-global first2
- pick y>> slide-by-line
- swap x>> slide-by-line ;
+ scroll-direction get-global
+ [ first swap x>> slide-by-line ]
+ [ second swap y>> slide-by-line ]
+ 2bi ;
scroller H{
{ T{ mouse-scroll } [ do-mouse-scroll ] }
dup model>> dependencies>> second <y-slider> >>y dup y>> @right grid-add
tuck model>> <viewport> >>viewport
- dup viewport>> @center grid-add ;
+ dup viewport>> @center grid-add ; inline
: <scroller> ( gadget -- scroller ) scroller new-scroller ;
: scroll ( value scroller -- )
[
- dup viewport>> rect-dim { 0 0 }
- rot viewport>> viewport-dim 4array flip
+ viewport>> [ rect-dim { 0 0 } ] [ viewport-dim ] bi
+ 4array flip
] keep
2dup control-value = [ 2drop ] [ set-control-value ] if ;
-: rect-min ( rect1 rect2 -- rect )
- >r [ rect-loc ] keep r> [ rect-dim ] bi@ vmin <rect> ;
+: rect-min ( rect dim -- rect' )
+ [ [ loc>> ] [ dim>> ] bi ] dip vmin <rect> ;
: (scroll>rect) ( rect scroller -- )
- [
- scroller-value vneg offset-rect
- viewport-gap offset-rect
- ] keep
- [ viewport>> rect-min ] keep
- [
- viewport>> 2rect-extent
- >r >r v- { 0 0 } vmin r> r> v- { 0 0 } vmax v+
- ] keep dup scroller-value rot v+ swap scroll ;
+ [ [ loc>> { 1 1 } v- ] [ dim>> { 1 1 } v+ ] bi <rect> ] dip
+ {
+ [ scroller-value vneg offset-rect viewport-gap offset-rect ]
+ [ viewport>> dim>> rect-min ]
+ [ viewport>> 2rect-extent [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] 2bi* v+ ]
+ [ scroller-value v+ ]
+ [ scroll ]
+ } cleave ;
: relative-scroll-rect ( rect gadget scroller -- newrect )
viewport>> gadget-child relative-loc offset-rect ;
[ relative-scroll-rect ] keep
swap >>follows
relayout
- ] [
- 3drop
- ] if ;
+ ] [ 3drop ] if ;
+
+: (update-scroller) ( scroller -- )
+ [ scroller-value ] keep scroll ;
: (scroll>gadget) ( gadget scroller -- )
- >r { 0 0 } over pref-dim <rect> swap r>
- [ relative-scroll-rect ] keep
- (scroll>rect) ;
+ 2dup swap child? [
+ [ [ pref-dim { 0 0 } swap <rect> ] keep ] dip
+ [ relative-scroll-rect ] keep
+ (scroll>rect)
+ ] [ f >>follows (update-scroller) drop ] if ;
: scroll>gadget ( gadget -- )
dup find-scroller* dup [
] if ;
: (scroll>bottom) ( scroller -- )
- dup viewport>> viewport-dim { 0 1 } v* swap scroll ;
+ [ viewport>> viewport-dim { 0 1 } v* ] keep scroll ;
: scroll>bottom ( gadget -- )
find-scroller [ t >>follows relayout-1 ] when* ;
M: rect update-scroller swap (scroll>rect) ;
-M: f update-scroller drop dup scroller-value swap scroll ;
+M: f update-scroller drop (update-scroller) ;
M: scroller layout*
- dup call-next-method
- dup follows>>
- 2dup update-scroller
- >>follows drop ;
+ [ call-next-method ] [
+ dup follows>>
+ [ update-scroller ] [ >>follows drop ] 2bi
+ ] bi ;
M: scroller focusable-child*
viewport>> ;
M: scroller model-changed
- nip f >>follows drop ;
+ f >>follows 2drop ;
-TUPLE: limited-scroller < scroller fixed-dim ;
+TUPLE: limited-scroller < scroller
+{ min-dim initial: { 0 0 } }
+{ max-dim initial: { 1/0. 1/0. } } ;
-: <limited-scroller> ( gadget dim -- scroller )
- >r limited-scroller new-scroller r> >>fixed-dim ;
+: <limited-scroller> ( gadget -- scroller )
+ limited-scroller new-scroller ;
M: limited-scroller pref-dim*
- fixed-dim>> ;
+ [ call-next-method ] [ min-dim>> vmax ] [ max-dim>> vmin ] tri ;
GENERIC: finish-editing ( slot-editor ref -- )
M: key-ref finish-editing
- drop T{ update-object } swap send-gesture drop ;
+ drop T{ update-object } swap propagate-gesture ;
M: value-ref finish-editing
- drop T{ update-slot } swap send-gesture drop ;
+ drop T{ update-slot } swap propagate-gesture ;
: slot-editor-value ( slot-editor -- object )
text>> control-value parse-fresh ;
: delete ( slot-editor -- )
dup ref>> delete-ref
- T{ update-object } swap send-gesture drop ;
+ T{ update-object } swap propagate-gesture ;
\ delete H{
{ +description+ "Delete the slot and close the slot editor." }
} define-command
: close ( slot-editor -- )
- T{ update-slot } swap send-gesture drop ;
+ T{ update-slot } swap propagate-gesture ;
\ close H{
{ +description+ "Close the slot editor without saving changes." }
: <slot-editor> ( ref -- gadget )
{ 0 1 } slot-editor new-track
swap >>ref
- dup <toolbar> f track-add
+ add-toolbar
<source-editor> >>text
dup text>> <scroller> 1 track-add
dup revert ;
: <edit-button> ( -- gadget )
"..."
- [ T{ edit-slot } swap send-gesture drop ]
+ [ T{ edit-slot } swap propagate-gesture ]
<roll-button> ;
: display-slot ( gadget editable-slot -- )
<gadget> { 100 100 } >>dim 1 track-add
pref-dim
] unit-test
+
+[ { 10 10 } ] [
+ { 0 1 } <track>
+ <gadget> { 10 10 } >>dim 1 track-add
+ <gadget> { 10 10 } >>dim 0 track-add
+ pref-dim
+] unit-test
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors io kernel math namespaces
- sequences words math.vectors ui.gadgets ui.gadgets.packs
- math.geometry.rect fry ;
+USING: accessors io kernel namespaces fry
+math math.vectors math.geometry.rect math.order
+sequences words ui.gadgets ui.gadgets.packs ;
IN: ui.gadgets.tracks
M: track layout* ( track -- ) dup track-layout pack-layout ;
-: track-pref-dims-1 ( track -- dim ) children>> pref-dims max-dim ;
+: track-pref-dims-1 ( track -- dim )
+ children>> pref-dims max-dim ;
: track-pref-dims-2 ( track -- dim )
- [ children>> pref-dims ] [ normalized-sizes ] bi
- [ [ v/n ] when* ] 2map
- max-dim
- [ >fixnum ] map ;
+ [
+ [ children>> pref-dims ] [ normalized-sizes ] bi
+ [ dup { 0 f } memq? [ drop ] [ v/n ] if ] 2map
+ max-dim [ >fixnum ] map
+ ]
+ [ [ gap>> ] [ children>> length 1 [-] ] bi v*n ] bi
+ v+ ;
M: track pref-dim* ( gadget -- dim )
[ track-pref-dims-1 ]
swap add-gadget ;
M: viewport layout*
- dup rect-dim viewport-gap 2 v*n v-
- over gadget-child pref-dim vmax
- swap gadget-child (>>dim) ;
+ [
+ [ rect-dim viewport-gap 2 v*n v- ]
+ [ gadget-child pref-dim ]
+ bi vmax
+ ] [ gadget-child ] bi (>>dim) ;
M: viewport focusable-child*
gadget-child ;
: (request-focus) ( child world ? -- )
pick parent>> pick eq? [
- >r >r dup parent>> dup r> r>
+ [ dup parent>> dup ] 2dip
[ (request-focus) ] keep
] unless focus-child ;
: ui-error ( error -- )
ui-error-hook get [ call ] [ print-error ] if* ;
-[ rethrow ] ui-error-hook set-global
+ui-error-hook global [ [ rethrow ] or ] change-at
: draw-world ( world -- )
dup draw-world? [
{ T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
{ T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
{ T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
+ { T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-up f { C+ } 1 } [ drop T{ button-up f f 3 } button-gesture ] }
{ T{ button-up f { A+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
+ { T{ button-up f { M+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
} set-gestures
+PREDICATE: specific-button-up < button-up #>> ;
+PREDICATE: specific-button-down < button-down #>> ;
+PREDICATE: specific-drag < drag #>> ;
+
+: generalize-gesture ( gesture -- )
+ clone f >># button-gesture ;
+
+M: world handle-gesture ( gesture gadget -- ? )
+ 2dup call-next-method [
+ {
+ { [ over specific-button-up? ] [ drop generalize-gesture f ] }
+ { [ over specific-button-down? ] [ drop generalize-gesture f ] }
+ { [ over specific-drag? ] [ drop generalize-gesture f ] }
+ [ 2drop t ]
+ } cond
+ ] [ 2drop f ] if ;
+
: close-global ( world global -- )
dup get-global find-world rot eq?
[ f swap set-global ] [ drop ] if ;
"The default implementation looks at the " { $snippet "\"gestures\"" } " word property of each superclass of the gadget's class." }
{ $notes "Methods should be defined on this word if you desire to handle an arbitrary set of gestures. To define handlers for a fixed set, it is easier to use " { $link set-gestures } "." } ;
-{ send-gesture handle-gesture set-gestures } related-words
+{ propagate-gesture handle-gesture set-gestures } related-words
-HELP: send-gesture
-{ $values { "gesture" "a gesture" } { "gadget" gadget } { "?" "a boolean" } }
-{ $description "Calls " { $link send-gesture } " on every parent of " { $snippet "gadget" } ". Outputs " { $link f } " if some parent handled the gesture, else outputs " { $link t } "." } ;
+HELP: propagate-gesture
+{ $values { "gesture" "a gesture" } { "gadget" gadget } }
+{ $description "Calls " { $link handle-gesture } " on every parent of " { $snippet "gadget" } "." } ;
HELP: user-input
-{ $values { "str" string } { "gadget" gadget } }
+{ $values { "string" string } { "gadget" gadget } }
{ $description "Calls " { $link user-input* } " on every parent of the gadget." } ;
HELP: motion
{ $class-description "Gesture sent when the " { $emphasis "select all" } " standard window system action is invoked." }
{ $examples { $code "T{ select-all-action }" } } ;
-HELP: generalize-gesture
-{ $values { "gesture" "a gesture" } { "newgesture" "a new gesture" } }
-{ $description "Turns a " { $link button-down } ", " { $link button-up } " or " { $link drag } " action naming a specific mouse button into one which can apply regardless of which mouse button was pressed." } ;
-
HELP: C+
{ $description "Control key modifier." } ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs kernel math models namespaces
make sequences words strings system hashtables math.parser
-math.vectors classes.tuple classes ui.gadgets boxes calendar
-alarms symbols combinators sets columns ;
+math.vectors classes.tuple classes boxes calendar
+alarms symbols combinators sets columns fry deques ui.gadgets ;
IN: ui.gestures
-: set-gestures ( class hash -- ) "gestures" set-word-prop ;
-
GENERIC: handle-gesture ( gesture gadget -- ? )
M: object handle-gesture
[ "gestures" word-prop ] map
assoc-stack dup [ call f ] [ 2drop t ] if ;
-: send-gesture ( gesture gadget -- ? )
- [ dupd handle-gesture ] each-parent nip ;
+: set-gestures ( class hash -- ) "gestures" set-word-prop ;
+
+: gesture-queue ( -- deque ) \ gesture-queue get ;
+
+GENERIC: send-queued-gesture ( request -- )
+
+TUPLE: send-gesture gesture gadget ;
+
+M: send-gesture send-queued-gesture
+ [ gesture>> ] [ gadget>> ] bi handle-gesture drop ;
+
+: queue-gesture ( ... class -- )
+ boa gesture-queue push-front notify-ui-thread ; inline
+
+: send-gesture ( gesture gadget -- )
+ \ send-gesture queue-gesture ;
+
+: each-gesture ( gesture seq -- ) [ send-gesture ] with each ;
-: user-input ( str gadget -- )
- over empty?
- [ [ dupd user-input* ] each-parent ] unless
- 2drop ;
+TUPLE: propagate-gesture gesture gadget ;
+
+M: propagate-gesture send-queued-gesture
+ [ gesture>> ] [ gadget>> ] bi
+ [ handle-gesture ] with each-parent drop ;
+
+: propagate-gesture ( gesture gadget -- )
+ \ propagate-gesture queue-gesture ;
+
+TUPLE: user-input string gadget ;
+
+M: user-input send-queued-gesture
+ [ string>> ] [ gadget>> ] bi
+ [ user-input* ] with each-parent drop ;
+
+: user-input ( string gadget -- )
+ '[ _ \ user-input queue-gesture ] unless-empty ;
! Gesture objects
TUPLE: motion ; C: <motion> motion
TUPLE: up-action ; C: <up-action> up-action
TUPLE: down-action ; C: <down-action> down-action
-TUPLE: zoom-in-action ; C: <zoom-in-action> zoom-in-action
-TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
-
-: generalize-gesture ( gesture -- newgesture )
- clone f >># ;
+TUPLE: zoom-in-action ; C: <zoom-in-action> zoom-in-action
+TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
! Modifiers
SYMBOLS: C+ A+ M+ S+ ;
TUPLE: key-down mods sym ;
: <key-gesture> ( mods sym action? class -- mods' sym' )
- >r [ S+ rot remove swap ] unless r> boa ; inline
+ [ [ [ S+ swap remove f like ] dip ] unless ] dip boa ; inline
: <key-down> ( mods sym action? -- key-down )
key-down <key-gesture> ;
hand-loc get hand-click-loc get = not ;
: button-gesture ( gesture -- )
- hand-clicked get-global 2dup send-gesture [
- >r generalize-gesture r> send-gesture drop
- ] [
- 2drop
- ] if ;
+ hand-clicked get-global propagate-gesture ;
: drag-gesture ( -- )
hand-buttons get-global
: fire-motion ( -- )
hand-buttons get-global empty? [
- T{ motion } hand-gadget get-global send-gesture drop
+ T{ motion } hand-gadget get-global propagate-gesture
] [
drag-gesture
] if ;
-: each-gesture ( gesture seq -- )
- [ handle-gesture drop ] with each ;
-
: hand-gestures ( new old -- )
drop-prefix <reversed>
T{ mouse-leave } swap each-gesture
: forget-rollover ( -- )
f hand-world set-global
- hand-gadget get-global >r
- f hand-gadget set-global
- f r> parents hand-gestures ;
+ hand-gadget get-global
+ [ f hand-gadget set-global f ] dip
+ parents hand-gestures ;
: send-lose-focus ( gadget -- )
- T{ lose-focus } swap handle-gesture drop ;
+ T{ lose-focus } swap send-gesture ;
: send-gain-focus ( gadget -- )
- T{ gain-focus } swap handle-gesture drop ;
+ T{ gain-focus } swap send-gesture ;
: focus-child ( child gadget ? -- )
[
: move-hand ( loc world -- )
dup hand-world set-global
- under-hand >r over hand-loc set-global
- pick-up hand-gadget set-global
- under-hand r> hand-gestures ;
+ under-hand [
+ over hand-loc set-global
+ pick-up hand-gadget set-global
+ under-hand
+ ] dip hand-gestures ;
: send-button-down ( gesture loc world -- )
move-hand
: send-wheel ( direction loc world -- )
move-hand
scroll-direction set-global
- T{ mouse-scroll } hand-gadget get-global send-gesture
- drop ;
+ T{ mouse-scroll } hand-gadget get-global propagate-gesture ;
: world-focus ( world -- gadget )
dup focus>> [ world-focus ] [ ] ?if ;
: send-action ( world gesture -- )
- swap world-focus send-gesture drop ;
+ swap world-focus propagate-gesture ;
GENERIC: gesture>string ( gesture -- string/f )
models models.history ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
ui.gadgets.buttons compiler.units assocs words vocabs
-accessors ;
+accessors fry combinators.short-circuit ;
IN: ui.tools.browser
TUPLE: browser-gadget < track pane history ;
: show-help ( link help -- )
- dup history>> add-history
- >r >link r> history>> set-model ;
+ history>> dup add-history
+ [ >link ] dip set-model ;
: <help-pane> ( browser-gadget -- gadget )
- history>> [
[ help ] curry try ] <pane-control> ;
+ history>> [
'[ _ print-topic ] try ] <pane-control> ;
: init-history ( browser-gadget -- )
"handbook" >link <history> >>history drop ;
: <browser-gadget> ( -- gadget )
{ 0 1 } browser-gadget new-track
dup init-history
- dup <toolbar> f track-add
+ add-toolbar
dup <help-pane> >>pane
dup pane>> <scroller> 1 track-add ;
[ call-next-method ] [ remove-definition-observer ] bi ;
: showing-definition? ( defspec assoc -- ? )
- [ key? ] 2keep
- [ >r dup word-link? [ name>> ] when r> key? ] 2keep
- >r dup vocab-link? [ vocab ] when r> key?
- or or ;
+ {
+ [ key? ]
+ [ [ dup word-link? [ name>> ] when ] dip key? ]
+ [ [ dup vocab-link? [ vocab ] when ] dip key? ]
+ } 2|| ;
M: browser-gadget definitions-changed ( assoc browser -- )
history>>
\ browser-help H{ { +nullary+ t } } define-command
browser-gadget "toolbar" f {
- { T{ key-down f { A+ } "b" } com-back }
- { T{ key-down f { A+ } "f" } com-forward }
- { T{ key-down f { A+ } "h" } com-documentation }
- { T{ key-down f { A+ } "v" } com-vocabularies }
+ { T{ key-down f { A+ } "LEFT" } com-back }
+ { T{ key-down f { A+ } "RIGHT" } com-forward }
+ { f com-documentation }
+ { f com-vocabularies }
{ T{ key-down f f "F1" } browser-help }
} define-command-map
"Creates a gadget displaying a description of the error, along with buttons to print the contents of the stacks in the listener, and a list of restarts."
} ;
-{ <debugger> debugger-window ui-try } related-words
+{ <debugger> debugger-window } related-words
HELP: debugger-window
{ $values { "error" "an error" } }
: <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track
- dup <toolbar> f track-add
+ add-toolbar
-rot <restart-list> >>restarts
dup restarts>> rot <debugger-display> <scroller> 1 track-add ;
#! No restarts for the debugger window
f [ drop ] <debugger> "Error" open-window ;
-[ debugger-window ] ui-error-hook set-global
+GENERIC: error-in-debugger? ( error -- ? )
+
+M: world-error error-in-debugger? world>> gadget-child debugger? ;
+
+M: object error-in-debugger? drop f ;
+
+[
+ dup error-in-debugger? [ rethrow ] [ debugger-window ] if
+] ui-error-hook set-global
M: world-error error.
"An error occurred while drawing the world " write
: com-close ( gadget -- )
close-window ;
+deploy-gadget "misc" "Miscellaneous commands" {
+ { T{ key-down f f "ESC" } com-close }
+} define-command-map
+
deploy-gadget "toolbar" f {
- { f com-close }
- { f com-help }
+ { T{ key-down f f "F1" } com-help }
{ f com-revert }
{ f com-save }
{ T{ key-down f f "RET" } com-deploy }
: <inspector-gadget> ( -- gadget )
{ 0 1 } inspector-gadget new-track
- dup <toolbar> f track-add
+ add-toolbar
<pane> >>pane
dup pane>> <scroller> 1 track-add ;
: handle-interactive ( lines interactor -- quot/f ? )
tuck try-parse {
{ [ dup quotation? ] [ nip t ] }
- { [ dup not ] [ drop "\n" swap user-input f f ] }
+ { [ dup not ] [ drop "\n" swap user-input* drop f f ] }
[ handle-parse-error f f ]
} cond ;
]
} cond ;
-M: interactor pref-dim*
- [ line-height 4 * 0 swap 2array ] [ call-next-method ] bi
- vmax ;
-
interactor "interactor" f {
{ T{ key-down f f "RET" } evaluate-input }
{ T{ key-down f { C+ } "k" } clear-input }
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: inspector ui.tools.interactor ui.tools.inspector
-ui.tools.workspace help.markup io io.styles
-kernel models namespaces parser quotations sequences ui.commands
-ui.gadgets ui.gadgets.editors ui.gadgets.labelled
-ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
-ui.gadgets.tracks ui.gestures ui.operations vocabs words
-prettyprint listener debugger threads boxes concurrency.flags
-math arrays generic accessors combinators assocs ;
+USING: inspector help help.markup io io.styles kernel models
+namespaces parser quotations sequences vocabs words prettyprint
+listener debugger threads boxes concurrency.flags math arrays
+generic accessors combinators assocs fry ui.commands ui.gadgets
+ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes
+ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs
+ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations
+ui.tools.browser ui.tools.interactor ui.tools.inspector
+ui.tools.workspace ;
IN: ui.tools.listener
-TUPLE: listener-gadget < track input output stack ;
-
-: listener-output, ( listener -- listener )
- <scrolling-pane> >>output
- dup output>> <scroller> "Output" <labelled-gadget> 1 track-add ;
+TUPLE: listener-gadget < track input output ;
: listener-streams ( listener -- input output )
[ input>> ] [ output>> <pane-stream> ] bi ;
: <listener-input> ( listener -- gadget )
output>> <pane-stream> <interactor> ;
-: listener-input, ( listener -- listener )
- dup <listener-input> >>input
- dup input>>
- { 0 100 } <limited-scroller>
- "Input" <labelled-gadget>
- f track-add ;
-
: welcome. ( -- )
"If this is your first time with Factor, please read the " print
- "handbook" ($link) "." print nl ;
+ "handbook" ($link) ". To see a list of keyboard shortcuts," print
+ "press F1." print nl ;
M: listener-gadget focusable-child*
input>> ;
: call-listener ( quot -- )
[ workspace-busy? not ] get-workspace* listener>>
- [ dup wait-for-listener (call-listener) ] 2curry
+ '[ _ _ dup wait-for-listener (call-listener) ]
"Listener call" spawn drop ;
M: listener-command invoke-command ( target command -- )
: listener-run-files ( seq -- )
[
- [ [ run-file ] each ] curry call-listener
+ '[ _ [ run-file ] each ] call-listener
] unless-empty ;
: com-end ( listener -- )
: insert-word ( word -- )
get-workspace listener>> input>>
- [ >r word-completion-string r> user-input ]
+ [ >r word-completion-string r> user-input* drop ]
[ interactor-use use-if-necessary ]
2bi ;
[ select-all ]
2bi ;
-TUPLE: stack-display < track ;
-
-: <stack-display> ( workspace -- gadget )
- listener>>
- { 0 1 } stack-display new-track
- over <toolbar> f track-add
- swap stack>> [ [ stack. ] curry try ] t "Data stack" <labelled-pane>
- 1 track-add ;
-
-M: stack-display tool-scroller
- find-workspace listener>> tool-scroller ;
-
-: ui-listener-hook ( listener -- )
- >r datastack r> stack>> set-model ;
+: ui-help-hook ( topic -- )
+ browser-gadget call-tool ;
: ui-error-hook ( error listener -- )
find-workspace debugger-popup ;
: listener-thread ( listener -- )
dup listener-streams [
- [ [ ui-listener-hook ] curry listener-hook set ]
- [ [ ui-error-hook ] curry error-hook set ]
- [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+ [ ui-help-hook ] help-hook set
+ [ '[ _ ui-error-hook ] error-hook set ]
+ [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
welcome.
listener
] with-streams* ;
: start-listener-thread ( listener -- )
- [
- [ input>> register-self ] [ listener-thread ] bi
- ] curry "Listener" spawn drop ;
+ '[
+ _
+ [ input>> register-self ]
+ [ listener-thread ]
+ bi
+ ] "Listener" spawn drop ;
: restart-listener ( listener -- )
#! Returns when listener is ready to receive input.
[ wait-for-listener ]
} cleave ;
-: init-listener ( listener -- )
- f <model> >>stack drop ;
+: init-listener ( listener -- listener )
+ <scrolling-pane> >>output
+ dup <listener-input> >>input ;
+
+: <listener-scroller> ( listener -- scroller )
+ <filled-pile>
+ over output>> add-gadget
+ swap input>> add-gadget
+ <scroller> ;
: <listener-gadget> ( -- gadget )
{ 0 1 } listener-gadget new-track
- dup init-listener
- listener-output,
- listener-input, ;
+ add-toolbar
+ init-listener
+ dup <listener-scroller> 1 track-add ;
: listener-help ( -- ) "ui-listener" help-window ;
\ listener-help H{ { +nullary+ t } } define-command
+: com-auto-use ( -- )
+ auto-use? [ not ] change ;
+
+\ com-auto-use H{ { +nullary+ t } { +listener+ t } } define-command
+
+listener-gadget "misc" "Miscellaneous commands" {
+ { T{ key-down f f "F1" } listener-help }
+} define-command-map
+
listener-gadget "toolbar" f {
{ f restart-listener }
- { T{ key-down f { A+ } "c" } clear-output }
- { T{ key-down f { A+ } "C" } clear-stack }
+ { T{ key-down f { A+ } "u" } com-auto-use }
+ { T{ key-down f { A+ } "k" } clear-output }
+ { T{ key-down f { A+ } "K" } clear-stack }
{ T{ key-down f { C+ } "d" } com-end }
- { T{ key-down f f "F1" } listener-help }
} define-command-map
M: listener-gadget handle-gesture ( gesture gadget -- ? )
: <profiler-gadget> ( -- gadget )
{ 0 1 } profiler-gadget new-track
- dup <toolbar> f track-add
+ add-toolbar
<pane> >>pane
dup pane>> <scroller> 1 track-add ;
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs ui.tools.interactor ui.tools.listener
-ui.tools.workspace help help.topics io.files io.styles kernel
-models models.delay models.filter namespaces prettyprint
+USING: accessors assocs help help.topics io.files io.styles
+kernel models models.delay models.filter namespaces prettyprint
quotations sequences sorting source-files definitions strings
-tools.completion tools.crossref classes.tuple ui.commands
-ui.gadgets ui.gadgets.editors ui.gadgets.lists
-ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations
-vocabs words vocabs.loader tools.vocabs unicode.case calendar ui
-;
+tools.completion tools.crossref classes.tuple vocabs words
+vocabs.loader tools.vocabs unicode.case calendar locals
+ui.tools.interactor ui.tools.listener ui.tools.workspace
+ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists
+ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.borders
+ui.gestures ui.operations ui ;
IN: ui.tools.search
TUPLE: live-search < track field list ;
M: live-search handle-gesture ( gesture live-search -- ? )
tuck search-gesture dup [
over find-workspace hide-popup
- >r search-value r> invoke-command f
+ [ search-value ] dip invoke-command f
] [
2drop t
] if ;
{ T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
} set-gestures
-: <search-model> ( live-search producer -- live-search filter )
- >r dup field>> model>> ! live-search model :: producer
- ui-running? [ 1/5 seconds <delay> ] when
- [ "\n" join ] r> append <filter> ;
+: <search-model> ( live-search producer -- filter )
+ [
+ field>> model>>
+ ui-running? [ 1/5 seconds <delay> ] when
+ ] dip [ "\n" join ] prepend <filter> ;
-: <search-list> ( live-search seq limited? presenter -- live-search list )
- >r
- [ limited-completions ] [ completions ] ? curry
- <search-model>
- >r [ find-workspace hide-popup ] r> r>
- swap <list> ;
+: init-search-model ( live-search seq limited? -- live-search )
+ [ 2drop ]
+ [ [ limited-completions ] [ completions ] ? curry <search-model> ] 3bi
+ >>model ; inline
-: <live-search> ( string seq limited? presenter -- gadget )
+: <search-list> ( presenter live-search -- list )
+ [ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* <list> ;
+
+:: <live-search> ( string seq limited? presenter -- gadget )
{ 0 1 } live-search new-track
<search-field> >>field
- dup field>> f track-add
- -roll <search-list> >>list
+ seq limited? init-search-model
+ presenter over <search-list> >>list
+ dup field>> 1 <border> { 1 1 } >>fill f track-add
dup list>> <scroller> 1 track-add
- swap
- over field>> set-editor-string
- dup field>> end-of-document ;
+ string over field>> set-editor-string
+ dup field>> end-of-document ;
M: live-search focusable-child* field>> ;
[ dup synopsis >lower ] { } map>assoc sort-values ;
: <definition-search> ( string words limited? -- gadget )
- >r definition-candidates r> [ synopsis ] <live-search> ;
+ [ definition-candidates ] dip [ synopsis ] <live-search> ;
: word-candidates ( words -- candidates )
[ dup name>> >lower ] { } map>assoc ;
: <word-search> ( string words limited? -- gadget )
- >r word-candidates r> [ synopsis ] <live-search> ;
+ [ word-candidates ] dip [ synopsis ] <live-search> ;
: com-words ( workspace -- )
dup current-word all-words t <word-search>
"Word search" show-titled-popup ;
: show-vocab-words ( workspace vocab -- )
- "" over words natural-sort f <word-search>
- "Words in " rot vocab-name append show-titled-popup ;
+ [ "" swap words natural-sort f <word-search> ]
+ [ "Words in " swap vocab-name append ]
+ bi show-titled-popup ;
: show-word-usage ( workspace word -- )
- "" over smart-usage f <definition-search>
- "Words and methods using " rot name>> append
- show-titled-popup ;
+ [ "" swap smart-usage f <definition-search> ]
+ [ "Words and methods using " swap name>> append ]
+ bi show-titled-popup ;
: help-candidates ( seq -- candidates )
[ dup >link swap article-title >lower ] { } map>assoc
"Source file search" show-titled-popup ;
: show-vocab-files ( workspace vocab -- )
- "" over vocab-files <source-file-search>
- "Source files in " rot vocab-name append show-titled-popup ;
+ [ "" swap vocab-files <source-file-search> ]
+ [ "Source files in " swap vocab-name append ]
+ bi show-titled-popup ;
: vocab-candidates ( -- candidates )
all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
{ $heading "Editing commands" }
"The text editing commands are standard; see " { $link "gadgets-editors" } "."
{ $heading "Implementation" }
-"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } "), and an input area (instance of " { $link interactor } "), and a stack display kept up to date using a " { $link listener-hook } "." ;
+"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } ")." ;
ARTICLE: "ui-inspector" "UI inspector"
"The graphical inspector builds on the terminal inspector (see " { $link "inspector" } ") and provides in-place editing of slot values."
<toggle-buttons> ;
: <workspace-book> ( workspace -- gadget )
- dup
- <stack-display>
+ <gadget>
<browser-gadget>
<inspector-gadget>
<profiler-gadget>
dup <workspace-book> >>book
dup <workspace-tabs> f track-add
- dup book>> 1/5 track-add
- dup listener>> 4/5 track-add
- dup <toolbar> f track-add ;
+ dup book>> 0 track-add
+ dup listener>> 1 track-add
+ add-toolbar ;
: resize-workspace ( workspace -- )
- dup sizes>> over control-value zero? [
- 1/5 over set-second
- 4/5 swap set-third
+ dup sizes>> over control-value 0 = [
+ 0 over set-second
+ 1 swap set-third
] [
2/3 over set-second
1/3 swap set-third
[ workspace-window ] ui-hook set-global
-: com-listener ( workspace -- ) stack-display select-tool ;
+: select-tool ( workspace n -- ) swap book>> model>> set-model ;
-: com-browser ( workspace -- ) browser-gadget select-tool ;
+: com-listener ( workspace -- ) 0 select-tool ;
-: com-inspector ( workspace -- ) inspector-gadget select-tool ;
+: com-browser ( workspace -- ) 1 select-tool ;
-: com-profiler ( workspace -- ) profiler-gadget select-tool ;
+: com-inspector ( workspace -- ) 2 select-tool ;
+
+: com-profiler ( workspace -- ) 3 select-tool ;
workspace "tool-switching" f {
{ T{ key-down f { A+ } "1" } com-listener }
dup model>> <callstack-display> 2/3 track-add
- dup <toolbar> f track-add ;
+ add-toolbar ;
: <namestack-display> ( model -- gadget )
[ [ name>> namestack. ] when* ]
<pane-control> ;
: <variables-gadget> ( model -- gadget )
- <namestack-display> { 400 400 } <limited-scroller> ;
+ <namestack-display>
+ <limited-scroller>
+ { 400 400 } >>min-dim
+ { 400 400 } >>max-dim ;
: variables ( traceback -- )
model>> <variables-gadget>
swap >>status
dup continuation>> <traceback-gadget> >>traceback
- dup <toolbar> f track-add
+ add-toolbar
dup status>> self <thread-status> f track-add
- dup traceback>> 1 track-add ;
+ dup traceback>> 1 track-add ;
: walker-help ( -- ) "ui-walker" help-window ;
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: classes continuations help help.topics kernel models
- sequences ui ui.backend ui.tools.debugger ui.gadgets
- ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
- ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
- ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
- ui.commands ui.gestures assocs arrays namespaces accessors ;
-
+sequences assocs arrays namespaces accessors math.vectors ui
+ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
+ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
+ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
+ui.gadgets.presentations ui.gadgets.status-bar ui.commands
+ui.gestures ;
IN: ui.tools.workspace
TUPLE: workspace < track book listener popup ;
[ find-tool swap ] keep book>> model>>
set-model ;
-: select-tool ( workspace class -- ) swap show-tool drop ;
-
: get-workspace* ( quot -- workspace )
[ >r dup workspace? r> [ drop f ] if ] curry find-window
[ dup raise-window gadget-child ]
: get-tool ( class -- gadget )
get-workspace find-tool nip ;
+: <help-pane> ( topic -- pane )
+ <pane> [ [ help ] with-pane ] keep ;
+
: help-window ( topic -- )
[
- <pane> [ [ help ] with-pane ] keep
- { 550 700 } <limited-scroller>
- ] keep
- article-title open-window ;
+ <help-pane> <limited-scroller>
+ { 550 700 } >>max-dim
+ ] [ article-title ] bi
+ open-window ;
: hide-popup ( workspace -- )
dup popup>> track-remove
{ 600 700 } workspace-dim set-global
-M: workspace pref-dim* drop workspace-dim get ;
+M: workspace pref-dim* call-next-method workspace-dim get vmax ;
M: workspace focusable-child*
dup popup>> [ ] [ listener>> ] ?if ;
{ $description "Opens a native window containing the given world. This grafts the world by calling " { $link graft } ". Each world can only be displayed in one top-level window at a time." }
{ $notes "This word should not be called directly by user code. Instead, use " { $link open-window } "." } ;
-HELP: ui-try
-{ $values { "quot" quotation } }
-{ $description "Calls the quotation. If it throws an error, opens a window with the error and restores the data stack." }
-{ $notes "This is essentially a graphical variant of " { $link try } "." } ;
-
ARTICLE: "ui-glossary" "UI glossary"
{ $table
{ "color specifier"
ARTICLE: "ui-geometry" "Gadget geometry"
"The " { $link gadget } " class inherits from the " { $link rect } " class, and thus all gadgets have a bounding box:"
-{ $subsection rect }
-"Rectangles can be taken apart:"
-{ $subsection rect-loc }
-{ $subsection rect-dim }
-{ $subsection rect-bounds }
-{ $subsection rect-extent }
-"New rectangles can be created:"
-{ $subsection <zero-rect> }
-{ $subsection <rect> }
-{ $subsection <extent-rect> }
-"More utility words for working with rectangles:"
-{ $subsection offset-rect }
-{ $subsection rect-intersect }
-{ $subsection intersects? }
-
-! "A gadget's bounding box is always relative to its parent. "
-! { $subsection gadget-parent }
-
+{ $subsection "math.geometry.rect" }
"Word for converting from a child gadget's co-ordinate system to a parent's:"
{ $subsection relative-loc }
{ $subsection screen-loc }
--- /dev/null
+IN: ui.tests
+USING: ui tools.test ;
+
+\ event-loop must-infer
+\ open-window must-infer
: init-ui ( -- )
<dlist> \ graft-queue set-global
<dlist> \ layout-queue set-global
+ <dlist> \ gesture-queue set-global
V{ } clone windows set-global ;
: restore-gadget-later ( gadget -- )
: notify ( gadget -- )
dup graft-state>>
- dup first { f f } { t t } ?
- pick (>>graft-state) {
+ [ first { f f } { t t } ? >>graft-state ] keep
+ {
{ { f t } [ dup activate-control graft* ] }
{ { t f } [ dup deactivate-control ungraft* ] }
} case ;
: notify-queued ( -- )
graft-queue [ notify ] slurp-deque ;
+: send-queued-gestures ( -- )
+ gesture-queue [ send-queued-gesture ] slurp-deque ;
+
: update-ui ( -- )
- [ notify-queued layout-queued redraw-worlds ] assert-depth ;
+ [
+ [
+ notify-queued
+ layout-queued
+ redraw-worlds
+ send-queued-gestures
+ ] assert-depth
+ ] [ ui-error ] recover ;
: ui-wait ( -- )
10 milliseconds sleep ;
-: ui-try ( quot -- ) [ ui-error ] recover ;
-
SYMBOL: ui-thread
: ui-running ( quot -- )
\ ui-running get-global ;
: update-ui-loop ( -- )
- ui-running? ui-thread get-global self eq? and [
- ui-notify-flag get lower-flag
- [ update-ui ] ui-try
- update-ui-loop
- ] when ;
+ [ ui-running? ui-thread get-global self eq? and ]
+ [ ui-notify-flag get lower-flag update-ui ]
+ [ ] while ;
: start-ui-thread ( -- )
[ self ui-thread set-global update-ui-loop ]
ui.gestures io kernel math math.vectors namespaces make
sequences strings vectors words windows.kernel32 windows.gdi32
windows.user32 windows.opengl32 windows.messages windows.types
-windows.nt windows threads libc combinators continuations
-command-line shuffle opengl ui.render unicode.case ascii
-math.bitwise locals symbols accessors math.geometry.rect ;
+windows.nt windows threads libc combinators
+combinators.short-circuit continuations command-line shuffle
+opengl ui.render ascii math.bitwise locals symbols accessors
+math.geometry.rect math.order ascii ;
IN: ui.windows
SINGLETON: windows-ui-backend
: alt? ( -- ? ) left-alt? right-alt? or ;
: caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ;
-: switch-case ( seq -- seq )
- dup first CHAR: a >= [ >upper ] [ >lower ] if ;
-
-: switch-case? ( -- ? ) shift? caps-lock? xor not ;
-
: key-modifiers ( -- seq )
[
shift? [ S+ , ] when
: exclude-key-wm-char? ( n -- bool )
exclude-keys-wm-char key? ;
-: keystroke>gesture ( n -- mods sym ? )
- dup wm-keydown-codes at* [
- nip >r key-modifiers r> t
- ] [
- drop 1string >r key-modifiers r>
- C+ pick member? >r A+ pick member? r> or [
- shift? [ >lower ] unless f
- ] [
- switch-case? [ switch-case ] when t
- ] if
- ] if ;
+: keystroke>gesture ( n -- mods sym )
+ wm-keydown-codes at* [ key-modifiers swap ] [ drop f f ] if ;
+
+: send-key-gesture ( sym action? quot hWnd -- )
+ [ [ key-modifiers ] 3dip call ] dip
+ window-focus propagate-gesture ; inline
+
+: send-key-down ( sym action? hWnd -- )
+ [ [ <key-down> ] ] dip send-key-gesture ;
+
+: send-key-up ( sym action? hWnd -- )
+ [ [ <key-up> ] ] dip send-key-gesture ;
+
+: key-sym ( wParam -- string/f action? )
+ {
+ {
+ [ dup LETTER? ]
+ [ shift? caps-lock? xor [ CHAR: a + CHAR: A - ] unless 1string f ]
+ }
+ { [ dup digit? ] [ 1string f ] }
+ [ wm-keydown-codes at t ]
+ } cond ;
:: handle-wm-keydown ( hWnd uMsg wParam lParam -- )
wParam exclude-key-wm-keydown? [
- wParam keystroke>gesture <key-down>
- hWnd window-focus send-gesture drop
+ wParam key-sym over [
+ dup ctrl? alt? xor or [
+ hWnd send-key-down
+ ] [ 2drop ] if
+ ] [ 2drop ] if
] unless ;
:: handle-wm-char ( hWnd uMsg wParam lParam -- )
- wParam exclude-key-wm-char? ctrl? alt? xor or [
- wParam 1string
- hWnd window-focus user-input
+ wParam exclude-key-wm-char? [
+ ctrl? alt? xor [
+ wParam 1string
+ [ f hWnd send-key-down ]
+ [ hWnd window-focus user-input ] bi
+ ] unless
] unless ;
:: handle-wm-keyup ( hWnd uMsg wParam lParam -- )
- wParam keystroke>gesture <key-up>
- hWnd window-focus send-gesture drop ;
+ wParam exclude-key-wm-keydown? [
+ wParam key-sym over [
+ hWnd send-key-up
+ ] [ 2drop ] if
+ ] unless ;
:: set-window-active ( hwnd uMsg wParam lParam ? -- n )
? hwnd window (>>active?)
: message>button ( uMsg -- button down? )
{
- { [ dup WM_LBUTTONDOWN = ] [ drop 1 t ] }
- { [ dup WM_LBUTTONUP = ] [ drop 1 f ] }
- { [ dup WM_MBUTTONDOWN = ] [ drop 2 t ] }
- { [ dup WM_MBUTTONUP = ] [ drop 2 f ] }
- { [ dup WM_RBUTTONDOWN = ] [ drop 3 t ] }
- { [ dup WM_RBUTTONUP = ] [ drop 3 f ] }
-
- { [ dup WM_NCLBUTTONDOWN = ] [ drop 1 t ] }
- { [ dup WM_NCLBUTTONUP = ] [ drop 1 f ] }
- { [ dup WM_NCMBUTTONDOWN = ] [ drop 2 t ] }
- { [ dup WM_NCMBUTTONUP = ] [ drop 2 f ] }
- { [ dup WM_NCRBUTTONDOWN = ] [ drop 3 t ] }
- { [ dup WM_NCRBUTTONUP = ] [ drop 3 f ] }
- } cond ;
+ { WM_LBUTTONDOWN [ 1 t ] }
+ { WM_LBUTTONUP [ 1 f ] }
+ { WM_MBUTTONDOWN [ 2 t ] }
+ { WM_MBUTTONUP [ 2 f ] }
+ { WM_RBUTTONDOWN [ 3 t ] }
+ { WM_RBUTTONUP [ 3 f ] }
+
+ { WM_NCLBUTTONDOWN [ 1 t ] }
+ { WM_NCLBUTTONUP [ 1 f ] }
+ { WM_NCMBUTTONDOWN [ 2 t ] }
+ { WM_NCMBUTTONUP [ 2 f ] }
+ { WM_NCRBUTTONDOWN [ 3 t ] }
+ { WM_NCRBUTTONUP [ 3 f ] }
+ } case ;
! If the user clicks in the window border ("non-client area")
! Windows sends us an NC[LMR]BUTTONDOWN message; but if the
! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object )
"uint" { "void*" "uint" "long" "long" } "stdcall" [
- [
- pick
- trace-messages? get-global [ dup windows-message-name name>> print flush ] when
- wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
- ] ui-try
+ pick
+ trace-messages? get-global [ dup windows-message-name name>> print flush ] when
+ wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
] alien-callback ;
: peek-message? ( msg -- ? ) f 0 0 PM_REMOVE PeekMessage zero? ;
x11.windows io.encodings.string io.encodings.ascii
io.encodings.utf8 combinators debugger command-line qualified
math.vectors classes.tuple opengl.gl threads math.geometry.rect
-environment ;
+environment ascii ;
IN: ui.x11
SINGLETON: x11-ui-backend
: event-modifiers ( event -- seq )
XKeyEvent-state modifiers modifier ;
+: valid-input? ( string gesture -- ? )
+ over empty? [ 2drop f ] [
+ mods>> { f { S+ } } member? [
+ [ [ 127 = not ] [ CHAR: \s >= ] bi and ] all?
+ ] [
+ [ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all?
+ ] if
+ ] if ;
+
: key-down-event>gesture ( event world -- string gesture )
dupd
handle>> xic>> lookup-string
>r swap event-modifiers r> key-code <key-down> ;
M: world key-down-event
- [ key-down-event>gesture ] keep world-focus
- [ send-gesture ] keep swap [ user-input ] [ 2drop ] if ;
+ [ key-down-event>gesture ] keep
+ world-focus
+ [ propagate-gesture drop ]
+ [ 2over valid-input? [ nip user-input ] [ 3drop ] if ]
+ 3bi ;
: key-up-event>gesture ( event -- gesture )
dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
M: world key-up-event
- >r key-up-event>gesture r> world-focus send-gesture drop ;
+ >r key-up-event>gesture r> world-focus propagate-gesture ;
: mouse-event>gesture ( event -- modifiers button loc )
dup event-modifiers over XButtonEvent-button
M: x11-ui-backend do-events
wait-event dup XAnyEvent-window window dup
- [ [ 2dup handle-event ] assert-depth ] when 2drop ;
+ [ handle-event ] [ 2drop ] if ;
: x-clipboard@ ( gadget clipboard -- prop win )
atom>> swap
: SEEK_CUR 1 ; inline
: SEEK_END 2 ; inline
-: DT_UNKNOWN 0 ; inline
-: DT_FIFO 1 ; inline
-: DT_CHR 2 ; inline
-: DT_DIR 4 ; inline
-: DT_BLK 6 ; inline
-: DT_REG 8 ; inline
-: DT_LNK 10 ; inline
-: DT_SOCK 12 ; inline
-: DT_WHT 14 ; inline
-
os {
{ macosx [ "unix.bsd.macosx" require ] }
{ freebsd [ "unix.bsd.freebsd" require ] }
: S_IFIFO OCT: 010000 ; inline ! FIFO.
: S_IFLNK OCT: 120000 ; inline ! Symbolic link.
: S_IFSOCK OCT: 140000 ; inline ! Socket.
+: S_IFWHT OCT: 160000 ; inline ! Whiteout.
FUNCTION: int chmod ( char* path, mode_t mode ) ;
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader qualified accessors
stack-checker macros locals generalizations unix.types
-debugger io prettyprint ;
+debugger io prettyprint io.files ;
IN: unix
: PROT_NONE 0 ; inline
: NGROUPS_MAX 16 ; inline
+: DT_UNKNOWN 0 ; inline
+: DT_FIFO 1 ; inline
+: DT_CHR 2 ; inline
+: DT_DIR 4 ; inline
+: DT_BLK 6 ; inline
+: DT_REG 8 ; inline
+: DT_LNK 10 ; inline
+: DT_SOCK 12 ; inline
+: DT_WHT 14 ; inline
+
+: dirent-type>file-type ( ch -- type )
+ {
+ { DT_BLK [ +block-device+ ] }
+ { DT_CHR [ +character-device+ ] }
+ { DT_DIR [ +directory+ ] }
+ { DT_LNK [ +symbolic-link+ ] }
+ { DT_SOCK [ +socket+ ] }
+ { DT_FIFO [ +fifo+ ] }
+ { DT_REG [ +regular-file+ ] }
+ { DT_WHT [ +whiteout+ ] }
+ [ drop +unknown+ ]
+ } case ;
+
C-STRUCT: group
{ "char*" "gr_name" }
{ "char*" "gr_passwd" }
{ [ dup empty? ] [ drop ] }
{ [ over "/" tail? ] [ append ] }
{ [ "/" pick start not ] [ nip ] }
- [ [ "/" last-split1 drop "/" ] dip 3append ]
+ [ [ "/" split1-last drop "/" ] dip 3append ]
} cond ;
PRIVATE>
IN: values\r
\r
ARTICLE: "values" "Global values"\r
-"Usually, dynamically scoped variables are sufficient for holding data which is not literal. But occasionally, for global information that's calculated just once, it's useful to use the word mechanism instead, and set the word to the appropriate value just once. Values abstract over this concept. To create a new word as a value, use the following syntax:"\r
+"Usually, dynamically scoped variables are sufficient for holding data which is not literal. But occasionally, for global information that's calculated just once, it's useful to use the word mechanism instead, and set the word to the appropriate value just once. The " { $vocab-link "values" } " vocabulary implements " { $emphasis "values" } ", which abstract over this concept. To create a new word as a value, use the following syntax:"\r
{ $subsection POSTPONE: VALUE: }\r
"To get the value, just call the word. The following words manipulate values:"\r
{ $subsection get-value }\r
{ $subsection POSTPONE: to: }\r
{ $subsection change-value } ;\r
\r
+ABOUT: "values"\r
+\r
HELP: VALUE:\r
{ $syntax "VALUE: word" }\r
{ $values { "word" "a word to be created" } }\r
$ECHO "***Factor will compile NO_UI=1"
NO_UI=1
fi
- rm -f $GCC_TEST
- check_ret rm
- rm -f $GCC_OUT
- check_ret rm
+ $DELETE -f $GCC_TEST
+ check_ret $DELETE
+ $DELETE -f $GCC_OUT
+ check_ret $DELETE
$ECHO "found."
}
gcc -o $C_WORD $C_WORD.c
WORD=$(./$C_WORD)
check_ret $C_WORD
- rm -f $C_WORD*
+ $DELETE -f $C_WORD*
}
intel_macosx_word_size() {
set_factor_binary() {
case $OS in
- # winnt) FACTOR_BINARY=factor-nt;;
- # macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;;
+ winnt) FACTOR_BINARY=factor.exe;;
*) FACTOR_BINARY=factor;;
esac
}
+set_factor_library() {
+ case $OS in
+ winnt) FACTOR_LIBRARY=factor.dll;;
+ macosx) FACTOR_LIBRARY=libfactor.dylib;;
+ *) FACTOR_LIBRARY=libfactor.a;;
+ esac
+}
+
+set_factor_image() {
+ FACTOR_IMAGE=factor.image
+}
+
echo_build_info() {
$ECHO OS=$OS
$ECHO ARCH=$ARCH
$ECHO WORD=$WORD
$ECHO FACTOR_BINARY=$FACTOR_BINARY
+ $ECHO FACTOR_LIBRARY=$FACTOR_LIBRARY
+ $ECHO FACTOR_IMAGE=$FACTOR_IMAGE
$ECHO MAKE_TARGET=$MAKE_TARGET
$ECHO BOOT_IMAGE=$BOOT_IMAGE
$ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
$ECHO DOWNLOADER=$DOWNLOADER
$ECHO CC=$CC
$ECHO MAKE=$MAKE
+ $ECHO COPY=$COPY
+ $ECHO DELETE=$DELETE
}
check_os_arch_word() {
find_architecture
find_word_size
set_factor_binary
+ set_factor_library
+ set_factor_image
set_build_info
set_downloader
set_gcc
check_ret cd
}
+set_copy() {
+ case $OS in
+ winnt) COPY=cp;;
+ *) COPY=cp;;
+ esac
+}
+
+set_delete() {
+ case $OS in
+ winnt) DELETE=rm;;
+ *) DELETE=rm;;
+ esac
+}
+
+backup_factor() {
+ $ECHO "Backing up factor..."
+ $COPY $FACTOR_BINARY $FACTOR_BINARY.bak
+ $COPY $FACTOR_LIBRARY $FACTOR_LIBRARY.bak
+ $COPY $BOOT_IMAGE $BOOT_IMAGE.bak
+ $COPY $FACTOR_IMAGE $FACTOR_IMAGE.bak
+ $ECHO "Done with backup."
+}
+
check_makefile_exists() {
if [[ ! -e "Makefile" ]] ; then
echo ""
update_boot_images() {
echo "Deleting old images..."
- rm checksums.txt* > /dev/null 2>&1
- rm $BOOT_IMAGE.* > /dev/null 2>&1
- rm temp/staging.*.image > /dev/null 2>&1
+ $DELETE checksums.txt* > /dev/null 2>&1
+ # delete boot images with one or two characters after the dot
+ $DELETE $BOOT_IMAGE.{?,??} > /dev/null 2>&1
+ $DELETE temp/staging.*.image > /dev/null 2>&1
if [[ -f $BOOT_IMAGE ]] ; then
get_url http://factorcode.org/images/latest/checksums.txt
factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '`;
if [[ "$factorcode_md5" == "$disk_md5" ]] ; then
echo "Your disk boot image matches the one on factorcode.org."
else
- rm $BOOT_IMAGE > /dev/null 2>&1
+ $DELETE $BOOT_IMAGE > /dev/null 2>&1
get_boot_image;
fi
else
update() {
get_config_info
git_pull_factorcode
+ backup_factor
make_clean
make_factor
}
}
refresh_image() {
- ./$FACTOR_BINARY -script -e="USE: vocabs.loader refresh-all USE: memory save 0 USE: system exit"
+ ./$FACTOR_BINARY -script -e="USE: vocabs.loader USE: system refresh-all USE: memory save 0 exit"
check_ret factor
}
make_boot_image() {
- ./$FACTOR_BINARY -script -e="\"$MAKE_IMAGE_TARGET\" USE: bootstrap.image make-image save 0 USE: system exit"
+ ./$FACTOR_BINARY -script -e="\"$MAKE_IMAGE_TARGET\" USE: system USE: bootstrap.image make-image save 0 exit"
check_ret factor
}
parse_build_info $2
fi
+set_copy
+set_delete
+
case "$1" in
install) install ;;
install-x11) install_build_system_apt; install ;;
M: array clone (clone) ;
M: array length length>> ;
-M: array nth-unsafe >r >fixnum r> array-nth ;
-M: array set-nth-unsafe >r >fixnum r> set-array-nth ;
+M: array nth-unsafe [ >fixnum ] dip array-nth ;
+M: array set-nth-unsafe [ >fixnum ] dip set-array-nth ;
M: array resize resize-array ;
: >array ( seq -- array ) { } clone-like ;
GENERIC: >alist ( assoc -- newassoc )
: (assoc-each) ( assoc quot -- seq quot' )
- >r >alist r> [ first2 ] prepose ; inline
+ [ >alist ] dip [ first2 ] prepose ; inline
: assoc-find ( assoc quot -- key value ? )
(assoc-each) find swap [ first2 t ] [ drop f f f ] if ; inline
(assoc-each) each ; inline
: assoc>map ( assoc quot exemplar -- seq )
- >r accumulator >r assoc-each r> r> like ; inline
+ [ accumulator [ assoc-each ] dip ] dip like ; inline
: assoc-map-as ( assoc quot exemplar -- newassoc )
- >r [ 2array ] compose V{ } assoc>map r> assoc-like ; inline
+ [ [ 2array ] compose V{ } assoc>map ] dip assoc-like ; inline
: assoc-map ( assoc quot -- newassoc )
over assoc-map-as ; inline
: assoc-push-if ( key value quot accum -- )
- >r 2keep r> roll
- [ >r 2array r> push ] [ 3drop ] if ; inline
+ [ 2keep rot ] dip swap
+ [ [ 2array ] dip push ] [ 3drop ] if ; inline
: assoc-pusher ( quot -- quot' accum )
V{ } clone [ [ assoc-push-if ] 2curry ] keep ; inline
+: assoc-filter-as ( assoc quot exemplar -- subassoc )
+ [ assoc-pusher [ assoc-each ] dip ] dip assoc-like ; inline
+
: assoc-filter ( assoc quot -- subassoc )
- over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline
+ over assoc-filter-as ; inline
: assoc-contains? ( assoc quot -- ? )
assoc-find 2nip ; inline
3drop f
] [
3dup nth-unsafe at*
- [ >r 3drop r> ] [ drop >r 1- r> (assoc-stack) ] if
+ [ [ 3drop ] dip ] [ drop [ 1- ] dip (assoc-stack) ] if
] if ; inline recursive
: assoc-stack ( key seq -- value )
: assoc-hashcode ( n assoc -- code )
[
- >r over r> hashcode* 2/ >r dupd hashcode* r> bitxor
+ [ over ] dip hashcode* 2/ [ dupd hashcode* ] dip bitxor
] { } assoc>map hashcode* ;
: assoc-intersect ( assoc1 assoc2 -- intersection )
: cache ( key assoc quot -- value )
2over at* [
- >r 3drop r>
+ [ 3drop ] dip
] [
- drop pick rot >r >r call dup r> r> set-at
+ drop pick rot [ call dup ] 2dip set-at
] if ; inline
: change-at ( key assoc quot -- )
- [ >r at r> call ] 3keep drop set-at ; inline
+ [ [ at ] dip call ] 3keep drop set-at ; inline
: at+ ( n key assoc -- )
[ 0 or + ] change-at ;
: map>assoc ( seq quot exemplar -- assoc )
- >r [ 2array ] compose { } map-as r> assoc-like ; inline
+ [ [ 2array ] compose { } map-as ] dip assoc-like ; inline
: extract-keys ( seq assoc -- subassoc )
[ [ dupd at ] curry ] keep map>assoc ;
M: sequence set-at
2dup search-alist
[ 2nip set-second ]
- [ drop >r swap 2array r> push ] if ;
+ [ drop [ swap 2array ] dip push ] if ;
M: sequence new-assoc drop <vector> ;
M: sequence assoc-size length ;
M: sequence assoc-clone-like
- >r >alist r> clone-like ;
+ [ >alist ] dip clone-like ;
M: sequence assoc-like
- >r >alist r> like ;
+ [ >alist ] dip like ;
M: sequence >alist ;
[ "slots" set-word-prop ] [ define-accessors ] 2bi ;
: define-builtin ( symbol slotspec -- )
- >r [ define-builtin-predicate ] keep
- r> define-builtin-slots ;
+ [ [ define-builtin-predicate ] keep ] dip define-builtin-slots ;
"fixnum" "math" create register-builtin
"bignum" "math" create register-builtin
[ f "inline" set-word-prop ]
[ make-flushable ]
[ ]
- [ tuple-layout [ <tuple-boa> ] curry ]
+ [
+ [
+ callable instance-check-quot %
+ tuple-layout ,
+ \ <tuple-boa> ,
+ ] [ ] make
+ ]
} cleave
(( obj quot -- curry )) define-declared
[ f "inline" set-word-prop ]
[ make-flushable ]
[ ]
- [ tuple-layout [ <tuple-boa> ] curry ]
+ [
+ [
+ callable instance-check-quot [ dip ] curry %
+ callable instance-check-quot %
+ tuple-layout ,
+ \ <tuple-boa> ,
+ ] [ ] make
+ ]
} cleave
(( quot1 quot2 -- compose )) define-declared
{ "fixnum-bitnot" "math.private" }
{ "fixnum-mod" "math.private" }
{ "fixnum-shift-fast" "math.private" }
+ { "fixnum/i-fast" "math.private" }
+ { "fixnum/mod-fast" "math.private" }
{ "fixnum<" "math.private" }
{ "fixnum<=" "math.private" }
{ "fixnum>" "math.private" }
! Primitive words
: make-primitive ( word vocab n -- )
- >r create dup reset-word r>
+ [ create dup reset-word ] dip
[ do-primitive ] curry [ ] like define ;
{
{ "unimplemented" "kernel.private" }
{ "gc-reset" "memory" }
}
-[ >r first2 r> make-primitive ] each-index
+[ [ first2 ] dip make-primitive ] each-index
! Bump build number
"build" "kernel" create build 1+ 1quotation define
GENERIC: checksum-lines ( lines checksum -- value )
-M: checksum checksum-bytes >r binary <byte-reader> r> checksum-stream ;
+M: checksum checksum-bytes
+ [ binary <byte-reader> ] dip checksum-stream ;
-M: checksum checksum-stream >r contents r> checksum-bytes ;
+M: checksum checksum-stream
+ [ contents ] dip checksum-bytes ;
-M: checksum checksum-lines >r B{ CHAR: \n } join r> checksum-bytes ;
+M: checksum checksum-lines
+ [ B{ CHAR: \n } join ] dip checksum-bytes ;
: checksum-file ( path checksum -- value )
- >r binary <file-reader> r> checksum-stream ;
+ [ binary <file-reader> ] dip checksum-stream ;
: hex-string ( seq -- str )
[ >hex 2 CHAR: 0 pad-left ] { } map-as concat ;
256 [
8 [
- dup even? >r 2/ r> [ crc32-polynomial bitxor ] unless
+ [ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless
] times >bignum
] map 0 crc32-table copy
INSTANCE: crc32 checksum
-: init-crc32 drop >r HEX: ffffffff dup r> ; inline
+: init-crc32 drop [ HEX: ffffffff dup ] dip ; inline
: finish-crc32 bitxor 4 >be ; inline
\ flatten-class must-infer\r
\ flatten-builtin-class must-infer\r
\r
-: class-and* ( cls1 cls2 cls3 -- ? ) >r class-and r> class= ;\r
+: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;\r
\r
-: class-or* ( cls1 cls2 cls3 -- ? ) >r class-or r> class= ;\r
+: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;\r
\r
[ t ] [ object object object class-and* ] unit-test\r
[ t ] [ fixnum object fixnum class-and* ] unit-test\r
20 [ random-boolean-op ] [ ] replicate-as dup .\r
[ infer in>> [ random-boolean ] replicate dup . ] keep\r
\r
- [ >r [ ] each r> call ] 2keep\r
+ [ [ [ ] each ] dip call ] 2keep\r
\r
- >r [ boolean>class ] each r> [ boolean-op>class-op ] map call object class=\r
+ [ [ boolean>class ] each ] dip [ boolean-op>class-op ] map call object class=\r
\r
=\r
] unit-test\r
C: <anonymous-complement> anonymous-complement\r
\r
: 2cache ( key1 key2 assoc quot -- value )\r
- >r >r 2array r> [ first2 ] r> compose cache ; inline\r
+ [ 2array ] 2dip [ first2 ] prepose cache ; inline\r
\r
GENERIC: valid-class? ( obj -- ? )\r
\r
swap superclass dup [ swap class<= ] [ 2drop f ] if ;\r
\r
: left-anonymous-union<= ( first second -- ? )\r
- >r members>> r> [ class<= ] curry all? ;\r
+ [ members>> ] dip [ class<= ] curry all? ;\r
\r
: right-anonymous-union<= ( first second -- ? )\r
members>> [ class<= ] with contains? ;\r
\r
: left-anonymous-intersection<= ( first second -- ? )\r
- >r participants>> r> [ class<= ] curry contains? ;\r
+ [ participants>> ] dip [ class<= ] curry contains? ;\r
\r
: right-anonymous-intersection<= ( first second -- ? )\r
participants>> [ class<= ] with all? ;\r
} cond ;\r
\r
: left-anonymous-complement<= ( first second -- ? )\r
- >r normalize-complement r> class<= ;\r
+ [ normalize-complement ] dip class<= ;\r
\r
PREDICATE: nontrivial-anonymous-complement < anonymous-complement\r
class>> {\r
: sort-classes ( seq -- newseq )\r
[ [ name>> ] compare ] sort >vector\r
[ dup empty? not ]\r
- [ dup largest-class >r over delete-nth r> ]\r
+ [ dup largest-class [ over delete-nth ] dip ]\r
[ ] produce nip ;\r
\r
: min-class ( class seq -- class/f )\r
[ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
: accessor-exists? ( class name -- ? )
- >r "forget-accessors-test" "classes.tuple.tests" lookup r>
+ [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip
">>" append "accessors" lookup method >boolean ;
[ t ] [ "x" accessor-exists? ] unit-test
: tuple>array ( tuple -- array )
prepare-tuple>array
- >r copy-tuple-slots r>
+ [ copy-tuple-slots ] dip
first prefix ;
: tuple-slots ( tuple -- seq )
[
\ dup ,
[ "predicate" word-prop % ]
- [ [ bad-slot-value ] curry , ] bi
+ [ [ literalize , \ bad-slot-value , ] [ ] make , ] bi
\ unless ,
] [ ] make ;
: update-slot ( old-values n class initial -- value )
pick [
- >r >r swap nth dup r> instance? r> swap
+ [ [ swap nth dup ] dip instance? ] dip swap
[ drop ] [ nip ] if
- ] [ >r 3drop r> ] if ;
+ ] [ [ 3drop ] dip ] if ;
: apply-slot-permutation ( old-values triples -- new-values )
[ first3 update-slot ] with map ;
class-usages [ tuple-class? ] filter ;
: each-subclass ( class quot -- )
- >r subclasses r> each ; inline
+ [ subclasses ] dip each ; inline
: redefine-tuple-class ( class superclass slots -- )
[
M: tuple hashcode*
[
[ class hashcode ] [ tuple-size ] [ ] tri
- >r rot r> [
+ [ rot ] dip [
swapd array-nth hashcode* sequence-hashcode-step
] 2curry each
] recursive-hashcode ;
{ $code
"! Equivalent"
"{ [ p ] [ q ] [ r ] [ s ] } spread"
- ">r >r >r p r> q r> r r> s"
+ "[ [ [ p ] dip q ] dip r ] dip s"
}
} ;
! spread
: spread>quot ( seq -- quot )
- [ ] [
- [ dup empty? [ [ >r ] swap [ r> ] 3append ] unless ] dip
- append
- ] reduce ;
+ [ ] [ [ dup empty? [ [ dip ] curry ] unless ] dip append ] reduce ;
: spread ( objs... seq -- )
spread>quot call ;
drop [ swap adjoin ] curry each
] [
[
- >r 2dup r> hashcode pick length rem rot nth adjoin
+ [ 2dup ] dip hashcode pick length rem rot nth adjoin
] each 2drop
] if ;
next-power-of-2 swap [ nip clone ] curry map ;
: distribute-buckets ( alist initial quot -- buckets )
- swapd [ >r dup first r> call 2array ] curry map
+ swapd [ [ dup first ] dip call 2array ] curry map
[ length <buckets> dup ] keep
[ first2 (distribute-buckets) ] with each ; inline
: hash-case-table ( default assoc -- array )
V{ } [ 1array ] distribute-buckets
- [ [ >r literalize r> ] assoc-map linear-case-quot ] with map ;
+ [ [ [ literalize ] dip ] assoc-map linear-case-quot ] with map ;
: hash-dispatch-quot ( table -- quot )
[ length 1- [ fixnum-bitand ] curry ] keep
{ [ dup [ length 4 <= ] [ [ word? ] contains? ] bi or ] [ drop linear-case-quot ] }
{ [ dup contiguous-range? ] [ drop dispatch-case-quot ] }
{ [ dup [ wrapper? ] contains? not ] [ drop hash-case-quot ] }
- { [ dup [ wrapper? ] all? ] [ drop [ >r wrapped>> r> ] assoc-map hash-case-quot ] }
+ { [ dup [ wrapper? ] all? ] [ drop [ [ wrapped>> ] dip ] assoc-map hash-case-quot ] }
[ drop linear-case-quot ]
} cond ;
! assert-depth
: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
- 2dup [ length ] bi@ min tuck tail >r tail r> ;
+ 2dup [ length ] bi@ min tuck [ tail ] 2bi@ ;
ERROR: relative-underflow stack ;
ERROR: relative-overflow stack ;
: assert-depth ( quot -- )
- >r datastack r> dip >r datastack r>
+ [ datastack ] dip dip [ datastack ] dip
2dup [ length ] compare {
{ +lt+ [ trim-datastacks nip relative-underflow ] }
{ +eq+ [ 2drop ] }
: errors-of-type ( type -- assoc )
compiler-errors get-global
- swap [ >r nip compiler-error-type r> eq? ] curry
+ swap [ [ nip compiler-error-type ] dip eq? ] curry
assoc-filter ;
: compiler-errors. ( type -- )
#! ( value f r:capture r:restore )
#! Execution begins right after the call to 'continuation'.
#! The 'restore' branch is taken.
- >r >r dummy-1 continuation r> r> [ dummy-2 ] prepose ?if ; inline
+ [ dummy-1 continuation ] 2dip [ dummy-2 ] prepose ?if ; inline
: callcc0 ( quot -- ) [ drop ] ifcc ; inline
set-catchstack
set-namestack
set-retainstack
- >r set-datastack r>
+ [ set-datastack ] dip
set-callstack ;
: (continue-with) ( obj continuation -- )
set-catchstack
set-namestack
set-retainstack
- >r set-datastack drop 4 getenv f 4 setenv f r>
+ [ set-datastack drop 4 getenv f 4 setenv f ] dip
set-callstack ;
PRIVATE>
c> continue-with ;
: recover ( try recovery -- )
- >r [ swap >c call c> drop ] curry r> ifcc ; inline
+ [ [ swap >c call c> drop ] curry ] dip ifcc ; inline
: ignore-errors ( quot -- )
[ drop ] recover ; inline
: cleanup ( try cleanup-always cleanup-error -- )
- over >r compose [ dip rethrow ] curry
- recover r> call ; inline
+ [ compose [ dip rethrow ] curry recover ] [ drop ] 2bi call ; inline
ERROR: attempt-all-error ;
{ sort-classes order } related-words
HELP: (call-next-method)
-{ $values { "class" class } { "generic" generic } }
+{ $values { "method" method-body } }
{ $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." }
{ $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ;
GENERIC: next-method-quot* ( class generic combination -- quot )
-: next-method-quot ( class generic -- quot )
+: next-method-quot ( method -- quot )
next-method-quot-cache get [
- dup "combination" word-prop next-method-quot*
- ] 2cache ;
+ [ "method-class" word-prop ]
+ [
+ "method-generic" word-prop
+ dup "combination" word-prop
+ ] bi next-method-quot*
+ ] cache ;
-: (call-next-method) ( class generic -- )
+: (call-next-method) ( method -- )
next-method-quot call ;
TUPLE: check-method class generic ;
: math-upgrade ( class1 class2 -- quot )
[ math-class-max ] 2keep
- >r over r> (math-upgrade) >r (math-upgrade)
- dup empty? [ [ dip ] curry [ ] like ] unless
- r> append ;
+ [ over ] dip (math-upgrade) [
+ (math-upgrade)
+ dup empty? [ [ dip ] curry [ ] like ] unless
+ ] dip append ;
ERROR: no-math-method left right generic ;
: math-method ( word class1 class2 -- quot )
2dup and [
- 2dup math-upgrade >r
- math-class-max over order min-class applicable-method
- r> prepend
+ 2dup math-upgrade
+ [ math-class-max over order min-class applicable-method ] dip
+ prepend
] [
2drop object-method
] if ;
dup
\ over [
dup math-class? [
- \ dup [ >r 2dup r> math-method ] math-vtable
+ \ dup [ [ 2dup ] dip math-method ] math-vtable
] [
over object-method
] if nip
: CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ;
-SYMBOL: current-class
-SYMBOL: current-generic
-
-: with-method-definition ( quot -- parsed )
- [
- [
- [ "method-class" word-prop current-class set ]
- [ "method-generic" word-prop current-generic set ]
- [ ] tri
- ] dip call
- ] with-scope ; inline
+SYMBOL: current-method
+
+: with-method-definition ( method quot -- )
+ [ dup current-method ] dip with-variable ; inline
: (M:) ( method def -- )
CREATE-METHOD [ parse-definition ] with-method-definition ;
[ over assumed [ engine>quot ] with-variable ] assoc-map ;
: if-small? ( assoc true false -- )
- >r >r dup assoc-size 4 <= r> r> if ; inline
+ [ dup assoc-size 4 <= ] 2dip if ; inline
: linear-dispatch-quot ( alist -- quot )
default get [ drop ] prepend swap
{ 0 [ [ dup ] ] }
{ 1 [ [ over ] ] }
{ 2 [ [ pick ] ] }
- [ 1- (picker) [ >r ] swap [ r> swap ] 3append ]
+ [ 1- (picker) [ dip swap ] curry ]
} case ;
: picker ( -- quot ) \ (dispatch#) get (picker) ;
C: <predicate-dispatch-engine> predicate-dispatch-engine
: class-predicates ( assoc -- assoc )
- [ >r "predicate" word-prop picker prepend r> ] assoc-map ;
+ [ [ "predicate" word-prop picker prepend ] dip ] assoc-map ;
: keep-going? ( assoc -- ? )
assumed get swap second first class<= ;
M: lo-tag-dispatch-engine engine>quot
methods>> engines>quots*
- [ >r lo-tag-number r> ] assoc-map
+ [ [ lo-tag-number ] dip ] assoc-map
[
picker % [ tag ] % [
sort-tags linear-dispatch-quot
M: hi-tag-dispatch-engine engine>quot
methods>> engines>quots*
- [ >r hi-tag-number r> ] assoc-map
+ [ [ hi-tag-number ] dip ] assoc-map
[
picker % hi-tag-quot % [
sort-tags linear-dispatch-quot
] [
num-tags get , \ fixnum-fast ,
- [ >r num-tags get - r> ] assoc-map
+ [ [ num-tags get - ] dip ] assoc-map
num-hi-tags direct-dispatch-quot
] if-small? %
] [ ] make ;
] change-at ;
: flatten-method ( class method assoc -- )
- >r >r dup flatten-class keys swap r> r> [
- >r spin r> push-method
+ [ dup flatten-class keys swap ] 2dip [
+ [ spin ] dip push-method
] 3curry each ;
: flatten-methods ( assoc -- assoc' )
T{ standard-combination f 0 } define-generic ;
: with-standard ( combination quot -- quot' )
- >r #>> (dispatch#) r> with-variable ; inline
+ [ #>> (dispatch#) ] dip with-variable ; inline
M: standard-generic extra-values drop 0 ;
growable-check
2dup length >= [
2dup capacity >= [ over new-size over expand ] when
- >r >fixnum r>
+ [ >fixnum ] dip
over 1 fixnum+fast over (>>length)
] [
- >r >fixnum r>
+ [ >fixnum ] dip
] if ; inline
M: growable set-nth ensure set-nth-unsafe ;
[ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
H{ { 1 2 } { 3 4 } { 5 6 } }
- [ >r neg r> sq ] assoc-map
+ [ [ neg ] dip sq ] assoc-map
] unit-test
! Bug discovered by littledan
length>> 1 fixnum-fast fixnum-bitand ; inline
: hash@ ( key array -- i )
- >r hashcode >fixnum dup fixnum+fast r> wrap ; inline
+ [ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline
: probe ( array i -- array i )
2 fixnum+fast over wrap ; inline
M: hashtable delete-at ( key hash -- )
tuck key@ [
- >r >r ((tombstone)) dup r> r> set-nth-pair
+ [ ((tombstone)) dup ] 2dip set-nth-pair
hash-deleted+
] [
3drop
[ count>> ] [ deleted>> ] bi - ;
: rehash ( hash -- )
- dup >alist >r
+ dup >alist [
dup clear-assoc
- r> (rehash) ;
+ ] dip (rehash) ;
M: hashtable set-at ( value key hash -- )
dup ?grow-hash
: push-unsafe ( elt seq -- )
[ length ] keep
[ underlying>> set-array-nth ]
- [ >r 1+ r> (>>length) ]
+ [ [ 1+ ] dip (>>length) ]
2bi ; inline
PRIVATE>
M: hashtable >alist
[ array>> [ length 2/ ] keep ] [ assoc-size <vector> ] bi [
[
- >r
- >r 1 fixnum-shift-fast r>
- [ array-nth ] [ >r 1 fixnum+fast r> array-nth ] 2bi r>
+ [
+ [ 1 fixnum-shift-fast ] dip
+ [ array-nth ] [ [ 1 fixnum+fast ] dip array-nth ] 2bi
+ ] dip
pick tombstone? [ 3drop ] [ [ 2array ] dip push-unsafe ] if
] 2curry each
] keep { } like ;
: ((read-until)) ( buf quot: ( -- char stop? ) -- string/f sep/f )
dup call
- [ >r drop "" like r> ]
+ [ [ drop "" like ] dip ]
[ pick push ((read-until)) ] if ; inline recursive
: (read-until) ( quot -- string/f sep/f )
<file-reader> lines ;
: with-file-reader ( path encoding quot -- )
- >r <file-reader> r> with-input-stream ; inline
+ [ <file-reader> ] dip with-input-stream ; inline
: file-contents ( path encoding -- str )
<file-reader> contents ;
: with-file-writer ( path encoding quot -- )
- >r <file-writer> r> with-output-stream ; inline
+ [ <file-writer> ] dip with-output-stream ; inline
: set-file-lines ( seq path encoding -- )
[ [ print ] each ] with-file-writer ;
[ write ] with-file-writer ;
: with-file-appender ( path encoding quot -- )
- >r <file-appender> r> with-output-stream ; inline
+ [ <file-appender> ] dip with-output-stream ; inline
! Pathnames
: path-separator? ( ch -- ? ) os windows? "/\\" "/" ? member? ;
{ [ dup head.? ] [ rest trim-left-separators append-path ] }
{ [ dup head..? ] [
2 tail trim-left-separators
- >r parent-directory r> append-path
+ [ parent-directory ] dip append-path
] }
{ [ over absolute-path? over first path-separator? and ] [
- >r 2 head r> append
+ [ 2 head ] dip append
] }
[
- >r trim-right-separators "/" r>
+ [ trim-right-separators "/" ] dip
trim-left-separators 3append
]
} cond ;
] unless ;
: file-extension ( filename -- extension )
- "." last-split1 nip ;
+ "." split1-last nip ;
! File info
TUPLE: file-info type size permissions created modified
HOOK: read-link io-backend ( symlink -- path )
: copy-link ( target symlink -- )
- >r read-link r> make-link ;
+ [ read-link ] dip make-link ;
SYMBOL: +regular-file+
SYMBOL: +directory+
SYMBOL: +block-device+
SYMBOL: +fifo+
SYMBOL: +socket+
+SYMBOL: +whiteout+
SYMBOL: +unknown+
! File metadata
(normalize-path) current-directory set ;
: with-directory ( path quot -- )
- >r (normalize-path) current-directory r> with-variable ; inline
+ [ (normalize-path) current-directory ] dip with-variable ; inline
! Creating directories
HOOK: make-directory io-backend ( path -- )
[ ] cleanup ; inline
: tabular-output ( style quot -- )
- swap >r { } make r> output-stream get stream-write-table ; inline
+ swap [ { } make ] dip output-stream get stream-write-table ; inline
: with-row ( quot -- )
{ } make , ; inline
] if ; inline
: with-nesting ( style quot -- )
- >r output-stream get make-block-stream
- r> with-output-stream ; inline
+ [ output-stream get make-block-stream ] dip
+ with-output-stream ; inline
: print ( string -- ) output-stream get stream-print ;
512 <byte-vector> swap <encoder> ;
: with-byte-writer ( encoding quot -- byte-array )
- >r <byte-writer> r> [ output-stream get ] compose with-output-stream*
+ [ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
dup encoder? [ stream>> ] when >byte-array ; inline
: <byte-reader> ( byte-array encoding -- stream )
- >r >byte-vector dup reverse-here r> <decoder> ;
+ [ >byte-vector dup reverse-here ] dip <decoder> ;
: with-byte-reader ( byte-array encoding quot -- )
- >r <byte-reader> r> with-input-stream* ; inline
+ [ <byte-reader> ] dip with-input-stream* ; inline
#! print stuff from contexts where the I/O system would
#! otherwise not work (tools.deploy.shaker, the I/O
#! multiplexer thread).
- "\r\n" append >byte-array
+ "\n" append >byte-array
stdout-handle fwrite
stdout-handle fflush ;
[ style>> ] [ stream>> ] bi stream-format ;
M: style-stream stream-write1
- >r 1string r> stream-write ;
+ [ 1string ] dip stream-write ;
M: style-stream make-span-stream
do-nested-style make-span-stream ;
] unless ;
: map-last ( seq quot -- seq )
- >r dup length <reversed> [ zero? ] r> compose 2map ; inline
+ [ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
PRIVATE>
>sbuf dup reverse-here null-encoding <decoder> ;
: with-string-reader ( str quot -- )
- >r <string-reader> r> with-input-stream ; inline
+ [ <string-reader> ] dip with-input-stream ; inline
INSTANCE: growable plain-writer
HELP: roll $shuffle ;
HELP: -roll $shuffle ;
-HELP: >r ( x -- )
-{ $values { "x" object } } { $description "Moves the top of the data stack to the retain stack." } ;
-
-HELP: r> ( -- x )
-{ $values { "x" object } } { $description "Moves the top of the retain stack to the data stack." } ;
-
HELP: datastack ( -- ds )
{ $values { "ds" array } }
{ $description "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
HELP: keep
{ $values { "quot" { $quotation "( x -- )" } } { "x" object } }
-{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." } ;
+{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }
+{ $examples
+ { $example "USING: arrays kernel prettyprint ;" "2 \"greetings\" [ <array> ] keep 2array ." "{ { \"greetings\" \"greetings\" } \"greetings\" }" }
+} ;
HELP: 2keep
{ $values { "quot" { $quotation "( x y -- )" } } { "x" object } { "y" object } }
"The following two lines are equivalent:"
{ $code
"[ p ] [ q ] bi*"
- ">r p r> q"
+ "[ p ] dip q"
}
} ;
"The following two lines are equivalent:"
{ $code
"[ p ] [ q ] 2bi*"
- ">r >r p r> r> q"
+ "[ p ] 2dip q"
}
} ;
"The following two lines are equivalent:"
{ $code
"[ p ] [ q ] [ r ] tri*"
- ">r >r p r> q r> r"
+ "[ [ p ] dip q ] dip r"
}
} ;
"The following two lines are equivalent:"
{ $code
"[ p ] bi@"
- ">r p r> p"
+ "[ p ] dip p"
}
"The following two lines are also equivalent:"
{ $code
"The following two lines are equivalent:"
{ $code
"[ p ] 2bi@"
- ">r >r p r> r> p"
+ "[ p ] 2dip p"
}
"The following two lines are also equivalent:"
{ $code
"The following two lines are equivalent:"
{ $code
"[ p ] tri@"
- ">r >r p r> p r> p"
+ "[ [ p ] dip p ] dip p"
}
"The following two lines are also equivalent:"
{ $code
{ $values { "quot1" callable } { "quot2" callable } { "compose" compose } }
{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } " followed by " { $snippet "quot2" } "." }
{ $notes
- "The two quotations must leave the retain stack in the same state on exit as it was on entry, so the following code is not allowed:"
- { $code
- "[ 3 >r ] [ r> . ] compose"
- }
- "Except for this restriction, the following two lines are equivalent:"
+ "The following two lines are equivalent:"
{ $code
"compose call"
"append call"
{ $values { "quot1" callable } { "quot2" callable } { "quot3" callable } { "compose" compose } }
{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } ", " { $snippet "quot2" } " and then " { $snippet "quot3" } "." }
{ $notes
- "The three quotations must leave the retain stack in the same state on exit as it was on entry, so for example, the following code is not allowed:"
- { $code
- "[ >r ] swap [ r> ] 3compose"
- }
- "The correct way to achieve the effect of the above is the following:"
- { $code
- "[ dip ] curry"
- }
- "Excepting the retain stack restriction, the following two lines are equivalent:"
+ "The following two lines are equivalent:"
{ $code
"3compose call"
"3append call"
HELP: dip
{ $values { "x" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
-{ $notes "The following are equivalent:"
- { $code ">r foo bar r>" }
- { $code "[ foo bar ] dip" }
+{ $examples
+ { $example "USING: arrays kernel math prettyprint ;" "10 20 30 [ / ] dip 2array ." "{ 1/2 30 }" }
} ;
HELP: 2dip
{ $values { "x" object } { "y" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } " and " { $snippet "obj2" } " hidden on the retain stack." }
{ $notes "The following are equivalent:"
- { $code ">r >r foo bar r> r>" }
+ { $code "[ [ foo bar ] dip ] dip" }
{ $code "[ foo bar ] 2dip" }
} ;
{ $values { "x" object } { "y" object } { "z" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } " hidden on the retain stack." }
{ $notes "The following are equivalent:"
- { $code ">r >r >r foo bar r> r> r>" }
+ { $code "[ [ [ foo bar ] dip ] dip ] dip" }
{ $code "[ foo bar ] 3dip" }
} ;
{ $subsection -rot }
{ $subsection spin }
{ $subsection roll }
-{ $subsection -roll }
-"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using the following two words:"
-{ $subsection >r }
-{ $subsection r> }
-"The top of the data stack is ``hidden'' between " { $link >r } " and " { $link r> } ":"
-{ $example "1 2 3 >r .s r>" "1\n2" }
-"Usages of " { $link >r } " and " { $link r> } " must be balanced within a single quotation; quotations are not permitted to pop retain stack elements they did not push, or leave elements on the retain stack after returning."
-$nl
-"The " { $link "inference" } " tool checks retain stack usage. The " { $link "slip-keep-combinators" } " combinators abstract out common retain stack usage patterns." ;
+{ $subsection -roll } ;
ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators"
"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "."
{ $subsection tri* }
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
{ $code
- "! First alternative; uses retain stack explicitly"
- ">r >r 1 +"
- "r> 1 -"
- "r> 2 *"
+ "! First alternative; uses dip"
+ "[ [ 1 + ] dip 1 - dip ] 2 *"
"! Second alternative: uses tri*"
- "[ 1 + ]"
- "[ 1 - ]"
- "[ 2 * ] tri*"
+ "[ 1 + ] [ 1 - ] [ 2 * ] tri*"
}
$nl
{ $subsection both? }
{ $subsection either? } ;
-ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators"
+ARTICLE: "slip-keep-combinators" "Retain stack combinators"
+"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
+$nl
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
{ $subsection dip }
{ $subsection 2dip }
"These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:"
{ $code
": keep ( x quot -- x )"
- " over >r call r> ; inline"
+ " over [ call ] dip ; inline"
}
"Word inlining is documented in " { $link "declarations" } "." ;
{ $subsection "booleans" }
{ $subsection "shuffle-words" }
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
+{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" }
-{ $subsection "slip-keep-combinators" }
{ $subsection "conditionals" }
{ $subsection "compositional-combinators" }
{ $subsection "combinators" }
! Regression
: (loop) ( a b c d -- )
- >r pick r> swap >r pick r> swap
- < [ >r >r >r 1+ r> r> r> (loop) ] [ 2drop 2drop ] if ; inline
+ [ pick ] dip swap [ pick ] dip swap
+ < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline
: loop ( obj obj -- )
- H{ } values swap >r dup length swap r> 0 -roll (loop) ;
+ H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
[ loop ] must-fail
USING: kernel.private slots.private classes.tuple.private ;
IN: kernel
+DEFER: dip
+DEFER: 2dip
+DEFER: 3dip
+
! Stack stuff
: spin ( x y z -- z y x ) swap rot ; inline
-: roll ( x y z t -- y z t x ) >r rot r> swap ; inline
+: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline
-: -roll ( x y z t -- t x y z ) swap >r -rot r> ; inline
+: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline
: 2over ( x y z -- x y z x y ) pick pick ; inline
pick [ roll 2drop call ] [ 2nip call ] if ; inline
! Slippers
-: slip ( quot x -- x ) >r call r> ; inline
-
-: 2slip ( quot x y -- x y ) >r >r call r> r> ; inline
-
-: 3slip ( quot x y z -- x y z ) >r >r >r call r> r> r> ; inline
+: slip ( quot x -- x )
+ #! 'slip' and 'dip' can be defined in terms of each other
+ #! because the JIT special-cases a 'dip' preceeded by
+ #! a literal quotation.
+ [ call ] dip ;
+
+: 2slip ( quot x y -- x y )
+ #! '2slip' and '2dip' can be defined in terms of each other
+ #! because the JIT special-cases a '2dip' preceeded by
+ #! a literal quotation.
+ [ call ] 2dip ;
+
+: 3slip ( quot x y z -- x y z )
+ #! '3slip' and '3dip' can be defined in terms of each other
+ #! because the JIT special-cases a '3dip' preceeded by
+ #! a literal quotation.
+ [ call ] 3dip ;
: dip ( x quot -- x ) swap slip ; inline
-: 2dip ( x y quot -- x y ) swap >r dip r> ; inline
+: 2dip ( x y quot -- x y ) -rot 2slip ; inline
-: 3dip ( x y z quot -- x y z ) swap >r 2dip r> ; inline
+: 3dip ( x y z quot -- x y z ) -roll 3slip ; inline
! Keepers
-: keep ( x quot -- x ) dupd dip ; inline
+: keep ( x quot -- x ) over slip ; inline
-: 2keep ( x y quot -- x y ) >r 2dup r> 2dip ; inline
+: 2keep ( x y quot -- x y ) [ 2dup ] dip 2dip ; inline
-: 3keep ( x y z quot -- x y z ) >r 3dup r> 3dip ; inline
+: 3keep ( x y z quot -- x y z ) [ 3dup ] dip 3dip ; inline
! Cleavers
: bi ( x p q -- )
- >r keep r> call ; inline
+ [ keep ] dip call ; inline
: tri ( x p q r -- )
- >r >r keep r> keep r> call ; inline
+ [ [ keep ] dip keep ] dip call ; inline
! Double cleavers
: 2bi ( x y p q -- )
- >r 2keep r> call ; inline
+ [ 2keep ] dip call ; inline
: 2tri ( x y p q r -- )
- >r >r 2keep r> 2keep r> call ; inline
+ [ [ 2keep ] dip 2keep ] dip call ; inline
! Triple cleavers
: 3bi ( x y z p q -- )
- >r 3keep r> call ; inline
+ [ 3keep ] dip call ; inline
: 3tri ( x y z p q r -- )
- >r >r 3keep r> 3keep r> call ; inline
+ [ [ 3keep ] dip 3keep ] dip call ; inline
! Spreaders
: bi* ( x y p q -- )
- >r dip r> call ; inline
+ [ dip ] dip call ; inline
: tri* ( x y z p q r -- )
- >r >r 2dip r> dip r> call ; inline
+ [ [ 2dip ] dip dip ] dip call ; inline
! Double spreaders
: 2bi* ( w x y z p q -- )
- >r 2dip r> call ; inline
+ [ 2dip ] dip call ; inline
! Appliers
: bi@ ( x y quot -- )
dup slip swap [ loop ] [ drop ] if ; inline recursive
: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
- >r >r dup slip r> r> roll
- [ >r tuck 2slip r> while ]
+ [ dup slip ] 2dip roll
+ [ [ tuck 2slip ] dip while ]
[ 2nip call ] if ; inline recursive
! Object protocol
: either? ( x y quot -- ? ) bi@ or ; inline
: most ( x y quot -- z )
- >r 2dup r> call [ drop ] [ nip ] if ; inline
+ [ 2dup ] dip call [ drop ] [ nip ] if ; inline
! Error handling -- defined early so that other files can
! throw errors before continuations are loaded
lexer new-lexer ;
: skip ( i seq ? -- n )
- >r tuck r>
+ [ tuck ] dip
[ swap CHAR: \s eq? xor ] curry find-from drop
[ ] [ length ] ?if ;
: unexpected-eof ( word -- * ) f unexpected ;
+: expect ( token -- )
+ scan
+ [ 2dup = [ 2drop ] [ unexpected ] if ]
+ [ unexpected-eof ]
+ if* ;
+
: (parse-tokens) ( accum end -- accum )
scan 2dup = [
2drop
M: fixnum - fixnum- ;
M: fixnum * fixnum* ;
M: fixnum /i fixnum/i ;
-M: fixnum /f >r >float r> >float float/f ;
+M: fixnum /f [ >float ] dip >float float/f ;
M: fixnum mod fixnum-mod ;
M: fixnum bit? neg shift 1 bitand 0 > ;
: (fixnum-log2) ( accum n -- accum )
- dup 1 number= [ drop ] [ >r 1+ r> 2/ (fixnum-log2) ] if ;
+ dup 1 number= [ drop ] [ [ 1+ ] [ 2/ ] bi* (fixnum-log2) ] if ;
inline recursive
M: fixnum (log2) 0 swap (fixnum-log2) ;
: pre-scale ( num den -- scale shifted-num scaled-den )
2dup [ log2 ] bi@ -
- tuck [ neg 54 + shift ] [ >r scale-denonimator r> + ] 2bi*
+ tuck [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] 2bi*
-rot ; inline
! Second step: loop
: /f-loop ( scale mantissa den -- scale' fraction-and-guard rem )
[ 2dup /i log2 53 > ]
- [ >r shift-mantissa r> ]
+ [ [ shift-mantissa ] dip ]
[ ] while /mod ; inline
! Third step: post-scaling
52 2^ 1- bitand 1022 52 shift bitor bits>double ; inline
: scale-float ( scale mantissa -- float' )
- >r dup 0 < [ neg 2^ recip ] [ 2^ ] if r> * ; inline
+ [ dup 0 < [ neg 2^ recip ] [ 2^ ] if ] dip * ; inline
: post-scale ( scale mantissa -- n )
2/ dup log2 52 > [ shift-mantissa ] when
{ $subsection 2/ }
{ $subsection 2^ }
{ $subsection bit? }
+"The " { $vocab-link "math.bitwise" } " vocabulary implements additional bitwise integer operations."
{ $see-also "conditionals" } ;
ARTICLE: "arithmetic" "Arithmetic"
2dup >= [
drop
] [
- >r 1 shift r> (next-power-of-2)
+ [ 1 shift ] dip (next-power-of-2)
] if ;
: next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable
: iterate-prep 0 -rot ; inline
-: if-iterate? >r >r 2over < r> r> if ; inline
+: if-iterate? [ 2over < ] 2dip if ; inline
: iterate-step ( i n quot -- i n quot )
#! Apply quot to i, keep i and quot, hide n.
- swap >r 2dup 2slip r> swap ; inline
+ swap [ 2dup 2slip ] dip swap ; inline
-: iterate-next >r >r 1+ r> r> ; inline
+: iterate-next [ 1+ ] 2dip ; inline
PRIVATE>
2dup 2slip rot [
drop
] [
- >r 1- r> find-last-integer
+ [ 1- ] dip find-last-integer
] if
] if ; inline recursive
: (base>) ( str -- n ) radix get base> ;
: whole-part ( str -- m n )
- sign split1 >r (base>) r>
+ sign split1 [ (base>) ] dip
dup [ (base>) ] [ drop 0 swap ] if ;
: string>ratio ( str -- a/b )
"-" ?head dup negative? set swap
- "/" split1 (base>) >r whole-part r>
+ "/" split1 (base>) [ whole-part ] dip
3dup and and [ / + swap [ neg ] when ] [ 2drop 2drop f ] if ;
: valid-digits? ( seq -- ? )
{
{
[ CHAR: e over member? ]
- [ "e" split1 >r fix-float "e" r> 3append ]
+ [ "e" split1 [ fix-float "e" ] dip 3append ]
} {
[ CHAR: . over member? ]
[ ]
: off ( variable -- ) f swap set ; inline
: get-global ( variable -- value ) global at ;
: set-global ( value variable -- ) global set-at ;
-: change ( variable quot -- ) >r dup get r> rot slip set ; inline
+: change ( variable quot -- ) [ [ get ] keep ] dip dip set ; inline
: +@ ( n variable -- ) [ 0 or + ] change ;
: inc ( variable -- ) 1 swap +@ ; inline
: dec ( variable -- ) -1 swap +@ ; inline
H{ } clone >n call ndrop ; inline
: with-variable ( value key quot -- )
- >r associate >n r> call ndrop ; inline
+ [ associate >n ] dip call ndrop ; inline
}
"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ;
-ARTICLE: "vocabulary-search-errors" "Word lookup errors"
-"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies. Then, one of three things happen:"
-{ $list
- { "If there are no words having this name at all, an error is thrown and parsing stops." }
- { "If there are vocabularies which contain words with this name, a restartable error is thrown, with a restart for each vocabulary in question. The restarts add the vocabulary to the search path and continue parsing." }
-}
-"When writing a new vocabulary, one approach is to ignore " { $link POSTPONE: USING: } " declarations altogether, then to load the vocabulary and observe any parser notes and restarts and use this information to write the correct " { $link POSTPONE: USING: } " declaration." ;
+ARTICLE: "vocabulary-search-errors" "Word lookup errors"
+"If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies."
+$nl
+"If " { $link auto-use? } " mode is off, a restartable error is thrown with a restart for each vocabulary in question, together with a restart which defers the word in the current vocabulary, as if " { $link POSTPONE: DEFER: } " was used."
+$nl
+"If " { $link auto-use? } " mode is on and only one vocabulary has a word with this name, the vocabulary is added to the search path and parsing continues."
+$nl
+"If any restarts were invoked, or if " { $link auto-use? } " is on, the parser will print the correct " { $link POSTPONE: USING: } " after parsing completes. This form can be copy and pasted back into the source file."
+{ $subsection auto-use? } ;
ARTICLE: "vocabulary-search" "Vocabulary search path"
"When the parser reads a token, it attempts to look up a word named by that token. The lookup is performed by searching each vocabulary in the search path, in order."
{ $description "Throws a " { $link staging-violation } " error." }
{ $error-description "Thrown by the parser if a parsing word is used in the same compilation unit as where it was defined; see " { $link "compilation-units" } "." }
{ $notes "One possible workaround is to use the " { $link POSTPONE: << } " word to execute code at parse time. However, executing words defined in the same source file at parse time is still prohibited." } ;
+
+HELP: auto-use?
+{ $var-description "If set to a true value, the behavior of the parser when encountering an unknown word name is changed. If only one loaded vocabulary has a word with this name, instead of throwing an error, the parser adds the vocabulary to the search path and prints a parse note. Off by default." }
+{ $notes "This feature is intended to help during development. To generate a " { $link POSTPONE: USING: } " form automatically, enable " { $link auto-use? } ", load the source file, and copy and paste the " { $link POSTPONE: USING: } " form printed by the parser back into the file, then disable " { $link auto-use? } ". See " { $link "vocabulary-search-errors" } "." } ;
io.streams.string namespaces classes effects source-files
assocs sequences strings io.files definitions continuations
sorting classes.tuple compiler.units debugger vocabs
-vocabs.loader accessors eval combinators ;
+vocabs.loader accessors eval combinators lexer ;
IN: parser.tests
[
"USE: this-better-not-exist" eval
] must-fail
-[ ": foo ;" eval ] [ error>> no-current-vocab? ] must-fail-with
+[ ": foo ;" eval ] [ error>> error>> no-current-vocab? ] must-fail-with
[ 92 ] [ "CHAR: \\" eval ] unit-test
[ 92 ] [ "CHAR: \\\\" eval ] unit-test
[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
-[ "DEFER: blah" eval ] [ error>> no-current-vocab? ] must-fail-with
+[ "DEFER: blah" eval ] [ error>> error>> no-current-vocab? ] must-fail-with
[
"IN: parser.tests : blah ; parsing FORGET: blah" eval
[ "IN: parser.tests USE: kernel TUPLE: blah < tuple ; : blah ; TUPLE: blah < tuple ; : blah ;" eval ]
[ error>> error>> def>> \ blah eq? ] must-fail-with
+
+[ ] [ f lexer set f file set "Hello world" note. ] unit-test
+
+[ "CHAR: \\u9999999999999" eval ] must-fail
: location ( -- loc )
file get lexer get line>> 2dup and
- [ >r path>> r> 2array ] [ 2drop f ] if ;
+ [ [ path>> ] dip 2array ] [ 2drop f ] if ;
: save-location ( definition -- )
location remember-definition ;
: note. ( str -- )
parser-notes? [
file get [ path>> write ":" write ] when*
- lexer get line>> number>string write ": " write
+ lexer get [ line>> number>string write ": " write ] when*
"Note: " write dup print
] when drop ;
M: parsing-word stack-effect drop (( parsed -- parsed )) ;
-ERROR: no-current-vocab ;
+TUPLE: no-current-vocab ;
+
+: no-current-vocab ( -- vocab )
+ \ no-current-vocab boa
+ { { "Define words in scratchpad vocabulary" "scratchpad" } }
+ throw-restarts dup set-in ;
: current-vocab ( -- str )
in get [ no-current-vocab ] unless* ;
: CREATE-WORD ( -- word ) CREATE dup reset-generic ;
-: word-restarts ( possibilities -- restarts )
- natural-sort [
- [
- "Use the " swap vocabulary>> " vocabulary" 3append
- ] keep
- ] { } map>assoc ;
+: word-restarts ( name possibilities -- restarts )
+ natural-sort
+ [ [ "Use the " swap vocabulary>> " vocabulary" 3append ] keep ] { } map>assoc
+ swap "Defer word in current vocabulary" swap 2array
+ suffix ;
ERROR: no-word-error name ;
+: <no-word-error> ( name possibilities -- error restarts )
+ [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;
+
+SYMBOL: amended-use?
+
+SYMBOL: auto-use?
+
+: no-word-restarted ( restart-value -- word )
+ dup word? [
+ amended-use? on
+ dup vocabulary>>
+ [ (use+) ] [
+ "Added ``" swap "'' vocabulary to search path" 3append note.
+ ] bi
+ ] [ create-in ] if ;
+
: no-word ( name -- newword )
- dup \ no-word-error boa
- swap words-named [ forward-reference? not ] filter
- word-restarts throw-restarts
- dup vocabulary>> (use+) ;
+ dup words-named [ forward-reference? not ] filter
+ dup length 1 = auto-use? get and
+ [ nip first no-word-restarted ]
+ [ <no-word-error> throw-restarts no-word-restarted ]
+ if ;
: check-forward ( str word -- word/f )
dup forward-reference? [
} cond ;
: (parse-until) ( accum end -- accum )
- dup >r parse-step [ r> (parse-until) ] [ r> drop ] if ;
+ [ parse-step ] keep swap [ (parse-until) ] [ drop ] if ;
: parse-until ( end -- vec )
100 <vector> swap (parse-until) ;
: parsed ( accum obj -- accum ) over push ;
: (parse-lines) ( lexer -- quot )
- [ f parse-until >quotation ] with-lexer ;
+ [
+ f parse-until >quotation
+ ] with-lexer ;
: parse-lines ( lines -- quot )
lexer-factory get call (parse-lines) ;
: parse-literal ( accum end quot -- accum )
- >r parse-until r> call parsed ; inline
+ [ parse-until ] dip call parsed ; inline
: parse-definition ( -- quot )
\ ; parse-until >quotation ;
call
] with-scope ; inline
+SYMBOL: print-use-hook
+
+print-use-hook global [ [ ] or ] change-at
+
: parse-fresh ( lines -- quot )
- [ parse-lines ] with-file-vocabs ;
+ [
+ amended-use? off
+ parse-lines
+ amended-use? get [
+ print-use-hook get call
+ ] when
+ ] with-file-vocabs ;
: parsing-file ( file -- )
"quiet" get [
[ [ "hi" ] ] [ "hi" 1quotation ] unit-test
-! [ 1 \ + curry ] must-fail
+[ 1 \ + curry ] must-fail
M: curry length quot>> length 1+ ;
M: curry nth
- over zero? [ nip obj>> literalize ] [ >r 1- r> quot>> nth ] if ;
+ over 0 =
+ [ nip obj>> literalize ]
+ [ [ 1- ] dip quot>> nth ]
+ if ;
INSTANCE: curry immutable-sequence
GENERIC: clone-like ( seq exemplar -- newseq ) flushable
: new-like ( len exemplar quot -- seq )
- over >r >r new-sequence r> call r> like ; inline
+ over [ [ new-sequence ] dip call ] dip like ; inline
M: sequence like drop ;
[ first3-unsafe 3 ] [ nth-unsafe ] bi ; inline
: exchange-unsafe ( m n seq -- )
- [ tuck nth-unsafe >r nth-unsafe r> ] 3keep tuck
- >r >r set-nth-unsafe r> r> set-nth-unsafe ; inline
+ [ tuck [ nth-unsafe ] 2bi@ ]
+ [ tuck [ set-nth-unsafe ] 2bi@ ] 3bi ; inline
: (head) ( seq n -- from to seq ) 0 spin ; inline
: (tail) ( seq n -- from to seq ) over length rot ; inline
-: from-end >r dup length r> - ; inline
+: from-end [ dup length ] dip - ; inline
: (2sequence)
tuck 1 swap set-nth-unsafe
{ seq read-only } ;
: collapse-slice ( m n slice -- m' n' seq )
- [ from>> ] [ seq>> ] bi >r tuck + >r + r> r> ; inline
+ [ from>> ] [ seq>> ] bi [ tuck [ + ] 2bi@ ] dip ; inline
-ERROR: slice-error reason ;
+ERROR: slice-error from to seq reason ;
: check-slice ( from to seq -- from to seq )
pick 0 < [ "start < 0" slice-error ] when
: prepare-subseq ( from to seq -- dst i src j n )
#! The check-length call forces partial dispatch
- [ >r swap - r> new-sequence dup 0 ] 3keep
+ [ [ swap - ] dip new-sequence dup 0 ] 3keep
-rot drop roll length check-length ; inline
: check-copy ( src n dst -- )
over 0 < [ bounds-error ] when
- >r swap length + r> lengthen ; inline
+ [ swap length + ] dip lengthen ; inline
PRIVATE>
: copy ( src i dst -- )
#! The check-length call forces partial dispatch
- pick length check-length >r 3dup check-copy spin 0 r>
+ pick length check-length [ 3dup check-copy spin 0 ] dip
(copy) drop ; inline
M: sequence clone-like
- >r dup length r> new-sequence [ 0 swap copy ] keep ;
+ [ dup length ] dip new-sequence [ 0 swap copy ] keep ;
M: immutable-sequence clone-like like ;
<PRIVATE
-: ((append)) ( seq1 seq2 accum -- accum )
- [ >r over length r> copy ]
- [ 0 swap copy ]
+: (append) ( seq1 seq2 accum -- accum )
+ [ [ over length ] dip copy ]
+ [ 0 swap copy ]
[ ] tri ; inline
-: (append) ( seq1 seq2 exemplar -- newseq )
- >r over length over length + r>
- [ ((append)) ] new-like ; inline
+PRIVATE>
-: (3append) ( seq1 seq2 seq3 exemplar -- newseq )
- >r pick length pick length pick length + + r> [
- [ >r pick length pick length + r> copy ]
- [ ((append)) ] bi
- ] new-like ; inline
+: append-as ( seq1 seq2 exemplar -- newseq )
+ [ over length over length + ] dip
+ [ (append) ] new-like ; inline
-PRIVATE>
+: 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
+ [ pick length pick length pick length + + ] dip [
+ [ [ pick length pick length + ] dip copy ]
+ [ (append) ] bi
+ ] new-like ; inline
-: append ( seq1 seq2 -- newseq ) over (append) ;
+: append ( seq1 seq2 -- newseq ) over append-as ;
: prepend ( seq1 seq2 -- newseq ) swap append ; inline
-: 3append ( seq1 seq2 seq3 -- newseq ) pick (3append) ;
+: 3append ( seq1 seq2 seq3 -- newseq ) pick 3append-as ;
: change-nth ( i seq quot -- )
- [ >r nth r> call ] 3keep drop set-nth ; inline
+ [ [ nth ] dip call ] 3keep drop set-nth ; inline
: min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline
<PRIVATE
: (each) ( seq quot -- n quot' )
- >r dup length swap [ nth-unsafe ] curry r> compose ; inline
+ [ dup length swap [ nth-unsafe ] curry ] dip compose ; inline
: (collect) ( quot into -- quot' )
- [ >r keep r> set-nth-unsafe ] 2curry ; inline
+ [ [ keep ] dip set-nth-unsafe ] 2curry ; inline
: collect ( n quot into -- )
(collect) each-integer ; inline
: map-into ( seq quot into -- )
- >r (each) r> collect ; inline
+ [ (each) ] dip collect ; inline
: 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
- >r over r> nth-unsafe >r nth-unsafe r> ; inline
+ [ over ] dip nth-unsafe [ nth-unsafe ] dip ; inline
: (2each) ( seq1 seq2 quot -- n quot' )
- >r [ min-length ] 2keep r>
- [ >r 2nth-unsafe r> call ] 3curry ; inline
+ [ [ min-length ] 2keep ] dip
+ [ [ 2nth-unsafe ] dip call ] 3curry ; inline
: 2map-into ( seq1 seq2 quot into -- newseq )
- >r (2each) r> collect ; inline
+ [ (2each) ] dip collect ; inline
: finish-find ( i seq -- i elt )
over [ dupd nth-unsafe ] [ drop f ] if ; inline
: (find) ( seq quot quot' -- i elt )
- pick >r >r (each) r> call r> finish-find ; inline
+ pick [ [ (each) ] dip call ] dip finish-find ; inline
: (find-from) ( n seq quot quot' -- i elt )
[ 2dup bounds-check? ] 2dip
swapd each ; inline
: map-as ( seq quot exemplar -- newseq )
- >r over length r> [ [ map-into ] keep ] new-like ; inline
+ [ over length ] dip [ [ map-into ] keep ] new-like ; inline
: map ( seq quot -- newseq )
over map-as ; inline
[ drop ] prepose map ; inline
: replicate-as ( seq quot exemplar -- newseq )
- >r [ drop ] prepose r> map-as ; inline
+ [ [ drop ] prepose ] dip map-as ; inline
: change-each ( seq quot -- )
over map-into ; inline
(2each) each-integer ; inline
: 2reverse-each ( seq1 seq2 quot -- )
- >r [ <reversed> ] bi@ r> 2each ; inline
+ [ [ <reversed> ] bi@ ] dip 2each ; inline
: 2reduce ( seq1 seq2 identity quot -- result )
- >r -rot r> 2each ; inline
+ [ -rot ] dip 2each ; inline
: 2map-as ( seq1 seq2 quot exemplar -- newseq )
- >r 2over min-length r>
+ [ 2over min-length ] dip
[ [ 2map-into ] keep ] new-like ; inline
: 2map ( seq1 seq2 quot -- newseq )
[ nip find-last-integer ] (find-from) ; inline
: find-last ( seq quot -- i elt )
- [ >r 1- r> find-last-integer ] (find) ; inline
+ [ [ 1- ] dip find-last-integer ] (find) ; inline
: all? ( seq quot -- ? )
(each) all-integers? ; inline
: push-if ( elt quot accum -- )
- >r keep r> rot [ push ] [ 2drop ] if ; inline
+ [ keep ] dip rot [ push ] [ 2drop ] if ; inline
: pusher ( quot -- quot accum )
V{ } clone [ [ push-if ] 2curry ] keep ; inline
: filter ( seq quot -- subseq )
- over >r pusher >r each r> r> like ; inline
+ over [ pusher [ each ] dip ] dip like ; inline
: push-either ( elt quot accum1 accum2 -- )
- >r >r keep swap r> r> ? push ; inline
+ [ keep swap ] 2dip ? push ; inline
: 2pusher ( quot -- quot accum1 accum2 )
V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
: partition ( seq quot -- trueseq falseseq )
- over >r 2pusher >r >r each r> r> r> tuck [ like ] 2bi@ ; inline
+ over [ 2pusher [ each ] 2dip ] dip tuck [ like ] 2bi@ ; inline
: monotonic? ( seq quot -- ? )
- >r dup length 1- swap r> (monotonic) all? ; inline
+ [ dup length 1- swap ] dip (monotonic) all? ; inline
: interleave ( seq between quot -- )
- [ (interleave) ] 2curry >r dup length swap r> 2each ; inline
+ [ (interleave) ] 2curry [ dup length swap ] dip 2each ; inline
: accumulator ( quot -- quot' vec )
V{ } clone [ [ push ] curry compose ] keep ; inline
: produce-as ( pred quot tail exemplar -- seq )
- >r swap accumulator >r swap while r> r> like ; inline
+ [ swap accumulator [ swap while ] dip ] dip like ; inline
: produce ( pred quot tail -- seq )
{ } produce-as ; inline
: follow ( obj quot -- seq )
- >r [ dup ] r> [ keep ] curry [ ] produce nip ; inline
+ [ dup ] swap [ keep ] curry [ ] produce nip ; inline
: prepare-index ( seq quot -- seq n quot )
- >r dup length r> ; inline
+ [ dup length ] dip ; inline
: each-index ( seq quot -- )
prepare-index 2each ; inline
: cache-nth ( i seq quot -- elt )
2over ?nth dup [
- >r 3drop r>
+ [ 3drop ] dip
] [
- drop swap >r over >r call dup r> r> set-nth
+ drop swap [ over [ call dup ] dip ] dip set-nth
] if ; inline
: mismatch ( seq1 seq2 -- i )
[ eq? not ] with filter-here ;
: prefix ( seq elt -- newseq )
- over >r over length 1+ r> [
+ over [ over length 1+ ] dip [
[ 0 swap set-nth-unsafe ] keep
[ 1 swap copy ] keep
] new-like ;
: suffix ( seq elt -- newseq )
- over >r over length 1+ r> [
- [ >r over length r> set-nth-unsafe ] keep
+ over [ over length 1+ ] dip [
+ [ [ over length ] dip set-nth-unsafe ] keep
[ 0 swap copy ] keep
] new-like ;
2over = [
2drop 2drop
] [
- [ >r 2over + pick r> move >r 1+ r> ] keep
+ [ [ 2over + pick ] dip move [ 1+ ] dip ] keep
move-backward
] if ;
2over = [
2drop 2drop
] [
- [ >r pick >r dup dup r> + swap r> move 1- ] keep
+ [ [ pick [ dup dup ] dip + swap ] dip move 1- ] keep
move-forward
] if ;
: (open-slice) ( shift from to seq ? -- )
[
- >r [ 1- ] bi@ r> move-forward
+ [ [ 1- ] bi@ ] dip move-forward
] [
- >r >r over - r> r> move-backward
+ [ over - ] 2dip move-backward
] if ;
PRIVATE>
pick 0 = [
3drop
] [
- pick over length + over >r >r
- pick 0 > >r [ length ] keep r> (open-slice)
- r> r> set-length
+ pick over length + over
+ [ pick 0 > [ [ length ] keep ] dip (open-slice) ] 2dip
+ set-length
] if ;
: delete-slice ( from to seq -- )
- check-slice >r over >r - r> r> open-slice ;
+ check-slice [ over [ - ] dip ] dip open-slice ;
: delete-nth ( n seq -- )
- >r dup 1+ r> delete-slice ;
+ [ dup 1+ ] dip delete-slice ;
: replace-slice ( new from to seq -- )
- [ >r >r dup pick length + r> - over r> open-slice ] keep
+ [ [ [ dup pick length + ] dip - over ] dip open-slice ] keep
copy ;
: remove-nth ( n seq -- seq' )
: reverse-here ( seq -- )
dup length dup 2/ [
- >r 2dup r>
+ [ 2dup ] dip
tuck - 1- rot exchange-unsafe
] each 2drop ;
<PRIVATE
: joined-length ( seq glue -- n )
- >r dup sum-lengths swap length 1 [-] r> length * + ;
+ [ dup sum-lengths swap length 1 [-] ] dip length * + ;
PRIVATE>
] dip compose if ; inline
: pad-left ( seq n elt -- padded )
- [ swap dup (append) ] padding ;
+ [ swap dup append-as ] padding ;
: pad-right ( seq n elt -- padded )
[ append ] padding ;
>fixnum {
[ drop nip ]
[ 2drop first ]
- [ >r drop first2 r> call ]
- [ >r drop first3 r> bi@ ]
+ [ [ drop first2 ] dip call ]
+ [ [ drop first3 ] dip bi@ ]
} dispatch
] [
drop
- >r >r halves r> r>
+ [ halves ] 2dip
[ [ binary-reduce ] 2curry bi@ ] keep
call
] if ; inline recursive
: (start) ( subseq seq n -- subseq seq ? )
pick length [
- >r 3dup r> [ + swap nth-unsafe ] keep rot nth-unsafe =
+ [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
] all? nip ; inline
PRIVATE>
: start* ( subseq seq n -- i )
pick length pick length swap - 1+
[ (start) ] find-from
- swap >r 3drop r> ;
+ swap [ 3drop ] dip ;
: start ( subseq seq -- i ) 0 start* ; inline
: drop-prefix ( seq1 seq2 -- slice1 slice2 )
2dup mismatch [ 2dup min-length ] unless*
- tuck tail-slice >r tail-slice r> ;
+ tuck [ tail-slice ] 2bi@ ;
: unclip ( seq -- rest first )
[ rest ] [ first ] bi ;
inline
: trim-left-slice ( seq quot -- slice )
- over >r [ not ] compose find drop r> swap
+ over [ [ not ] compose find drop ] dip swap
[ tail-slice ] [ dup length tail-slice ] if* ; inline
: trim-left ( seq quot -- newseq )
over [ trim-left-slice ] dip like ; inline
: trim-right-slice ( seq quot -- slice )
- over >r [ not ] compose find-last drop r> swap
+ over [ [ not ] compose find-last drop ] dip swap
[ 1+ head-slice ] [ 0 head-slice ] if* ; inline
: trim-right ( seq quot -- newseq )
USING: arrays byte-arrays kernel kernel.private math namespaces
make sequences strings words effects generic generic.standard
classes classes.algebra slots.private combinators accessors
-words sequences.private assocs alien ;
+words sequences.private assocs alien quotations ;
IN: slots
TUPLE: slot-spec name offset class initial read-only ;
3bi ;
: create-accessor ( name effect -- word )
- >r "accessors" create dup r>
+ [ "accessors" create dup ] dip
"declared-effect" set-word-prop ;
: reader-quot ( slot-spec -- quot )
offset>> , \ set-slot , ;
: writer-quot/coerce ( slot-spec -- )
- [ \ >r , class>> "coercer" word-prop % \ r> , ]
+ [ class>> "coercer" word-prop [ dip ] curry % ]
[ offset>> , \ set-slot , ]
bi ;
bi ;
: writer-quot/fixnum ( slot-spec -- )
- [ >r >fixnum r> ] % writer-quot/check ;
+ [ [ >fixnum ] dip ] % writer-quot/check ;
: writer-quot ( slot-spec -- quot )
[
: define-changer ( name -- )
dup changer-word dup deferred? [
[
- [ over >r >r ] %
- over reader-word ,
- [ r> call r> swap ] %
+ \ over ,
+ over reader-word 1quotation
+ [ dip call ] curry [ dip swap ] curry %
swap setter-word ,
] [ ] make define-inline
] [ 2drop ] if ;
: dump ( from to seq accum -- )
#! Optimize common case where to - from = 1, 2, or 3.
- >r >r 2dup swap - r> r> pick 1 =
- [ >r >r 2drop r> nth-unsafe r> push ] [
+ [ 2dup swap - ] 2dip pick 1 =
+ [ [ [ 2drop ] dip nth-unsafe ] dip push ] [
pick 2 = [
- >r >r 2drop dup 1+
- r> [ nth-unsafe ] curry bi@
- r> [ push ] curry bi@
+ [
+ [ 2drop dup 1+ ] dip
+ [ nth-unsafe ] curry bi@
+ ] dip [ push ] curry bi@
] [
pick 3 = [
- >r >r 2drop dup 1+ dup 1+
- r> [ nth-unsafe ] curry tri@
- r> [ push ] curry tri@
- ] [
- >r nip subseq r> push-all
- ] if
+ [
+ [ 2drop dup 1+ dup 1+ ] dip
+ [ nth-unsafe ] curry tri@
+ ] dip [ push ] curry tri@
+ ] [ [ nip subseq ] dip push-all ] if
] if
] if ; inline
{ $subsection ?tail }
{ $subsection ?tail-slice }
{ $subsection split1 }
+{ $subsection split1-slice }
+{ $subsection split1-last }
+{ $subsection split1-last-slice }
{ $subsection split }
"Splitting a string into lines:"
{ $subsection string-lines } ;
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
{ $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
-HELP: last-split1
+HELP: split1-slice
+{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
+{ $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
+
+HELP: split1-last
{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
{ $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
-{ split1 last-split1 } related-words
+HELP: split1-last-slice
+{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
+{ $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
+
+{ split1 split1-slice split1-last split1-last-slice } related-words
HELP: split
{ $values { "seq" "a sequence" } { "separators" "a sequence" } { "pieces" "a new array" } }
-USING: splitting tools.test kernel sequences arrays ;
+USING: splitting tools.test kernel sequences arrays strings ;
IN: splitting.tests
[ "hello" "world ." ] [ "hello world ." " " split1 ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
[ "" "" ] [ "great" "great" split1 ] unit-test
-[ "hello world" "." ] [ "hello world ." " " last-split1 ] unit-test
-[ "hello-+world" "." ] [ "hello-+world-+." "-+" last-split1 ] unit-test
-[ "goodbye" f ] [ "goodbye" " " last-split1 ] unit-test
-[ "" "" ] [ "great" "great" last-split1 ] unit-test
+[ "hello world" "." ] [ "hello world ." " " split1-last ] unit-test
+[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last ] unit-test
+[ "goodbye" f ] [ "goodbye" " " split1-last ] unit-test
+[ "" "" ] [ "great" "great" split1-last ] unit-test
+
+[ "hello world" "." ] [ "hello world ." " " split1-last-slice [ >string ] bi@ ] unit-test
+[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last-slice [ >string ] bi@ ] unit-test
+[ "goodbye" f ] [ "goodbye" " " split1-last-slice [ >string ] dip ] unit-test
+[ "" f ] [ "great" "great" split1-last-slice [ >string ] dip ] unit-test
[ "and end" t ] [ "Beginning and end" "Beginning " ?head ] unit-test
[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?head ] unit-test
: split1 ( seq subseq -- before after )
dup pick start dup [
- [ >r over r> head -rot length ] keep + tail
+ [ [ over ] dip head -rot length ] keep + tail
] [
2drop f
] if ;
-: last-split1 ( seq subseq -- before after )
+: split1-slice ( seq subseq -- before-slice after-slice )
+ dup pick start dup [
+ [ [ over ] dip head-slice -rot length ] keep + tail-slice
+ ] [
+ 2drop f
+ ] if ;
+
+: split1-last ( seq subseq -- before after )
[ <reversed> ] bi@ split1 [ reverse ] bi@
dup [ swap ] when ;
+: split1-last-slice ( seq subseq -- before-slice after-slice )
+ [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
+ [ f ] [ swap ] if-empty ;
+
: (split) ( separators n seq -- )
3dup rot [ member? ] curry find-from drop
[ [ swap subseq , ] 2keep 1+ swap (split) ]
: unicode-escape ( str -- ch str' )
"{" ?head-slice [
CHAR: } over index cut-slice
- >r >string name>char-hook get call r>
+ [ >string name>char-hook get call ] dip
rest-slice
] [
- 6 cut-slice >r hex> r>
+ 6 cut-slice [ hex> ] dip
] if ;
: next-escape ( str -- ch str' )
: (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [
- >r cut-slice >r % r> rest-slice r>
+ [ cut-slice [ % ] dip rest-slice ] dip
dup CHAR: " = [
drop from>>
] [
- drop next-escape >r , r> (parse-string)
+ drop next-escape [ , ] dip (parse-string)
] if
] [
"Unterminated string" throw
length>> ;
M: string nth-unsafe
- >r >fixnum r> string-nth ;
+ [ >fixnum ] dip string-nth ;
M: string set-nth-unsafe
dup reset-string-hashcode
- >r >fixnum >r >fixnum r> r> set-string-nth ;
+ [ [ >fixnum ] dip >fixnum ] dip set-string-nth ;
M: string clone
(clone) [ clone ] change-aux ;
"syntax" lookup t "delimiter" set-word-prop ;
: define-syntax ( name quot -- )
- >r "syntax" lookup dup r> define t "parsing" set-word-prop ;
+ [ "syntax" lookup dup ] dip define t "parsing" set-word-prop ;
[
{ "]" "}" ";" ">>" } [ define-delimiter ] each
"CHAR:" [
scan {
{ [ dup length 1 = ] [ first ] }
- { [ "\\" ?head ] [ next-escape drop ] }
+ { [ "\\" ?head ] [ next-escape >string "" assert= ] }
[ name>char-hook get call ]
} cond parsed
] define-syntax
] define-syntax
"INSTANCE:" [
- location >r
- scan-word scan-word 2dup add-mixin-instance
- <mixin-instance> r> remember-definition
+ location [
+ scan-word scan-word 2dup add-mixin-instance
+ <mixin-instance>
+ ] dip remember-definition
] define-syntax
"PREDICATE:" [
] define-syntax
"call-next-method" [
- current-class get current-generic get
- 2dup [ word? ] both? [
- [ literalize parsed ] bi@
+ current-method get [
+ literalize parsed
\ (call-next-method) parsed
] [
not-in-a-method-error
- ] if
+ ] if*
] define-syntax
"initial:" "syntax" lookup define-symbol
[ t ] [
V{ 1 2 3 4 } dup underlying>> length
- >r clone underlying>> length r>
+ [ clone underlying>> length ] dip
=
] unit-test
[ 4 ] [ 5 V{ 1 2 3 4 5 } index ] unit-test
[ t ] [
- 100 >array dup >vector <reversed> >array >r reverse r> =
+ 100 >array dup >vector <reversed> >array [ reverse ] dip =
] unit-test
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
-USING: vocabs help.markup help.syntax words strings io ;
+USING: vocabs vocabs.loader.private help.markup help.syntax
+words strings io ;
IN: vocabs.loader
ARTICLE: "vocabs.roots" "Vocabulary roots"
2 [
[ "vocabs.loader.test.a" require ] must-fail
- [ f ] [ "vocabs.loader.test.a" vocab-source-loaded? ] unit-test
+ [ f ] [ "vocabs.loader.test.a" vocab source-loaded?>> ] unit-test
[ t ] [
"resource:core/vocabs/loader/test/a/a.factor"
] with-compilation-unit
] unit-test
-[ t ] [
+[ +done+ ] [
[ "vocabs.loader.test.d" require ] [ :1 ] recover
- "vocabs.loader.test.d" vocab-source-loaded?
+ "vocabs.loader.test.d" vocab source-loaded?>>
] unit-test
: forget-junk
[ "vocabs.loader.test.e" require ]
[ relative-overflow? ] must-fail-with
+
+0 "vocabs.loader.test.g" set-global
+
+[
+ "vocabs.loader.test.f" forget-vocab
+ "vocabs.loader.test.g" forget-vocab
+] with-compilation-unit
+
+[ ] [ "vocabs.loader.test.g" require ] unit-test
+
+[ 1 ] [ "vocabs.loader.test.g" get-global ] unit-test
+
+[
+ "vocabs.loader.test.h" forget-vocab
+ "vocabs.loader.test.i" forget-vocab
+] with-compilation-unit
+
+[ ] [ "vocabs.loader.test.h" require ] unit-test
vocab-name { { CHAR: . CHAR: / } } substitute ;
: vocab-dir+ ( vocab str/f -- path )
- >r vocab-name "." split r>
- [ >r dup peek r> append suffix ] when*
+ [ vocab-name "." split ] dip
+ [ [ dup peek ] dip append suffix ] when*
"/" join ;
: vocab-dir? ( root name -- ? )
- over [
- ".factor" vocab-dir+ append-path exists?
- ] [
- 2drop f
- ] if ;
+ over
+ [ ".factor" vocab-dir+ append-path exists? ]
+ [ 2drop f ]
+ if ;
SYMBOL: root-cache
H{ } clone root-cache set-global
+<PRIVATE
+
: (find-vocab-root) ( name -- path/f )
vocab-roots get swap [ vocab-dir? ] curry find nip ;
+PRIVATE>
+
: find-vocab-root ( vocab -- path/f )
vocab-name dup root-cache get at [ ] [ (find-vocab-root) ] ?if ;
SYMBOL: load-help?
-: load-source ( vocab -- vocab )
- f over set-vocab-source-loaded?
- [ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep
- t swap set-vocab-source-loaded?
- [ % ] [ assert-depth ] if-bootstrapping ;
+ERROR: circular-dependency name ;
-: load-docs ( vocab -- vocab )
- load-help? get [
- f over set-vocab-docs-loaded?
- [ vocab-docs-path [ ?run-file ] when* ] keep
- t swap set-vocab-docs-loaded?
- ] [ drop ] if ;
+<PRIVATE
-: reload ( name -- )
+: load-source ( vocab -- )
[
- dup vocab [ [ load-source ] [ load-docs ] bi ] [ no-vocab ] ?if
- ] with-compiler-errors ;
+ +parsing+ >>source-loaded?
+ dup vocab-source-path [ parse-file ] [ [ ] ] if*
+ [ % ] [ assert-depth ] if-bootstrapping
+ +done+ >>source-loaded? drop
+ ] [ ] [ f >>source-loaded? ] cleanup ;
+
+: load-docs ( vocab -- )
+ load-help? get [
+ [
+ +parsing+ >>docs-loaded?
+ [ vocab-docs-path [ ?run-file ] when* ] keep
+ +done+ >>docs-loaded?
+ ] [ ] [ f >>docs-loaded? ] cleanup
+ ] when drop ;
+
+PRIVATE>
: require ( vocab -- )
- load-vocab drop ;
+ [ load-vocab drop ] with-compiler-errors ;
+
+: reload ( name -- )
+ dup vocab
+ [ [ [ load-source ] [ load-docs ] bi ] with-compiler-errors ]
+ [ require ]
+ ?if ;
: run ( vocab -- )
dup load-vocab vocab-main [
SYMBOL: blacklist
+<PRIVATE
+
: add-to-blacklist ( error vocab -- )
vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
M: vocab (load-vocab)
[
- dup vocab-source-loaded? [ dup load-source ] unless
- dup vocab-docs-loaded? [ dup load-docs ] unless
- drop
+ dup source-loaded?>> +parsing+ eq? [
+ dup source-loaded?>> [ dup load-source ] unless
+ dup docs-loaded?>> [ dup load-docs ] unless
+ ] unless drop
] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
M: vocab-link (load-vocab)
[
[
- dup vocab-name blacklist get at* [
- rethrow
- ] [
- drop
- dup find-vocab-root [
- [ (load-vocab) ] with-compiler-errors
- ] [
- dup vocab [ drop ] [ no-vocab ] if
- ] if
+ dup vocab-name blacklist get at* [ rethrow ] [
+ drop dup find-vocab-root
+ [ [ (load-vocab) ] with-compiler-errors ]
+ [ dup vocab [ drop ] [ no-vocab ] if ]
+ if
] if
] with-compiler-errors
] load-vocab-hook set-global
+PRIVATE>
+
: vocab-where ( vocab -- loc )
vocab-source-path dup [ 1 2array ] when ;
--- /dev/null
+IN: vocabs.laoder.test.f
+USE: vocabs.loader
+
+"vocabs.loader.test.g" require
--- /dev/null
+unportable
--- /dev/null
+IN: vocabs.loader.test.g
+USING: vocabs.loader.test.f namespaces ;
+
+global [ "vocabs.loader.test.g" inc ] bind
--- /dev/null
+unportable
--- /dev/null
+USE: vocabs.loader.test.i
--- /dev/null
+unportable
--- /dev/null
+IN: vocabs.loader.test.i
+USE: vocabs.loader.test.h
--- /dev/null
+unportable
{ $values { "vocab-spec" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
{ $description "Outputs the words defined in a vocabulary." } ;
-HELP: vocab-source-loaded?
-{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
-{ $description "Outputs if the source for this vocubulary has been loaded." } ;
-
-HELP: vocab-docs-loaded?
-{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
-{ $description "Outputs if the documentation for this vocubulary has been loaded." } ;
-
HELP: words
{ $values { "vocab" string } { "seq" "a sequence of words" } }
{ $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
main help
source-loaded? docs-loaded? ;
+! sources-loaded? slot is one of these two
+SYMBOL: +parsing+
+SYMBOL: +running+
+SYMBOL: +done+
+
: <vocab> ( name -- vocab )
\ vocab new
swap >>name
M: f vocab-main ;
-GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
-
-M: vocab vocab-source-loaded? source-loaded?>> ;
-
-M: object vocab-source-loaded?
- vocab vocab-source-loaded? ;
-
-M: f vocab-source-loaded? ;
-
-GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
-
-M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
-
-M: object set-vocab-source-loaded?
- vocab set-vocab-source-loaded? ;
-
-M: f set-vocab-source-loaded? 2drop ;
-
-GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
-
-M: vocab vocab-docs-loaded? docs-loaded?>> ;
-
-M: object vocab-docs-loaded?
- vocab vocab-docs-loaded? ;
-
-M: f vocab-docs-loaded? ;
-
-GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
-
-M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
-
-M: object set-vocab-docs-loaded?
- vocab set-vocab-docs-loaded? ;
-
-M: f set-vocab-docs-loaded? 2drop ;
-
: create-vocab ( name -- vocab )
dictionary get [ <vocab> ] cache ;
M: array (quot-uses) seq-uses ;
-M: hashtable (quot-uses) >r >alist r> seq-uses ;
+M: hashtable (quot-uses) [ >alist ] dip seq-uses ;
M: callable (quot-uses) seq-uses ;
-M: wrapper (quot-uses) >r wrapped>> r> (quot-uses) ;
+M: wrapper (quot-uses) [ wrapped>> ] dip (quot-uses) ;
: quot-uses ( quot -- assoc )
global [ H{ } clone [ (quot-uses) ] keep ] bind ;
bi* 2bi ;
: compiled-xref ( word dependencies generic-dependencies -- )
- [ [ drop crossref? ] assoc-filter ] bi@
+ [ [ drop crossref? ] { } assoc-filter-as f like ] bi@
[ over ] dip
[ "compiled-uses" compiled-crossref (compiled-xref) ]
[ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
: (compiled-unxref) ( word word-prop variable -- )
[ [ [ dupd word-prop ] dip get remove-vertex* ] 2curry ]
- [ drop [ f swap set-word-prop ] curry ]
+ [ drop [ remove-word-prop ] curry ]
2bi bi ;
: compiled-unxref ( word -- )
dup [ 2nip ] [ drop <word> dup reveal ] if ;
: constructor-word ( name vocab -- word )
- >r "<" swap ">" 3append r> create ;
+ [ "<" swap ">" 3append ] dip create ;
PREDICATE: parsing-word < word "parsing" word-prop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: deep-fry ( quot -- quot )
- { _ } last-split1 dup
+ { _ } split1-last dup
[
shallow-fry [ >r ] rot
deep-fry [ [ dip ] curry r> compose ] 4array concat
MACRO: fry ( seq -- quot ) [fry] ;
-: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
\ No newline at end of file
+: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
] alien-callback\r
"int" { "int" } "cdecl" alien-indirect ;\r
\r
-: fib-main ( -- ) 25 fib drop ;\r
+: fib-main ( -- ) 34 fib drop ;\r
\r
MAIN: fib-main\r
[ t ] [
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
- [ regex-dna ] with-string-writer <string-reader> lines
+ [ regex-dna ] with-string-writer
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
- ascii file-lines =
+ ascii file-contents =
] unit-test
-USING: combinators.short-circuit kernel namespaces
+USING: kernel namespaces
math
math.constants
math.functions
math.physics.vel
combinators arrays sequences random vars
combinators.lib
+ combinators.short-circuit
accessors ;
IN: boids
2&& ;
: alignment-neighborhood ( self -- boids )
-boids> [ within-alignment-neighborhood? ] with filter ;
+ boids> [ within-alignment-neighborhood? ] with filter ;
: alignment-force ( self -- force )
alignment-neighborhood
! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
-USING: sequences math opengl.gadgets kernel
-byte-arrays cairo.ffi cairo io.backend
-ui.gadgets accessors opengl.gl
-arrays fry classes ;
+USING: sequences math kernel byte-arrays cairo.ffi cairo
+io.backend ui.gadgets accessors opengl.gl arrays fry
+classes ui.render namespaces ;
IN: cairo.gadgets
: width>stride ( width -- stride ) 4 * ;
-: copy-cairo ( dim quot -- byte-array )
- >r first2 over width>stride
- [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
+GENERIC: render-cairo* ( gadget -- )
+
+: render-cairo ( gadget -- byte-array )
+ dup dim>> first2 over width>stride
+ [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
[ cairo_image_surface_create_for_data ] 3bi
- r> with-cairo-from-surface ; inline
+ rot '[ _ render-cairo* ] with-cairo-from-surface ; inline
-TUPLE: cairo-gadget < texture-gadget ;
+TUPLE: cairo-gadget < gadget ;
: <cairo-gadget> ( dim -- gadget )
cairo-gadget new-gadget
swap >>dim ;
-M: cairo-gadget cache-key* [ dim>> ] [ class ] bi 2array ;
-
-: render-cairo ( dim quot -- bytes format )
- >r 2^-bounds r> copy-cairo GL_BGRA ; inline
-
-GENERIC: render-cairo* ( gadget -- )
-
-M: cairo-gadget render*
- [ dim>> dup ] [ '[ _ render-cairo* ] ] bi
- render-cairo render-bytes* ;
-
-! maybe also texture>png
-! : cairo>png ( gadget path -- )
-! >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
-! [ height>> ] tri over width>stride
-! cairo_image_surface_create_for_data
-! r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
+M: cairo-gadget draw-gadget*
+ [ dim>> ] [ render-cairo ] bi
+ origin get first2 glRasterPos2i
+ 1.0 -1.0 glPixelZoom
+ >r first2 GL_BGRA GL_UNSIGNED_BYTE r>
+ glDrawPixels ;
: copy-surface ( surface -- )
cr swap 0 0 cairo_set_source_surface
cr cairo_paint ;
-
-TUPLE: png-gadget < texture-gadget path ;
-: <png> ( path -- gadget )
- png-gadget new-gadget
- swap >>path ;
-
-M: png-gadget render*
- path>> normalize-path cairo_image_surface_create_from_png
- [ cairo_image_surface_get_width ]
- [ cairo_image_surface_get_height 2array dup 2^-bounds ]
- [ [ copy-surface ] curry copy-cairo ] tri
- GL_BGRA render-bytes* ;
-
-M: png-gadget cache-key* path>> ;
: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ;
-: cfdg-window* ( -- )
+: cfdg-window* ( -- slate )
C[ display ] <slate>
{ 500 500 } >>pdim
C[ delete-dlist ] >>ungraft
dup "CFDG" open-window ;
-: cfdg-window ( -- ) [ cfdg-window* ] with-ui ;
+: cfdg-window ( -- slate ) [ cfdg-window* ] with-ui ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+++ /dev/null
-
-USING: kernel namespaces sequences math
- listener io prettyprint sequences.lib bake bake.fry ;
-
-IN: display-stack
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: watched-variables
-
-: watch-var ( sym -- ) watched-variables get push ;
-
-: watch-vars ( seq -- ) watched-variables get [ push ] curry each ;
-
-: unwatch-var ( sym -- ) watched-variables get delete ;
-
-: unwatch-vars ( seq -- ) watched-variables get [ delete ] curry each ;
-
-: print-watched-variables ( -- )
- watched-variables get length 0 >
- [
- "----------" print
- watched-variables get
- watched-variables get [ unparse ] map longest length 2 +
- '[ [ unparse ": " append , 32 pad-right write ] [ get . ] bi ]
- each
-
- ]
- when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: display-stack ( -- )
- V{ } clone watched-variables set
- [
- print-watched-variables
- "----------" print
- datastack [ . ] each
- "----------" print
- retainstack reverse [ . ] each
- ]
- listener-hook set ;
-
cache-key* textures get delete-at*
[ tex>> delete-texture ] [ drop ] if ;
+: clear-textures ( -- )
+ textures get values [ tex>> delete-texture ] each
+ H{ } clone textures set-global
+ H{ } clone refcounts set-global ;
+
M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
M: texture-gadget ungraft* ( gadget -- )
;
STRING: plane-fragment-shader
+uniform float checker_size_inv;
+uniform vec4 checker_color_1, checker_color_2;
varying vec3 object_position;
+
+bool
+checker_color(vec3 p)
+{
+ vec3 pprime = checker_size_inv * object_position;
+ return fract((floor(pprime.x) + floor(pprime.z)) * 0.5) == 0.0;
+}
+
void
main()
{
float distance_factor = (gl_FragCoord.z * 0.5 + 0.5);
distance_factor = pow(distance_factor, 500.0)*0.5;
- gl_FragColor = fract((floor(0.125*object_position.x)+floor(0.125*object_position.z)) * 0.5) == 0.0
- ? vec4(1.0, 1.0 - distance_factor, 1.0 - distance_factor, 1.0)
- : vec4(1.0, distance_factor, distance_factor, 1.0);
+ gl_FragColor = checker_color(object_position)
+ ? mix(checker_color_1, checker_color_2, distance_factor)
+ : mix(checker_color_2, checker_color_1, distance_factor);
}
;
] with-gl-program
] [
plane-program>> [
- drop
+ {
+ [ "checker_size_inv" glGetUniformLocation 0.125 glUniform1f ]
+ [ "checker_color_1" glGetUniformLocation 1.0 0.5 0.0 1.0 glUniform4f ]
+ [ "checker_color_2" glGetUniformLocation 0.0 0.0 0.0 1.0 glUniform4f ]
+ } cleave
GL_QUADS [
-1000.0 -30.0 1000.0 glVertex3f
-1000.0 -30.0 -1000.0 glVertex3f
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors ui ui.gadgets ui.gadgets.buttons ui.render ;
+IN: ui.gadgets.broken
+
+! An intentionally broken gadget -- used to test UI error handling,
+! make sure that one bad gadget doesn't bring the whole system down
+
+: <bad-button> ( -- button )
+ "Click me if you dare"
+ [ "Haha" throw ]
+ <bevel-button> ;
+
+TUPLE: bad-gadget < gadget ;
+
+M: bad-gadget draw-gadget* "Lulz" throw ;
+
+M: bad-gadget pref-dim* drop { 100 100 } ;
+
+: <bad-gadget> ( -- gadget ) bad-gadget new-gadget ;
+
+: bad-gadget-test ( -- )
+ <bad-button> "Test 1" open-window
+ <bad-gadget> "Test 2" open-window ;
+
+MAIN: bad-gadget-test
(require 'font-lock)
(require 'comint)
+(require 'view)
;;; Customization:
:type '(file :must-match t)
:group 'factor)
+(defcustom factor-use-doc-window t
+ "When on, use a separate window to display help information.
+Disable to see that information in the factor-listener comint
+window."
+ :type 'boolean
+ :group 'factor)
+
+(defcustom factor-listener-use-other-window t
+ "Use a window other than the current buffer's when switching to
+the factor-listener buffer."
+ :type 'boolean
+ :group 'factor)
+
+(defcustom factor-listener-window-allow-split t
+ "Allow window splitting when switching to the factor-listener
+buffer."
+ :type 'boolean
+ :group 'factor)
+
+(defcustom factor-help-always-ask t
+ "When enabled, always ask for confirmation in help prompts."
+ :type 'boolean
+ :group 'factor)
+
(defcustom factor-display-compilation-output t
"Display the REPL buffer before compiling files."
:type 'boolean
:type 'hook
:group 'factor)
+(defcustom factor-help-mode-hook nil
+ "Hook run by `factor-help-mode'."
+ :type 'hook
+ :group 'factor)
+
(defgroup factor-faces nil
"Faces used in Factor mode"
:group 'factor
"Face for parsing words."
:group 'factor-faces)
+(defface factor-font-lock-help-mode-headlines '((t (:bold t :weight bold)))
+ "Face for headlines in help buffers."
+ :group 'factor-faces)
+
\f
;;; Factor mode font lock:
(defsubst factor--ppss-brackets-start ()
(nth 1 (syntax-ppss)))
-(defsubst factor--line-indent (pos)
+(defsubst factor--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation)))
(defconst factor--regex-closing-paren "[])}]")
(= (- (point) (line-beginning-position)) (current-indentation)))
(defconst factor--regex-single-liner
- (format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:" "PRIVATE>" "<PRIVATE" "USE:"))))
+ (format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:"
+ "PRIVATE>" "<PRIVATE" "SYMBOL:" "USE:"))))
(defsubst factor--at-begin-of-def ()
(looking-at "\\([^ ]\\|^\\)+:"))
(beginning-of-line)
(re-search-forward factor--regex-constructor (line-end-position) t)))
+(defsubst factor--increased-indentation (&optional i)
+ (+ (or i (current-indentation)) factor-indent-width))
+(defsubst factor--decreased-indentation (&optional i)
+ (- (or i (current-indentation)) factor-indent-width))
+
(defun factor--indent-in-brackets ()
(save-excursion
(beginning-of-line)
(let ((op (factor--ppss-brackets-start)))
(when (> (line-number-at-pos) (line-number-at-pos op))
(if (factor--at-closing-paren-p)
- (factor--line-indent op)
- (+ (factor--line-indent op) factor-indent-width)))))))
+ (factor--indentation-at op)
+ (factor--increased-indentation (factor--indentation-at op))))))))
(defun factor--indent-definition ()
(save-excursion
(defun factor--indent-setter-line ()
(when (factor--at-setter-line)
(save-excursion
- (beginning-of-line)
- (let ((indent (when (factor--at-constructor-line) (current-indentation))))
+ (let ((indent (and (factor--at-constructor-line) (current-indentation))))
(while (not (or indent
(bobp)
(factor--at-begin-of-def)
(factor--at-end-of-def)))
(if (factor--at-constructor-line)
- (setq indent (+ (current-indentation) factor-indent-width))
+ (setq indent (factor--increased-indentation))
(forward-line -1)))
indent))))
(defun factor--indent-continuation ()
(save-excursion
(forward-line -1)
- (beginning-of-line)
- (if (bobp) 0
- (if (factor--looking-at-emptiness)
- (factor--indent-continuation)
- (if (or (factor--at-end-of-def) (factor--at-setter-line))
- (- (current-indentation) factor-indent-width)
- (if (factor--at-begin-of-def)
- (+ (current-indentation) factor-indent-width)
- (current-indentation)))))))
+ (while (and (not (bobp)) (factor--looking-at-emptiness))
+ (forward-line -1))
+ (if (or (factor--at-end-of-def) (factor--at-setter-line))
+ (factor--decreased-indentation)
+ (if (factor--at-begin-of-def)
+ (factor--increased-indentation)
+ (current-indentation)))))
(defun factor--calculate-indentation ()
"Calculate Factor indentation for line at point."
(factor-send-region (search-backward ":")
(search-forward ";")))
-(defun factor-see ()
- (interactive)
- (comint-send-string "*factor*" "\\ ")
- (comint-send-string "*factor*" (thing-at-point 'sexp))
- (comint-send-string "*factor*" " see\n"))
-
-(defun factor-help ()
- (interactive)
- (comint-send-string "*factor*" "\\ ")
- (comint-send-string "*factor*" (thing-at-point 'sexp))
- (comint-send-string "*factor*" " help\n"))
-
(defun factor-edit ()
(interactive)
(comint-send-string "*factor*" "\\ ")
(defvar factor-mode-map (make-sparse-keymap)
"Key map used by Factor mode.")
-(define-key factor-mode-map "\C-c\C-f" 'factor-run-file)
-(define-key factor-mode-map "\C-c\C-r" 'factor-send-region)
-(define-key factor-mode-map "\C-c\C-d" 'factor-send-definition)
-(define-key factor-mode-map "\C-c\C-s" 'factor-see)
-(define-key factor-mode-map "\C-ce" 'factor-edit)
-(define-key factor-mode-map "\C-c\C-h" 'factor-help)
-(define-key factor-mode-map "\C-cc" 'comment-region)
-(define-key factor-mode-map [return] 'newline-and-indent)
-(define-key factor-mode-map [tab] 'indent-for-tab-command)
-
-
\f
;; Factor mode:
(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
\f
-;;; Factor listener mode
+;;; Factor listener mode:
;;;###autoload
-(define-derived-mode factor-listener-mode comint-mode "Factor Listener")
-
-(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
+(define-derived-mode factor-listener-mode comint-mode "Factor Listener"
+ "Major mode for interacting with an inferior Factor listener process.
+\\{factor-listener-mode-map}"
+ (set (make-local-variable 'comint-prompt-regexp) "^( [^)]+ ) "))
+
+(defvar factor--listener-buffer nil
+ "The buffer in which the Factor listener is running.")
+
+(defun factor--listener-start-process ()
+ "Start an inferior Factor listener process, using
+`factor-binary' and `factor-image'."
+ (setq factor--listener-buffer
+ (apply 'make-comint "factor" (expand-file-name factor-binary) nil
+ `("-run=listener" ,(format "-i=%s" (expand-file-name factor-image)))))
+ (with-current-buffer factor--listener-buffer
+ (factor-listener-mode)))
+
+(defun factor--listener-process ()
+ (or (and (buffer-live-p factor--listener-buffer)
+ (get-buffer-process factor--listener-buffer))
+ (progn (factor--listener-start-process)
+ (factor--listener-process))))
;;;###autoload
-(defun run-factor ()
- "Start a factor listener inside emacs, or switch to it if it
-already exists."
+(defalias 'switch-to-factor 'run-factor)
+;;;###autoload
+(defun run-factor (&optional arg)
+ "Show the factor-listener buffer, starting the process if needed."
(interactive)
- (switch-to-buffer
- (make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil
- (concat "-i=" (expand-file-name factor-image))
- "-run=listener"))
- (factor-listener-mode))
+ (let ((buf (process-buffer (factor--listener-process)))
+ (pop-up-windows factor-listener-window-allow-split))
+ (if factor-listener-use-other-window
+ (pop-to-buffer buf)
+ (switch-to-buffer buf))))
+
+\f
+;;;; Factor help mode:
+
+(defvar factor-help-mode-map (make-sparse-keymap)
+ "Keymap for Factor help mode.")
+
+(defconst factor--help-headlines
+ (regexp-opt '("Parent topics:"
+ "Inputs and outputs"
+ "Word description"
+ "Generic word contract"
+ "Vocabulary"
+ "Definition")
+ t))
+
+(defconst factor--help-headlines-regexp (format "^%s" factor--help-headlines))
+
+(defconst factor--help-font-lock-keywords
+ `((,factor--help-headlines-regexp . 'factor-font-lock-help-mode-headlines)
+ ,@factor-font-lock-keywords))
+
+(defun factor-help-mode ()
+ "Major mode for displaying Factor help messages.
+\\{factor-help-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map factor-help-mode-map)
+ (setq mode-name "Factor Help")
+ (setq major-mode 'factor-help-mode)
+ (set (make-local-variable 'font-lock-defaults)
+ '(factor--help-font-lock-keywords t nil nil nil))
+ (set (make-local-variable 'comint-redirect-subvert-readonly) t)
+ (set (make-local-variable 'view-no-disable-on-exit) t)
+ (view-mode)
+ (setq view-exit-action
+ (lambda (buffer)
+ ;; Use `with-current-buffer' to make sure that `bury-buffer'
+ ;; also removes BUFFER from the selected window.
+ (with-current-buffer buffer
+ (bury-buffer))))
+ (run-mode-hooks 'factor-help-mode-hook))
+
+(defun factor--listener-help-buffer ()
+ (set-buffer (get-buffer-create "*factor-help*"))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max)))
+ (factor-help-mode)
+ (current-buffer))
+
+(defvar factor--help-history nil)
+
+(defun factor--listener-show-help (&optional see)
+ (let* ((def (thing-at-point 'sexp))
+ (prompt (format "%s (%s): " (if see "See" "Help") def))
+ (ask (or (not (eq major-mode 'factor-mode))
+ (not def)
+ factor-help-always-ask))
+ (cmd (format "\\ %s %s"
+ (if ask (read-string prompt nil 'factor--help-history def) def)
+ (if see "see" "help")))
+ (hb (factor--listener-help-buffer))
+ (proc (factor--listener-process)))
+ (comint-redirect-send-command-to-process cmd hb proc nil)
+ (pop-to-buffer hb)))
+
+(defun factor-see ()
+ (interactive)
+ (factor--listener-show-help t))
+
+(defun factor-help ()
+ (interactive)
+ (factor--listener-show-help))
+
+\f
(defun factor-refresh-all ()
"Reload source files and documentation for all loaded
(comint-send-string "*factor*" "refresh-all\n"))
\f
+;;; Key bindings:
+(defmacro factor--define-key (key cmd)
+ `(progn
+ (define-key factor-mode-map [(control ?c) ,key] ,cmd)
+ (define-key factor-mode-map [(control ?c) (control ,key)] ,cmd)))
+
+(factor--define-key ?f 'factor-run-file)
+(factor--define-key ?r 'factor-send-region)
+(factor--define-key ?d 'factor-send-definition)
+(factor--define-key ?s 'factor-see)
+(factor--define-key ?e 'factor-edit)
+(factor--define-key ?z 'switch-to-factor)
+(factor--define-key ?c 'comment-region)
+
+(define-key factor-mode-map "\C-ch" 'factor-help)
+(define-key factor-mode-map "\C-m" 'newline-and-indent)
+(define-key factor-mode-map [tab] 'indent-for-tab-command)
+
+(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
+
+
+\f
(provide 'factor)
;;; factor.el ends here
+++ /dev/null
-
-USING: kernel words accessors
- classes
- classes.builtin
- classes.tuple
- classes.predicate
- vocabs
- arrays
- sequences sorting
- io help.markup
- effects
- generic
- prettyprint
- prettyprint.sections
- prettyprint.backend
- combinators.cleave
- obj.print ;
-
-IN: vocab-browser
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: word-effect-as-string ( word -- string )
- stack-effect dup
- [ effect>string ]
- [ drop "" ]
- if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: print-vocabulary-summary ( vocabulary -- )
-
- dup vocab words [ builtin-class? ] filter natural-sort
- dup empty?
- [ drop ]
- [
- "Builtin Classes" $heading nl
- print-seq
- ]
- if
-
- dup vocab words [ tuple-class? ] filter natural-sort
- dup empty?
- [ drop ]
- [
- "Tuple Classes" $heading nl
- [
- { [ ] [ superclass ] [ "slots" word-prop [ name>> ] map " " join ] }
- 1arr
- ]
- map
- { "CLASS" "PARENT" "SLOTS" } prefix
- print-table
- ]
- if
-
- dup vocab words [ predicate-class? ] filter natural-sort
- dup empty?
- [ drop ]
- [
- "Predicate Classes" $heading nl
- ! [ pprint-class ] each
- [ { [ ] [ superclass ] } 1arr ] map
- { "CLASS" "SUPERCLASS" } prefix
- print-table
- ]
- if
-
- dup vocab words [ class? not ] filter [ symbol? ] filter natural-sort
- dup empty?
- [ drop ]
- [
- "Symbols" $heading nl
- print-seq
- ]
- if
-
- dup vocab words [ generic? ] filter natural-sort
- dup empty?
- [ drop ]
- [
- "Generic words" $heading nl
- [ [ ] [ stack-effect effect>string ] bi 2array ] map
- print-table
- ]
- if
-
- "Words" $heading nl
- dup vocab words
- [ predicate-class? not ] filter
- [ builtin-class? not ] filter
- [ tuple-class? not ] filter
- [ generic? not ] filter
- [ symbol? not ] filter
- [ word? ] filter
- natural-sort
- [ [ ] [ word-effect-as-string ] bi 2array ] map
- print-table
-
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: vocabs.loader tools.vocabs.browser ;
-
-: $vocab-summary ( seq -- )
- first
- dup vocab
- [
- dup print-vocabulary-summary
- dup describe-help
- ! dup describe-uses
- ! dup describe-usage
- ]
- when
- dup find-vocab-root
- [
- dup describe-summary
- dup describe-tags
- dup describe-authors
- ! dup describe-files
- ]
- when
- ! dup describe-children
- drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: assocs ui.tools.browser ui.operations io.styles ;
-
-! IN: tools.vocabs.browser
-
-! : $describe-vocab ( element -- ) $vocab-summary ;
-
-USING: tools.vocabs ;
-
-: print-vocabs ( -- )
- vocabs
- [ { [ vocab ] [ vocab-summary ] } 1arr ]
- map
- print-table ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : $all-vocabs ( seq -- ) drop print-vocabs ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: help.syntax help.topics ;
-
-! ARTICLE: "vocab-index" "Vocabulary Index" { $all-vocabs } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: vocab-spec article-content ( vocab-spec -- content )
- { $vocab-summary } swap name>> suffix ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: loaded-and-unloaded-vocabs ( -- seq )
- "" all-child-vocabs values concat [ name>> ] map ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! ARTICLE: "loaded-vocabs-index" "Loaded Vocabularies" { $loaded-vocabs } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: debugger ;
-
-TUPLE: load-this-vocab name ;
-
-! : do-load-vocab ( ltv -- )
-! dup name>> require
-! name>> vocab com-follow ;
-
-: do-load-vocab ( ltv -- )
- [
- dup name>> require
- name>> vocab com-follow
- ]
- curry
- try ;
-
-[ load-this-vocab? ] \ do-load-vocab { { +primary+ t } } define-operation
-
-M: load-this-vocab pprint* ( obj -- )
- [ name>> "*" append ] [ ] bi write-object ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: vocab-or-loader ( name -- obj )
- dup vocab
- [ vocab ]
- [ load-this-vocab boa ]
- if ;
-
-: vocab-summary-text ( vocab-name -- text )
- dup vocab-summary-path vocab-file-contents
- dup empty?
- [ drop "" ]
- [ first ]
- if ;
-
-! : vocab-table-entry ( vocab-name -- seq )
-! { [ vocab-or-loader ] [ vocab-summary ] } 1arr ;
-
-: vocab-table-entry ( vocab-name -- seq )
- { [ vocab-or-loader ] [ vocab-summary-text ] } 1arr ;
-
-: print-these-vocabs ( seq -- ) [ vocab-table-entry ] map print-table ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : vocab-list ( -- seq ) "" all-child-vocabs values concat [ name>> ] map ;
-
-: all-vocab-names ( -- seq )
- all-vocabs values concat [ name>> ] map natural-sort ;
-
-: loaded-vocab-names ( -- seq ) all-vocab-names [ vocab ] filter ;
-
-: unloaded-vocab-names ( -- seq ) all-vocab-names [ vocab not ] filter ;
-
-: root->names ( root -- seq ) all-vocabs at [ name>> ] map natural-sort ;
-
-: vocab-names-core ( -- seq ) "resource:core" root->names ;
-: vocab-names-basis ( -- seq ) "resource:basis" root->names ;
-: vocab-names-extra ( -- seq ) "resource:extra" root->names ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: $all-vocabs ( seq -- ) drop all-vocab-names print-these-vocabs ;
-: $loaded-vocabs ( seq -- ) drop loaded-vocab-names print-these-vocabs ;
-: $unloaded-vocabs ( seq -- ) drop unloaded-vocab-names print-these-vocabs ;
-
-: $vocabs-core ( seq -- ) drop vocab-names-core print-these-vocabs ;
-: $vocabs-basis ( seq -- ) drop vocab-names-basis print-these-vocabs ;
-: $vocabs-extra ( seq -- ) drop vocab-names-extra print-these-vocabs ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! { "" }
-
-! all-child-vocabs values concat [ name>> ] map
-
-! : vocab-tree ( vocab -- seq )
-! dup
-! all-child-vocabs values concat [ name>> ] map prune
-! [ vocab-tree ]
-! map
-! concat
-! swap prefix
-! [ vocab-source-path ] filter ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: vocab-author pprint* ( vocab-author -- ) [ name>> ] [ ] bi write-object ;
-
-: $vocab-authors ( seq -- )
- drop all-authors [ vocab-author boa ] map print-seq ;
-
-ARTICLE: "vocab-authors" "Vocabulary Authors" { $vocab-authors } ;
-
-: vocabs-by-author ( author -- vocab-names )
- authored values concat [ name>> ] map ;
-
-: $vocabs-by-author ( seq -- )
- first name>> vocabs-by-author print-these-vocabs ;
-
-M: vocab-author article-content ( vocab-author -- content )
- { $vocabs-by-author } swap suffix ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-M: vocab-tag pprint* ( vocab-tag -- ) [ name>> ] [ ] bi write-object ;
-
-: print-vocab-tags ( -- ) all-tags [ vocab-tag boa ] map print-seq ;
-
-: $vocab-tags ( seq -- ) drop print-vocab-tags ;
-
-ARTICLE: "vocab-tags" "Vocabulary Tags" { $vocab-tags } ;
-
-: $vocabs-with-tag ( seq -- )
- first tagged values concat [ name>> ] map print-these-vocabs ;
-
-M: vocab-tag article-content ( vocab-tag -- content )
- name>> { $vocabs-with-tag } swap suffix ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-ARTICLE: "vocab-index-all" "All Vocabularies" { $all-vocabs } ;
-ARTICLE: "vocab-index-loaded" "Loaded Vocabularies" { $loaded-vocabs } ;
-ARTICLE: "vocab-index-unloaded" "Unloaded Vocabularies" { $loaded-vocabs } ;
-
-ARTICLE: "vocab-index-core" "Core Vocabularies" { $vocabs-core } ;
-ARTICLE: "vocab-index-basis" "Basis Vocabularies" { $vocabs-basis } ;
-ARTICLE: "vocab-index-extra" "Extra Vocabularies" { $vocabs-extra } ;
-
-ARTICLE: "vocab-indices" "Vocabulary Indices"
- { $subsection "vocab-index-core" }
- { $subsection "vocab-index-basis" }
- { $subsection "vocab-index-extra" }
- { $subsection "vocab-index-all" }
- { $subsection "vocab-index-loaded" }
- { $subsection "vocab-index-unloaded" }
- { $subsection "vocab-authors" }
- { $subsection "vocab-tags" } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+++ /dev/null
-USING: kernel ;
-
-REQUIRES: libs/calendar libs/shuffle ;
-
-PROVIDE: libs/io
-{ +files+ {
- "io.factor"
- "mmap.factor"
- "shell.factor"
- { "os-unix.factor" [ unix? ] }
- { "os-unix-shell.factor" [ unix? ] }
- { "mmap-os-unix.factor" [ unix? ] }
-
- { "os-winnt.factor" [ winnt? ] }
- { "os-winnt-shell.factor" [ winnt? ] }
- { "mmap-os-winnt.factor" [ winnt? ] }
-
- { "os-wince.factor" [ wince? ] }
-} }
-{ +tests+ {
- "test/io.factor"
- "test/mmap.factor"
-} } ;
-
+++ /dev/null
-USING: arrays kernel libs-io sequences prettyprint unix-internals
-calendar namespaces math ;
-USE: io
-IN: shell
-
-TUPLE: unix-shell ;
-
-T{ unix-shell } \ shell set-global
-
-TUPLE: file name mode nlink uid gid size mtime symbol ;
-
-M: unix-shell directory* ( path -- seq )
- dup (directory) [ tuck >r "/" r> 3append stat* 2array ] map-with ;
-
-M: unix-shell make-file ( path -- file )
- first2
- [ stat-mode ] keep
- [ stat-nlink ] keep
- [ stat-uid ] keep
- [ stat-gid ] keep
- [ stat-size ] keep
- [ stat-mtime timespec>timestamp >local-time ] keep
- stat-mode mode>symbol <file> ;
-
-M: unix-shell file. ( file -- )
- [ [ file-mode >oct write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-nlink unparse write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-uid unparse write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-gid unparse write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-size unparse write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-mtime file-time-string write ] keep ] with-cell
- [ bl ] with-cell
- [ file-name write ] with-cell ;
-
-USE: unix-internals
-M: unix-shell touch-file ( path -- )
- dup open-append dup -1 = [
- drop now dup set-file-times
- ] [
- nip [ now dup set-file-times* ] keep close
- ] if ;
+++ /dev/null
-! Copyright (C) 2007 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays calendar errors io io-internals kernel
-math nonblocking-io sequences unix-internals unix-io ;
-IN: libs-io
-
-: O_APPEND HEX: 100 ; inline
-: O_EXCL HEX: 800 ; inline
-: SEEK_SET 0 ; inline
-: SEEK_CUR 1 ; inline
-: SEEK_END 2 ; inline
-: EEXIST 17 ; inline
-
-: mode>symbol ( mode -- ch )
- S_IFMT bitand
- {
- { [ dup S_IFDIR = ] [ drop "/" ] }
- { [ dup S_IFIFO = ] [ drop "|" ] }
- { [ dup S_IXUSR = ] [ drop "*" ] }
- { [ dup S_IFLNK = ] [ drop "@" ] }
- { [ dup S_IFWHT = ] [ drop "%" ] }
- { [ dup S_IFSOCK = ] [ drop "=" ] }
- { [ t ] [ drop "" ] }
- } cond ;
+++ /dev/null
-USING: alien calendar io io-internals kernel libs-io math
-namespaces prettyprint sequences windows-api ;
-IN: shell
-
-TUPLE: winnt-shell ;
-
-T{ winnt-shell } \ shell set-global
-
-TUPLE: file name size mtime attributes ;
-
-: ((directory*)) ( handle -- )
- "WIN32_FIND_DATA" <c-object> [ FindNextFile ] 2keep
- rot zero? [ 2drop ] [ , ((directory*)) ] if ;
-
-: (directory*) ( path -- )
- "WIN32_FIND_DATA" <c-object> [
- FindFirstFile dup INVALID_HANDLE_VALUE = [
- win32-error
- ] when
- ] keep ,
- [ ((directory*)) ] keep FindClose win32-error=0/f ;
-
-: append-star ( path -- path )
- dup peek CHAR: \\ = "*" "\\*" ? append ;
-
-M: winnt-shell directory* ( path -- seq )
- normalize-pathname append-star [ (directory*) ] { } make ;
-
-: WIN32_FIND_DATA>file-size ( WIN32_FILE_ATTRIBUTE_DATA -- n )
- [ WIN32_FIND_DATA-nFileSizeLow ] keep
- WIN32_FIND_DATA-nFileSizeHigh 32 shift + ;
-
-M: winnt-shell make-file ( WIN32_FIND_DATA -- file )
- [ WIN32_FIND_DATA-cFileName alien>u16-string ] keep
- [ WIN32_FIND_DATA>file-size ] keep
- [
- WIN32_FIND_DATA-ftCreationTime
- FILETIME>timestamp >local-time
- ] keep
- WIN32_FIND_DATA-dwFileAttributes <file> ;
-
-M: winnt-shell file. ( file -- )
- [ [ file-attributes >oct write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-size unparse write ] keep ] with-cell
- [ bl ] with-cell
- [ [ file-mtime file-time-string write ] keep ] with-cell
- [ bl ] with-cell
- [ file-name write ] with-cell ;
-
-M: winnt-shell touch-file ( path -- )
- #! Set the file write time to 'now'
- normalize-pathname
- dup maybe-create-file [ drop ] [ now set-file-write-time ] if ;
-
+++ /dev/null
-USING: alien calendar errors generic io io-internals kernel
-math namespaces nonblocking-io parser quotations sequences
-shuffle windows-api words ;
-IN: libs-io
-
-: stat* ( path -- WIN32_FIND_DATA )
- "WIN32_FIND_DATA" <c-object>
- [
- FindFirstFile
- [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
- FindClose win32-error=0/f
- ] keep ;
-
-: set-file-time ( path timestamp/f timestamp/f timestamp/f -- )
- #! timestamp order: creation access write
- >r >r >r open-existing dup r> r> r>
- [ timestamp>FILETIME ] 3 napply
- SetFileTime win32-error=0/f
- close-handle ;
-
-: set-file-times ( path timestamp/f timestamp/f -- )
- f -rot set-file-time ;
-
-: set-file-create-time ( path timestamp -- )
- f f set-file-time ;
-
-: set-file-access-time ( path timestamp -- )
- >r f r> f set-file-time ;
-
-: set-file-write-time ( path timestamp -- )
- >r f f r> set-file-time ;
-
-: maybe-make-filetime ( ? -- FILETIME/f )
- [ "FILETIME" <c-object> ] [ f ] if ;
-
-: file-time ( path ? ? ? -- FILETIME/f FILETIME/f FILETIME/f )
- >r >r >r open-existing dup r> r> r>
- [ maybe-make-filetime ] 3 napply
- [ GetFileTime win32-error=0/f close-handle ] 3keep ;
-
-: file-times ( path -- FILETIME FILETIME FILETIME )
- t t t file-time [ FILETIME>timestamp ] 3 napply ;
-
-: file-create-time ( path -- FILETIME )
- t f f file-time 2drop FILETIME>timestamp ;
-
-: file-access-time ( path -- FILETIME )
- f t f file-time drop nip FILETIME>timestamp ;
-
-: file-write-time ( path -- FILETIME )
- f f t file-time 2nip FILETIME>timestamp ;
-
-: attrib ( path -- n )
- [ stat* WIN32_FIND_DATA-dwFileAttributes ] catch
- [ drop 0 ] when ;
-
-: (read-only?) ( mode -- ? )
- FILE_ATTRIBUTE_READONLY bit-set? ;
-
-: read-only? ( path -- ? )
- attrib (read-only?) ;
-
-: (hidden?) ( mode -- ? )
- FILE_ATTRIBUTE_HIDDEN bit-set? ;
-
-: hidden? ( path -- ? )
- attrib (hidden?) ;
-
-: (system?) ( mode -- ? )
- FILE_ATTRIBUTE_SYSTEM bit-set? ;
-
-: system? ( path -- ? )
- attrib (system?) ;
-
-: (directory?) ( mode -- ? )
- FILE_ATTRIBUTE_DIRECTORY bit-set? ;
-
-: directory? ( path -- ? )
- attrib (directory?) ;
-
-: (archive?) ( mode -- ? )
- FILE_ATTRIBUTE_ARCHIVE bit-set? ;
-
-: archive? ( path -- ? )
- attrib (archive?) ;
-
-! FILE_ATTRIBUTE_DEVICE
-! FILE_ATTRIBUTE_NORMAL
-! FILE_ATTRIBUTE_TEMPORARY
-! FILE_ATTRIBUTE_SPARSE_FILE
-! FILE_ATTRIBUTE_REPARSE_POINT
-! FILE_ATTRIBUTE_COMPRESSED
-! FILE_ATTRIBUTE_OFFLINE
-! FILE_ATTRIBUTE_NOT_CONTENT_INDEXED
-! FILE_ATTRIBUTE_ENCRYPTED
-
+++ /dev/null
-USING: calendar io io-internals kernel math namespaces
-nonblocking-io prettyprint quotations sequences ;
-IN: shell
-
-SYMBOL: shell
-HOOK: directory* shell ( path -- seq )
-HOOK: make-file shell ( bytes -- file )
-HOOK: file. shell ( file -- )
-HOOK: touch-file shell ( path -- )
-
-: (ls) ( path -- )
- >r H{ } r> directory*
- [
- [ [ make-file file. ] with-row ] each
- ] curry tabular-output ;
-
-: ls ( -- )
- cwd (ls) ;
-
-: pwd ( -- )
- cwd pprint nl ;
-
-: (slurp) ( quot -- )
- >r default-buffer-size read r> over [
- dup slip (slurp)
- ] [
- 2drop
- ] if ;
-
-: slurp ( stream quot -- )
- [ (slurp) ] curry with-stream ;
-
-: cat ( path -- )
- <file-reader> stdio get
- duplex-stream-out <duplex-stream>
- [ write ] slurp ;
-
-: copy-file ( path path -- )
- >r <file-reader> r>
- <file-writer> <duplex-stream> [ write ] slurp ;
+++ /dev/null
-USING: calendar errors io kernel libs-io math namespaces sequences\r
-shell test ;\r
-IN: temporary\r
-\r
-SYMBOL: file "file-appender-test.txt" \ file set\r
-[ \ file get delete-file ] catch drop\r
-[ f ] [ \ file get exists? ] unit-test\r
-\ file get <file-appender> [ "asdf" write ] with-stream\r
-[ t ] [ \ file get exists? ] unit-test\r
-[ 4 ] [ \ file get file-length ] unit-test\r
-\ file get <file-appender> [ "jkl;" write ] with-stream\r
-[ t ] [ \ file get exists? ] unit-test\r
-[ 8 ] [ \ file get file-length ] unit-test\r
-[ "asdfjkl;" ] [ \ file get <file-reader> contents ] unit-test\r
-\ file get delete-file\r
-[ f ] [ \ file get exists? ] unit-test\r
-\r
-SYMBOL: directory "test-directory" \ directory set\r
-\ directory get create-directory\r
-[ t ] [ \ directory get directory? ] unit-test\r
-\ directory get delete-directory\r
-[ f ] [ \ directory get directory? ] unit-test\r
-\r
-SYMBOL: time "time-test.txt" \ time set\r
-[ \ time get delete-file ] catch drop\r
-\ time get touch-file\r
-[ 0 ] [ \ time get file-length ] unit-test\r
-[ t ] [ \ time get exists? ] unit-test\r
-\ time get 0 unix-time>timestamp dup set-file-times\r
-[ t ] [ \ time get file-write-time 0 unix-time>timestamp = ] unit-test\r
-[ t ] [ \ time get file-access-time 0 unix-time>timestamp = ] unit-test\r
-\ time get touch-file\r
-[ t ] [ now \ time get file-write-time timestamp- 10 < ] unit-test\r
-\ time get delete-file\r
-\r
-SYMBOL: longname "" 255 CHAR: a pad-left \ longname set\r
-\ longname get touch-file\r
-[ t ] [ \ longname get exists? ] unit-test\r
-[ 0 ] [ \ longname get file-length ] unit-test\r
-\ longname get delete-file\r
-[ f ] [ \ longname get exists? ] unit-test\r
-\r
+++ /dev/null
-USING: alien errors io kernel libs-io mmap namespaces test ;\r
-\r
-IN: temporary\r
-SYMBOL: mmap "mmap-test.txt" \ mmap set\r
-\r
-[ \ mmap get delete-file ] catch drop\r
-\ mmap get [\r
- "Four" write\r
-] with-file-writer\r
-\r
-\ mmap get [\r
- >r CHAR: R r> mmap-address 3 set-alien-unsigned-1\r
-] with-mmap\r
-\r
-\ mmap get [\r
- mmap-address 3 alien-unsigned-1 CHAR: R = [\r
- "mmap test failed" throw\r
- ] unless\r
-] with-mmap\r
-\r
-[ \ mmap get delete-file ] catch drop\r
print_obj(frame_scan(frame));
print_string("\n");
print_cell_hex((CELL)frame_executing(frame));
+ print_string(" ");
print_cell_hex((CELL)frame->xt);
+ print_string("\n");
}
void print_callstack(void)
#define POP_FIXNUMS(x,y) \
F_FIXNUM y = untag_fixnum_fast(dpop()); \
- F_FIXNUM x = untag_fixnum_fast(dpop());
+ F_FIXNUM x = untag_fixnum_fast(dpeek());
void primitive_fixnum_add(void)
{
POP_FIXNUMS(x,y)
- box_signed_cell(x + y);
+ drepl(allot_integer(x + y));
}
void primitive_fixnum_subtract(void)
{
POP_FIXNUMS(x,y)
- box_signed_cell(x - y);
+ drepl(allot_integer(x - y));
}
/* Multiply two integers, and trap overflow.
POP_FIXNUMS(x,y)
if(x == 0 || y == 0)
- dpush(tag_fixnum(0));
+ drepl(tag_fixnum(0));
else
{
F_FIXNUM prod = x * y;
/* if this is not equal, we have overflow */
if(prod / x == y)
- box_signed_cell(prod);
+ drepl(allot_integer(prod));
else
{
F_ARRAY *bx = fixnum_to_bignum(x);
REGISTER_BIGNUM(bx);
F_ARRAY *by = fixnum_to_bignum(y);
UNREGISTER_BIGNUM(bx);
- dpush(tag_bignum(bignum_multiply(bx,by)));
+ drepl(tag_bignum(bignum_multiply(bx,by)));
}
}
}
void primitive_fixnum_divint(void)
{
POP_FIXNUMS(x,y)
- box_signed_cell(x / y);
+ F_FIXNUM result = x / y;
+ if(result == -FIXNUM_MIN)
+ drepl(allot_integer(-FIXNUM_MIN));
+ else
+ drepl(tag_fixnum(result));
}
void primitive_fixnum_divmod(void)
{
- POP_FIXNUMS(x,y)
- box_signed_cell(x / y);
- dpush(tag_fixnum(x % y));
+ F_FIXNUM y = get(ds);
+ F_FIXNUM x = get(ds - CELLS);
+ if(y == tag_fixnum(-1) && x == tag_fixnum(FIXNUM_MIN))
+ {
+ put(ds - CELLS,allot_integer(-FIXNUM_MIN));
+ put(ds,tag_fixnum(0));
+ }
+ else
+ {
+ put(ds - CELLS,tag_fixnum(x / y));
+ put(ds,x % y);
+ }
}
/*
if(x == 0 || y == 0)
{
- dpush(tag_fixnum(x));
+ drepl(tag_fixnum(x));
return;
}
else if(y < 0)
{
if(y <= -WORD_SIZE)
- dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
+ drepl(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
else
- dpush(tag_fixnum(x >> -y));
+ drepl(tag_fixnum(x >> -y));
return;
}
else if(y < WORD_SIZE - TAG_BITS)
F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
{
- dpush(tag_fixnum(x << y));
+ drepl(tag_fixnum(x << y));
return;
}
}
- dpush(tag_bignum(bignum_arithmetic_shift(
+ drepl(tag_bignum(bignum_arithmetic_shift(
fixnum_to_bignum(x),y)));
}
#define UAP_PROGRAM_COUNTER(uap) _UC_MACHINE_PC((ucontext_t *)uap)
-#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
&& array_nth(array,i + 1) == userenv[JIT_DISPATCH_WORD];
}
+bool jit_fast_dip_p(F_ARRAY *array, CELL i)
+{
+ return (i + 2) <= array_capacity(array)
+ && type_of(array_nth(array,i)) == QUOTATION_TYPE
+ && array_nth(array,i + 1) == userenv[JIT_DIP_WORD];
+}
+
+bool jit_fast_2dip_p(F_ARRAY *array, CELL i)
+{
+ return (i + 2) <= array_capacity(array)
+ && type_of(array_nth(array,i)) == QUOTATION_TYPE
+ && array_nth(array,i + 1) == userenv[JIT_2DIP_WORD];
+}
+
+bool jit_fast_3dip_p(F_ARRAY *array, CELL i)
+{
+ return (i + 2) <= array_capacity(array)
+ && type_of(array_nth(array,i)) == QUOTATION_TYPE
+ && array_nth(array,i + 1) == userenv[JIT_3DIP_WORD];
+}
+
bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
{
return (i + 1) < array_capacity(array)
if(word->subprimitive == F && obj != userenv[JIT_DECLARE_WORD])
return true;
}
+ else if(type_of(obj) == QUOTATION_TYPE)
+ {
+ if(jit_fast_dip_p(array,i)
+ || jit_fast_2dip_p(array,i)
+ || jit_fast_3dip_p(array,i))
+ return true;
+ }
}
return false;
tail_call = true;
break;
}
+ else if(jit_fast_dip_p(untag_object(array),i))
+ {
+ GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
+ EMIT(userenv[JIT_DIP],literals_count - 1);
+
+ i++;
+ break;
+ }
+ else if(jit_fast_2dip_p(untag_object(array),i))
+ {
+ GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
+ EMIT(userenv[JIT_2DIP],literals_count - 1);
+
+ i++;
+ break;
+ }
+ else if(jit_fast_3dip_p(untag_object(array),i))
+ {
+ GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
+ EMIT(userenv[JIT_3DIP],literals_count - 1);
+
+ i++;
+ break;
+ }
case ARRAY_TYPE:
if(jit_fast_dispatch_p(untag_object(array),i))
{
tail_call = true;
break;
}
+ else if(jit_fast_dip_p(untag_object(array),i))
+ {
+ i++;
+ COUNT(userenv[JIT_DIP],i)
+ break;
+ }
+ else if(jit_fast_2dip_p(untag_object(array),i))
+ {
+ i++;
+ COUNT(userenv[JIT_2DIP],i)
+ break;
+ }
+ else if(jit_fast_3dip_p(untag_object(array),i))
+ {
+ i++;
+ COUNT(userenv[JIT_3DIP],i)
+ break;
+ }
case ARRAY_TYPE:
if(jit_fast_dispatch_p(untag_object(array),i))
{
}
}
+F_CONTEXT *alloc_context(void)
+{
+ F_CONTEXT *context;
+
+ if(unused_contexts)
+ {
+ context = unused_contexts;
+ unused_contexts = unused_contexts->next;
+ }
+ else
+ {
+ context = safe_malloc(sizeof(F_CONTEXT));
+ context->datastack_region = alloc_segment(ds_size);
+ context->retainstack_region = alloc_segment(rs_size);
+ }
+
+ return context;
+}
+
+void dealloc_context(F_CONTEXT *context)
+{
+ context->next = unused_contexts;
+ unused_contexts = context;
+}
+
/* called on entry into a compiled callback */
void nest_stacks(void)
{
- F_CONTEXT *new_stacks = safe_malloc(sizeof(F_CONTEXT));
+ F_CONTEXT *new_stacks = alloc_context();
new_stacks->callstack_bottom = (F_STACK_FRAME *)-1;
new_stacks->callstack_top = (F_STACK_FRAME *)-1;
new_stacks->current_callback_save = userenv[CURRENT_CALLBACK_ENV];
new_stacks->catchstack_save = userenv[CATCHSTACK_ENV];
- new_stacks->datastack_region = alloc_segment(ds_size);
- new_stacks->retainstack_region = alloc_segment(rs_size);
-
new_stacks->next = stack_chain;
stack_chain = new_stacks;
/* called when leaving a compiled callback */
void unnest_stacks(void)
{
- dealloc_segment(stack_chain->datastack_region);
- dealloc_segment(stack_chain->retainstack_region);
-
ds = stack_chain->datastack_save;
rs = stack_chain->retainstack_save;
F_CONTEXT *old_stacks = stack_chain;
stack_chain = old_stacks->next;
- free(old_stacks);
+ dealloc_context(old_stacks);
}
/* called on startup */
ds_size = ds_size_;
rs_size = rs_size_;
stack_chain = NULL;
+ unused_contexts = NULL;
}
bool stack_to_array(CELL bottom, CELL top)
JIT_PUSH_IMMEDIATE,
JIT_DECLARE_WORD = 42,
JIT_SAVE_STACK,
+ JIT_DIP_WORD,
+ JIT_DIP,
+ JIT_2DIP_WORD,
+ JIT_2DIP,
+ JIT_3DIP_WORD,
+ JIT_3DIP,
STACK_TRACES_ENV = 59,
DLLEXPORT F_CONTEXT *stack_chain;
+F_CONTEXT *unused_contexts;
+
CELL ds_size, rs_size;
#define ds_bot (stack_chain->datastack_region->start)
projects / factor.git / commitdiff