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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-03-12 22:17:47 -05:00
parent 3b3f38a4cd aeaeca193d
commit b9950f4416
19 changed files with 493 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/alien/c-types/c-types-docs.factor
View File

@ -217,6 +217,8 @@ $nl
"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
{ $subsection &free }
{ $subsection |free }
"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
$nl
"You can unsafely copy a range of bytes from one memory location to another:"
{ $subsection memcpy }
"You can copy a range of bytes from memory into a byte array:"
@ -243,4 +245,6 @@ $nl
"New C types can be defined:"
{ $subsection "c-structs" }
{ $subsection "c-unions" }
"A utility for defining " { $link "destructors" } " for deallocating memory:"
{ $subsection "alien.destructors" }
{ $see-also "aliens" } ;

30
basis/alien/destructors/destructors-docs.factor Normal file
View File

@ -0,0 +1,30 @@
IN: alien.destructors
USING: help.markup help.syntax alien destructors ;
HELP: DESTRUCTOR:
{ $syntax "DESTRUCTOR: word" }
{ $description "Defines four things:"
{ $list
{ "a tuple named " { $snippet "word" } " with a single slot holding a " { $link c-ptr } }
{ "a " { $link dispose } " method on the tuple which calls " { $snippet "word" } " with the " { $link c-ptr } }
{ "a pair of words, " { $snippet "&word" } " and " { $snippet "|word" } ", which call " { $link &dispose } " and " { $link |dispose } " with a new instance of the tuple" }
}
"The " { $snippet "word" } " must be defined in the current vocabulary, and must have stack effect " { $snippet "( c-ptr -- )" } "."
}
{ $examples
"Suppose you are writing a binding to the GLib library, which as a " { $snippet "g_object_unref" } " function. Then you can define the function and destructor like so,"
{ $code
"FUNCTION: void g_object_unref ( gpointer object ) ;"
"DESTRUCTOR: g_object_unref"
}
"Now, memory management becomes easier:"
{ $code
"[ g_new_foo &g_object_unref ... ] with-destructors"
}
} ;
ARTICLE: "alien.destructors" "Alien destructors"
"The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes."
{ $subsection POSTPONE: DESTRUCTOR: } ;
ABOUT: "alien.destructors"

