"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:"
"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" } ;
--- /dev/null
+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"
\ No newline at end of file
-! 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 ;
[ [ 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
! 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
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 ]
[ drop ]
} cond ;
-! M: math-partial finalize-word
-! dup primitive? [ drop ] [ nip cached-expansion ] if ;
-
M: word finalize-word drop ;
M: #call finalize*
: 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 -- ? )
{
! [ 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
\ No newline at end of file
} 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 )
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
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 ;
#! in the EBNF syntax itself.\r
[\r
{\r
- [ dup blank? ]\r
- [ dup CHAR: " = ]\r
- [ dup CHAR: ' = ]\r
- [ dup CHAR: | = ]\r
- [ dup CHAR: { = ]\r
- [ dup CHAR: } = ]\r
- [ dup CHAR: = = ]\r
- [ dup CHAR: ) = ]\r
- [ dup CHAR: ( = ]\r
- [ dup CHAR: ] = ]\r
- [ dup CHAR: [ = ]\r
- [ dup CHAR: . = ]\r
- [ dup CHAR: ! = ]\r
- [ dup CHAR: & = ]\r
- [ dup CHAR: * = ]\r
- [ dup CHAR: + = ]\r
- [ dup CHAR: ? = ]\r
- [ dup CHAR: : = ]\r
- [ dup CHAR: ~ = ]\r
- [ dup CHAR: < = ]\r
- [ dup CHAR: > = ]\r
- } 0|| not nip \r
+ [ blank? ]\r
+ [ CHAR: " = ]\r
+ [ CHAR: ' = ]\r
+ [ CHAR: | = ]\r
+ [ CHAR: { = ]\r
+ [ CHAR: } = ]\r
+ [ CHAR: = = ]\r
+ [ CHAR: ) = ]\r
+ [ CHAR: ( = ]\r
+ [ CHAR: ] = ]\r
+ [ CHAR: [ = ]\r
+ [ CHAR: . = ]\r
+ [ CHAR: ! = ]\r
+ [ CHAR: & = ]\r
+ [ CHAR: * = ]\r
+ [ CHAR: + = ]\r
+ [ CHAR: ? = ]\r
+ [ CHAR: : = ]\r
+ [ CHAR: ~ = ]\r
+ [ CHAR: < = ]\r
+ [ CHAR: > = ]\r
+ } 1|| not\r
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;\r
\r
: 'terminal' ( -- parser )\r
#! Parse a valid foreign parser name\r
[\r
{\r
- [ dup blank? ]\r
- [ dup CHAR: > = ]\r
- } 0|| not nip \r
+ [ blank? ]\r
+ [ CHAR: > = ]\r
+ } 1|| not\r
] satisfy repeat1 [ >string ] action ;\r
\r
: 'foreign' ( -- parser )\r
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
[ \ IN: pprint-word pprint-vocab ] with-pprint ;
: in. ( vocab -- )
- [ write-in nl ] when* ;
+ [ write-in ] when* ;
: use. ( seq -- )
[
[ [ 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
-! 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
: words. ( vocab -- )
last-element off
- [ require ] [ words $words ] bi ;
+ [ require ] [ words $words ] bi nl ;
: describe-metadata ( vocab -- )
[
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
{ "gl" "opengl32.dll" "stdcall" }
{ "glu" "glu32.dll" "stdcall" }
{ "ole32" "ole32.dll" "stdcall" }
+ { "usp10" "usp10.dll" "stdcall" }
} [ first3 add-library ] each
--- /dev/null
+Doug Coleman
--- /dev/null
+! 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
+) ;
\ No newline at end of file
[ 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
: 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
projects / factor.git / commitdiff