11
basis/binary-search/binary-search.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private accessors math
math.order combinators hints arrays ;
@ -16,14 +16,19 @@ IN: binary-search
[ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi
[ drop ] [ dup ] [ ] tri* nth ; inline
DEFER: (search)
: keep-searching ( seq quot -- slice )
[ dup midpoint@ ] dip call collapse-slice slice boa (search) ; inline
: (search) ( quot: ( elt -- <=> ) seq -- i elt )
dup length 1 <= [
finish
] [
decide {
{ +eq+ [ finish ] }
{ +lt+ [ dup midpoint@ head-slice (search) ] }
{ +gt+ [ dup midpoint@ tail-slice (search) ] }
{ +lt+ [ [ (head) ] keep-searching ] }
{ +gt+ [ [ (tail) ] keep-searching ] }
} case
] if ; inline recursive

21
basis/compiler/compiler.factor
View File

@ -1,15 +1,14 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces arrays sequences io words fry
continuations vocabs assocs dlists definitions math graphs
generic combinators deques search-deques io stack-checker
stack-checker.state stack-checker.inlining
combinators.short-circuit compiler.errors compiler.units
compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.optimizer
continuations vocabs assocs dlists definitions math graphs generic
combinators deques search-deques macros io stack-checker
stack-checker.state stack-checker.inlining combinators.short-circuit
compiler.errors compiler.units compiler.tree.builder
compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
compiler.cfg.linearization compiler.cfg.two-operand
compiler.cfg.linear-scan compiler.cfg.stack-frame
compiler.codegen compiler.utilities ;
compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.codegen
compiler.utilities ;
IN: compiler
SYMBOL: compile-queue
@ -50,8 +49,12 @@ SYMBOLS: +optimized+ +unoptimized+ ;
H{ } clone generic-dependencies set
f swap compiler-error ;
: ignore-error? ( word error -- ? )
[ [ inline? ] [ macro? ] bi or ]
[ compiler-error-type +warning+ eq? ] bi* and ;
: fail ( word error -- * )
[ swap compiler-error ]
[ 2dup ignore-error? [ 2drop ] [ swap compiler-error ] if ]
[
drop
[ compiled-unxref ]

3
basis/compiler/tree/finalization/finalization.factor
View File

@ -46,9 +46,6 @@ M: predicate finalize-word
[ drop ]
} cond ;
! M: math-partial finalize-word
! dup primitive? [ drop ] [ nip cached-expansion ] if ;
M: word finalize-word drop ;
M: #call finalize*

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -238,7 +238,7 @@ DEFER: (value-info-union)
: value-infos-union ( infos -- info )
[ null-info ]
[ dup first [ value-info-union ] reduce ] if-empty ;
[ unclip-slice [ value-info-union ] reduce ] if-empty ;
: literals<= ( info1 info2 -- ? )
{

33
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -655,3 +655,36 @@ MIXIN: empty-mixin
! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
! generalize-counter-interval wasn't being called in all the right places.
! bug found by littledan
TUPLE: littledan-1 { a read-only } ;
: (littledan-1-test) ( a -- ) a>> 1+ littledan-1 boa (littledan-1-test) ; inline recursive
: littledan-1-test ( -- ) 0 littledan-1 boa (littledan-1-test) ; inline
[ ] [ [ littledan-1-test ] final-classes drop ] unit-test
TUPLE: littledan-2 { from read-only } { to read-only } ;
: (littledan-2-test) ( x -- i elt )
[ from>> ] [ to>> ] bi + dup littledan-2 boa (littledan-2-test) ; inline recursive
: littledan-2-test ( x -- i elt )
[ 0 ] dip { array-capacity } declare littledan-2 boa (littledan-2-test) ; inline
[ ] [ [ littledan-2-test ] final-classes drop ] unit-test
: (littledan-3-test) ( x -- )
length 1+ f <array> (littledan-3-test) ; inline recursive
: littledan-3-test ( x -- )
0 f <array> (littledan-3-test) ; inline
[ ] [ [ littledan-3-test ] final-classes drop ] unit-test
[ V{ 0 } ] [ [ { } length ] final-literals ] unit-test
[ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] unit-test

11
basis/compiler/tree/propagation/recursive/recursive.factor
View File

@ -34,9 +34,14 @@ IN: compiler.tree.propagation.recursive
} cond interval-union nip ;
: generalize-counter ( info' initial -- info )
2dup [ class>> null-class? ] either? [ drop ] [
[ drop clone ] [ [ interval>> ] bi@ ] 2bi
generalize-counter-interval >>interval
2dup [ not ] either? [ drop ] [
2dup [ class>> null-class? ] either? [ drop ] [
[ clone ] dip
[ [ drop ] [ [ interval>> ] bi@ generalize-counter-interval ] 2bi >>interval ]
[ [ drop ] [ [ slots>> ] bi@ [ generalize-counter ] 2map ] 2bi >>slots ]
[ [ drop ] [ [ length>> ] bi@ generalize-counter ] 2bi >>length ]
tri
] if
] if ;
: unify-recursive-stacks ( stacks initial -- infos )

10
basis/io/directories/search/search-tests.factor
View File

@ -8,3 +8,13 @@ IN: io.directories.search.tests
current-temporary-directory get [ ] find-all-files
] with-unique-directory drop [ natural-sort ] bi@ =
] unit-test
[ f ] [
{ "omg you shoudnt have a directory called this" "or this" }
t
[ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
] unit-test
[ f ] [
{ } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
] unit-test

4
basis/io/directories/search/search.factor
View File

@ -61,8 +61,8 @@ PRIVATE>
ERROR: file-not-found ;
: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
[
'[ _ _ find-file [ file-not-found ] unless* ] attempt-all
'[
_ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
] [
drop f
] recover ;

50
basis/peg/ebnf/ebnf.factor
View File

@ -128,28 +128,28 @@ PEG: escaper ( string -- ast )
#! in the EBNF syntax itself.
[
{
[ dup blank? ]
[ dup CHAR: " = ]
[ dup CHAR: ' = ]
[ dup CHAR: | = ]
[ dup CHAR: { = ]
[ dup CHAR: } = ]
[ dup CHAR: = = ]
[ dup CHAR: ) = ]
[ dup CHAR: ( = ]
[ dup CHAR: ] = ]
[ dup CHAR: [ = ]
[ dup CHAR: . = ]
[ dup CHAR: ! = ]
[ dup CHAR: & = ]
[ dup CHAR: * = ]
[ dup CHAR: + = ]
[ dup CHAR: ? = ]
[ dup CHAR: : = ]
[ dup CHAR: ~ = ]
[ dup CHAR: < = ]
[ dup CHAR: > = ]
} 0|| not nip
[ blank? ]
[ CHAR: " = ]
[ CHAR: ' = ]
[ CHAR: | = ]
[ CHAR: { = ]
[ CHAR: } = ]
[ CHAR: = = ]
[ CHAR: ) = ]
[ CHAR: ( = ]
[ CHAR: ] = ]
[ CHAR: [ = ]
[ CHAR: . = ]
[ CHAR: ! = ]
[ CHAR: & = ]
[ CHAR: * = ]
[ CHAR: + = ]
[ CHAR: ? = ]
[ CHAR: : = ]
[ CHAR: ~ = ]
[ CHAR: < = ]
[ CHAR: > = ]
} 1|| not
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
: 'terminal' ( -- parser )
@ -161,9 +161,9 @@ PEG: escaper ( string -- ast )
#! Parse a valid foreign parser name
[
{
[ dup blank? ]
[ dup CHAR: > = ]
} 0|| not nip
[ blank? ]
[ CHAR: > = ]
} 1|| not
] satisfy repeat1 [ >string ] action ;
: 'foreign' ( -- parser )

20
basis/prettyprint/prettyprint.factor
View File

@ -4,7 +4,7 @@ USING: accessors assocs colors combinators grouping io
io.streams.string io.styles kernel make math math.parser namespaces
parser prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections quotations sequences sorting strings vocabs
vocabs.parser words ;
vocabs.parser words sets ;
IN: prettyprint
<PRIVATE
@ -32,7 +32,7 @@ IN: prettyprint
[ \ IN: pprint-word pprint-vocab ] with-pprint ;
: in. ( vocab -- )
[ write-in nl ] when* ;
[ write-in ] when* ;
: use. ( seq -- )
[
@ -52,21 +52,23 @@ IN: prettyprint
[ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ;
: prelude. ( -- )
in get use get vocab-names use/in. ;
in get use get vocab-names prune in get ".private" append swap remove 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
{ { font-style bold } { font-name "sans-serif" } } [
"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
] with-style
{ { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } } [ prelude. ] with-nesting
nl nl
] print-use-hook set-global
PRIVATE>
: with-use ( obj quot -- )
make-pprint use/in. do-pprint ; inline
make-pprint use/in. nl do-pprint ; inline
: with-in ( obj quot -- )
make-pprint drop [ write-in bl ] when* do-pprint ; inline

4
basis/tools/vocabs/browser/browser.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate
@ -224,7 +224,7 @@ C: <vocab-author> vocab-author
: words. ( vocab -- )
last-element off
[ require ] [ words $words ] bi ;
[ require ] [ words $words ] bi nl ;
: describe-metadata ( vocab -- )
[

2
basis/ui/gadgets/panes/panes.factor
View File

@ -66,7 +66,7 @@ M: pane gadget-selection ( pane -- string/f )
selection-color >>selection-color ; inline
: init-last-line ( pane -- pane )
horizontal <track>
horizontal <track> 0 >>fill +baseline+ >>align
[ >>last-line ] [ 1 track-add ] bi
dup prepare-last-line ; inline

1
basis/windows/nt/nt.factor
View File

@ -12,4 +12,5 @@ USING: alien sequences ;
{ "gl" "opengl32.dll" "stdcall" }
{ "glu" "glu32.dll" "stdcall" }
{ "ole32" "ole32.dll" "stdcall" }
{ "usp10" "usp10.dll" "stdcall" }
} [ first3 add-library ] each

1
basis/windows/usp10/authors.txt Executable file
View File

@ -0,0 +1 @@
Doug Coleman

337
basis/windows/usp10/usp10.factor Executable file
View File

@ -0,0 +1,337 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
IN: windows.usp10
LIBRARY: usp10
C-STRUCT: SCRIPT_CONTROL
{ "DWORD" "flags" } ;
C-STRUCT: SCRIPT_STATE
{ "WORD" "flags" } ;
C-STRUCT: SCRIPT_ANALYSIS
{ "WORD" "flags" }
{ "SCRIPT_STATE" "s" } ;
C-STRUCT: SCRIPT_ITEM
{ "int" "iCharPos" }
{ "SCRIPT_ANALYSIS" "a" } ;
FUNCTION: HRESULT ScriptItemize (
WCHAR* pwcInChars,
int cInChars,
int cMaxItems,
SCRIPT_CONTROL* psControl,
SCRIPT_STATE* psState,
SCRIPT_ITEM* pItems,
int* pcItems
) ;
FUNCTION: HRESULT ScriptLayout (
int cRuns,
BYTE* pbLevel,
int* piVisualToLogical,
int* piLogicalToVisual
) ;
C-ENUM: SCRIPT_JUSTIFY_NONE
SCRIPT_JUSTIFY_ARABIC_BLANK
SCRIPT_JUSTIFY_CHARACTER
SCRIPT_JUSTIFY_RESERVED1
SCRIPT_JUSTIFY_BLANK
SCRIPT_JUSTIFY_RESERVED2
SCRIPT_JUSTIFY_RESERVED3
SCRIPT_JUSTIFY_ARABIC_NORMAL
SCRIPT_JUSTIFY_ARABIC_KASHIDA
SCRIPT_JUSTIFY_ALEF
SCRIPT_JUSTIFY_HA
SCRIPT_JUSTIFY_RA
SCRIPT_JUSTIFY_BA
SCRIPT_JUSTIFY_BARA
SCRIPT_JUSTIFY_SEEN
SCRIPT_JUSTIFFY_RESERVED4 ;
C-STRUCT: SCRIPT_VISATTR
{ "WORD" "flags" } ;
FUNCTION: HRESULT ScriptShape (
HDC hdc,
SCRIPT_CACHE* psc,
WCHAR* pwcChars,
int cChars,
int cMaxGlyphs,
SCRIPT_ANALYSIS* psa,
WORD* pwOutGlyphs,
WORD* pwLogClust,
SCRIPT_VISATTR* psva,
int* pcGlyphs
) ;
C-STRUCT: GOFFSET
{ "LONG" "du" }
{ "LONG" "dv" } ;
FUNCTION: HRESULT ScriptPlace (
HDC hdc,
SCRIPT_CACHE* psc,
WORD* pwGlyphs,
int cGlyphs,
SCRIPT_VISATTR* psva,
SCRIPT_ANALYSIS* psa,
int* piAdvance,
GOFFSET* pGoffset,
ABC* pABC
) ;
FUNCTION: HRESULT ScriptTextOut (
HDC hdc,
SCRIPT_CACHE* psc,
int x,
int y,
UINT fuOptions,
RECT* lprc,
SCRIPT_ANALYSIS* psa,
WCHAR* pwcReserved,
int iReserved,
WORD* pwGlyphs,
int cGlyphs,
int* piAdvance,
int* piJustify,
GOFFSET* pGoffset
) ;
FUNCTION: HRESULT ScriptJustify (
SCRIPT_VISATTR* psva,
int* piAdvance,
int cGlyphs,
int iDx,
int iMinKashida,
int* piJustify
) ;
C-STRUCT: SCRIPT_LOGATTR
{ "BYTE" "flags" } ;
FUNCTION: HRESULT ScriptBreak (
WCHAR* pwcChars,
int cChars,
SCRIPT_ANALYSIS* psa,
SCRIPT_LOGATTR* psla
) ;
FUNCTION: HRESULT ScriptCPtoX (
int iCP,
BOOL fTrailing,
int cChars,
int cGlyphs,
WORD* pwLogClust,
SCRIPT_VISATTR* psva,
int* piAdvance,
SCRIPT_ANALYSIS* psa,
int* piX
) ;
FUNCTION: HRESULT ScriptXtoCP (
int iCP,
BOOL fTrailing,
int cChars,
int cGlyphs,
WORD* pwLogClust,
SCRIPT_VISATTR* psva,
int* piAdvance,
SCRIPT_ANALYSIS* psa,
int* piCP,
int* piTrailing
) ;
FUNCTION: HRESULT ScriptGetLogicalWidths (
SCRIPT_ANALYSIS* psa,
int cChars,
int cGlyphs,
int* piGlyphWidth,
WORD* pwLogClust,
SCRIPT_VISATTR* psva,
int* piDx
) ;
FUNCTION: HRESULT ScriptApplyLogicalWidth (
int* piDx,
int cChars,
int cGlyphs,
WORD* pwLogClust,
SCRIPT_VISATTR* psva,
int* piAdvance,
SCRIPT_ANALYSIS* psa,
ABC* pABC,
int* piJustify
) ;
FUNCTION: HRESULT ScriptGetCMap (
HDC hdc,
SCRIPT_CACHE* psc,
WCHAR* pwcInChars,
int cChars,
DWORD dwFlags,
WORD* pwOutGlyphs
) ;
FUNCTION: HRESULT ScriptGetGlyphABCWidth (
HDC hdc,
SCRIPT_CACHE* psc,
WORD wGlyph,
ABC* pABC
) ;
C-STRUCT: SCRIPT_PROPERTIES
{ "DWORD" "flags" } ;
FUNCTION: HRESULT ScriptGetProperties (
SCRIPT_PROPERTIES*** ppSp,
int* piNumScripts
) ;
C-STRUCT: SCRIPT_FONTPROPERTIES
{ "int" "cBytes" }
{ "WORD" "wgBlank" }
{ "WORD" "wgDefault" }
{ "WORD" "wgInvalid" }
{ "WORD" "wgKashida" }
{ "int" "iKashidaWidth" } ;
FUNCTION: HRESULT ScriptGetFontProperties (
HDC hdc,
SCRIPT_CACHE* psc,
SCRIPT_FONTPROPERTIES* sfp
) ;
FUNCTION: HRESULT ScriptCacheGetHeight (
HDC hdc,
SCRIPT_CACHE* psc,
long* tmHeight
) ;
CONSTANT: SSA_PASSWORD HEX: 00000001
CONSTANT: SSA_TAB HEX: 00000002
CONSTANT: SSA_CLIP HEX: 00000004
CONSTANT: SSA_FIT HEX: 00000008
CONSTANT: SSA_DZWG HEX: 00000010
CONSTANT: SSA_FALLBACK HEX: 00000020
CONSTANT: SSA_BREAK HEX: 00000040
CONSTANT: SSA_GLYPHS HEX: 00000080
CONSTANT: SSA_RTL HEX: 00000100
CONSTANT: SSA_GCP HEX: 00000200
CONSTANT: SSA_HOTKEY HEX: 00000400
CONSTANT: SSA_METAFILE HEX: 00000800
CONSTANT: SSA_LINK HEX: 00001000
CONSTANT: SSA_HIDEHOTKEY HEX: 00002000
CONSTANT: SSA_HOTKEYONLY HEX: 00002400
CONSTANT: SSA_FULLMEASURE HEX: 04000000
CONSTANT: SSA_LPKANSIFALLBACK HEX: 08000000
CONSTANT: SSA_PIDX HEX: 10000000
CONSTANT: SSA_LAYOUTRTL HEX: 20000000
CONSTANT: SSA_DONTGLYPH HEX: 40000000
CONSTANT: SSA_NOKASHIDA HEX: 80000000
C-STRUCT: SCRIPT_TABDEF
{ "int" "cTabStops" }
{ "int" "iScale" }
{ "int*" "pTabStops" }
{ "int" "iTabOrigin" } ;
TYPEDEF: void* SCRIPT_STRING_ANALYSIS
FUNCTION: HRESULT ScriptStringAnalyse (
HDC hdc,
void* pString,
int cString,
int cGlyphs,
int iCharset,
DWORD dwFlags,
int iReqWidth,
SCRIPT_CONTROL* psControl,
SCRIPT_STATE* psState,
int* piDx,
SCRIPT_TABDEF* pTabDef,
BYTE* pbInClass,
SCRIPT_STRING_ANALYSIS* pssa
) ;
FUNCTION: HRESULT ScriptStringFree (
SCRIPT_STRING_ANALYSIS* pssa
) ;
FUNCTION: SIZE* ScriptString_pSize ( SCRIPT_STRING_ANALYSIS ssa ) ;
FUNCTION: int* ScriptString_pcOutChars ( SCRIPT_STRING_ANALYSIS ssa ) ;
FUNCTION: SCRIPT_LOGATTR* ScriptString_pLogAttr ( SCRIPT_STRING_ANALYSIS ssa ) ;
FUNCTION: HRESULT ScriptStringGetOrder (
SCRIPT_STRING_ANALYSIS ssa,
UINT* puOrder
) ;
FUNCTION: HRESULT ScriptStringCPtoX (
SCRIPT_STRING_ANALYSIS ssa,
int icp,
BOOL fTrailing,
int* pX
) ;
FUNCTION: HRESULT ScriptStringXtoCP (
SCRIPT_STRING_ANALYSIS ssa,
int iX,
int* piCh,
int* piTrailing
) ;
FUNCTION: HRESULT ScriptStringGetLogicalWidths (
SCRIPT_STRING_ANALYSIS ssa,
int* piDx
) ;
FUNCTION: HRESULT ScriptStringValidate (
SCRIPT_STRING_ANALYSIS ssa
) ;
FUNCTION: HRESULT ScriptStringOut (
SCRIPT_STRING_ANALYSIS ssa,
int iX,
int iY,
UINT uOptions,
RECT* prc,
int iMinSel,
int iMaxSel,
BOOL fDisabled
) ;
CONSTANT: SIC_COMPLEX 1
CONSTANT: SIC_ASCIIDIGIT 2
CONSTANT: SIC_NEUTRAL 4
FUNCTION: HRESULT ScriptIsComplex (
WCHAR* pwcInChars,
int cInChars,
DWORD dwFlags
) ;
C-STRUCT: SCRIPT_DIGITSUBSTITUTE
{ "DWORD" "flags" } ;
FUNCTION: HRESULT ScriptRecordDigitSubstitution (
LCID Locale,
SCRIPT_DIGITSUBSTITUTE* psds
) ;
CONSTANT: SCRIPT_DIGITSUBSTITUTE_CONTEXT 0
CONSTANT: SCRIPT_DIGITSUBSTITUTE_NONE 1
CONSTANT: SCRIPT_DIGITSUBSTITUTE_NATIONAL 2
CONSTANT: SCRIPT_DIGITSUBSTITUTE_TRADITIONAL 3
FUNCTION: HRESULT ScriptApplyDigitSubstitution (
SCRIPT_DIGITSUBSTITUTE* psds,
SCRIPT_CONTROL* psc,
SCRIPT_STATE* pss
) ;

4
core/sequences/sequences-tests.factor
View File

@ -13,6 +13,10 @@ IN: sequences.tests
[ V{ 4 5 } ] [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
[ V{ 3 4 } ] [ 2 4 1 10 dup <slice> subseq >vector ] unit-test
[ V{ 3 4 } ] [ 0 2 2 4 1 10 dup <slice> <slice> subseq >vector ] unit-test
[ 0 10 "hello" <slice> ] must-fail
[ -10 3 "hello" <slice> ] must-fail
[ 2 1 "hello" <slice> ] must-fail
[ "cba" ] [ "abcdef" 3 head-slice reverse ] unit-test
[ 5040 ] [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test

5
core/sequences/sequences.factor
View File

@ -221,8 +221,9 @@ TUPLE: slice-error from to seq reason ;
: check-slice ( from to seq -- from to seq )
3dup
[ 2drop 0 < "start < 0" slice-error ]
[ nip length > "end > sequence" slice-error ]
[ drop > "start > end" slice-error ] 3tri ; inline
[ [ drop ] 2dip length > "end > sequence" slice-error ]
[ drop > "start > end" slice-error ]
3tri ; inline
: <slice> ( from to seq -- slice )
dup slice? [ collapse-slice ] when