Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
d48aa32494
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: byte-arrays arrays assocs kernel kernel.private libc math
|
||||
namespaces make parser sequences strings words assocs splitting
|
||||
|
|
@ -275,7 +275,7 @@ M: long-long-type box-return ( type -- )
|
|||
: if-void ( type true false -- )
|
||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||
|
||||
: primitive-types
|
||||
CONSTANT: primitive-types
|
||||
{
|
||||
"char" "uchar"
|
||||
"short" "ushort"
|
||||
|
|
@ -284,7 +284,7 @@ M: long-long-type box-return ( type -- )
|
|||
"longlong" "ulonglong"
|
||||
"float" "double"
|
||||
"void*" "bool"
|
||||
} ;
|
||||
}
|
||||
|
||||
[
|
||||
<c-type>
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: http.client checksums checksums.md5 splitting assocs
|
|||
kernel io.files bootstrap.image sequences io urls ;
|
||||
IN: bootstrap.image.download
|
||||
|
||||
: url URL" http://factorcode.org/images/latest/" ;
|
||||
CONSTANT: url URL" http://factorcode.org/images/latest/"
|
||||
|
||||
: download-checksums ( -- alist )
|
||||
url "checksums.txt" >url derive-url http-get nip
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@ C-ENUM:
|
|||
CAIRO_STATUS_INVALID_STRIDE ;
|
||||
|
||||
TYPEDEF: int cairo_content_t
|
||||
: CAIRO_CONTENT_COLOR HEX: 1000 ;
|
||||
: CAIRO_CONTENT_ALPHA HEX: 2000 ;
|
||||
: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ;
|
||||
CONSTANT: CAIRO_CONTENT_COLOR HEX: 1000
|
||||
CONSTANT: CAIRO_CONTENT_ALPHA HEX: 2000
|
||||
CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
|
||||
|
||||
TYPEDEF: void* cairo_write_func_t
|
||||
: cairo-write-func ( quot -- callback )
|
||||
|
|
|
|||
|
|
@ -9,9 +9,9 @@ ERROR: unknown-digest name ;
|
|||
|
||||
TUPLE: openssl-checksum name ;
|
||||
|
||||
: openssl-md5 T{ openssl-checksum f "md5" } ;
|
||||
CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
|
||||
|
||||
: openssl-sha1 T{ openssl-checksum f "sha1" } ;
|
||||
CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
|
||||
|
||||
INSTANCE: openssl-checksum stream-checksum
|
||||
|
||||
|
|
|
|||
|
|
@ -19,9 +19,9 @@ IN: cocoa.application
|
|||
] curry assoc-each
|
||||
] keep ;
|
||||
|
||||
: NSApplicationDelegateReplySuccess 0 ;
|
||||
: NSApplicationDelegateReplyCancel 1 ;
|
||||
: NSApplicationDelegateReplyFailure 2 ;
|
||||
CONSTANT: NSApplicationDelegateReplySuccess 0
|
||||
CONSTANT: NSApplicationDelegateReplyCancel 1
|
||||
CONSTANT: NSApplicationDelegateReplyFailure 2
|
||||
|
||||
: with-autorelease-pool ( quot -- )
|
||||
NSAutoreleasePool -> new slip -> release ; inline
|
||||
|
|
|
|||
|
|
@ -18,8 +18,8 @@ IN: cocoa.dialogs
|
|||
dup 0 -> setCanChooseDirectories:
|
||||
dup 0 -> setAllowsMultipleSelection: ;
|
||||
|
||||
: NSOKButton 1 ;
|
||||
: NSCancelButton 0 ;
|
||||
CONSTANT: NSOKButton 1
|
||||
CONSTANT: NSCancelButton 0
|
||||
|
||||
: open-panel ( -- paths )
|
||||
<NSOpenPanel>
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types alien.strings arrays assocs
|
||||
continuations combinators compiler compiler.alien kernel math
|
||||
namespaces make parser quotations sequences strings words
|
||||
cocoa.runtime io macros memoize io.encodings.utf8
|
||||
effects libc libc.private parser lexer init core-foundation fry
|
||||
generalizations specialized-arrays.direct.alien call ;
|
||||
continuations combinators compiler compiler.alien stack-checker kernel
|
||||
math namespaces make parser quotations sequences strings words
|
||||
cocoa.runtime io macros memoize io.encodings.utf8 effects libc
|
||||
libc.private parser lexer init core-foundation fry generalizations
|
||||
specialized-arrays.direct.alien call ;
|
||||
IN: cocoa.messages
|
||||
|
||||
: make-sender ( method function -- quot )
|
||||
|
|
@ -14,7 +14,7 @@ IN: cocoa.messages
|
|||
: sender-stub ( method function -- word )
|
||||
[ "( sender-stub )" f <word> dup ] 2dip
|
||||
over first large-struct? [ "_stret" append ] when
|
||||
make-sender define ;
|
||||
make-sender dup infer define-declared ;
|
||||
|
||||
SYMBOL: message-senders
|
||||
SYMBOL: super-message-senders
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ cocoa.classes cocoa.application sequences cocoa core-foundation
|
|||
core-foundation.strings core-foundation.arrays ;
|
||||
IN: cocoa.pasteboard
|
||||
|
||||
: NSStringPboardType "NSStringPboardType" ;
|
||||
CONSTANT: NSStringPboardType "NSStringPboardType"
|
||||
|
||||
: pasteboard-string? ( pasteboard -- ? )
|
||||
NSStringPboardType swap -> types CF>string-array member? ;
|
||||
|
|
|
|||
|
|
@ -21,15 +21,15 @@ C-STRUCT: objc-super
|
|||
{ "id" "receiver" }
|
||||
{ "Class" "class" } ;
|
||||
|
||||
: CLS_CLASS HEX: 1 ;
|
||||
: CLS_META HEX: 2 ;
|
||||
: CLS_INITIALIZED HEX: 4 ;
|
||||
: CLS_POSING HEX: 8 ;
|
||||
: CLS_MAPPED HEX: 10 ;
|
||||
: CLS_FLUSH_CACHE HEX: 20 ;
|
||||
: CLS_GROW_CACHE HEX: 40 ;
|
||||
: CLS_NEED_BIND HEX: 80 ;
|
||||
: CLS_METHOD_ARRAY HEX: 100 ;
|
||||
CONSTANT: CLS_CLASS HEX: 1
|
||||
CONSTANT: CLS_META HEX: 2
|
||||
CONSTANT: CLS_INITIALIZED HEX: 4
|
||||
CONSTANT: CLS_POSING HEX: 8
|
||||
CONSTANT: CLS_MAPPED HEX: 10
|
||||
CONSTANT: CLS_FLUSH_CACHE HEX: 20
|
||||
CONSTANT: CLS_GROW_CACHE HEX: 40
|
||||
CONSTANT: CLS_NEED_BIND HEX: 80
|
||||
CONSTANT: CLS_METHOD_ARRAY HEX: 100
|
||||
|
||||
FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -38,9 +38,9 @@ IN: cocoa.subclassing
|
|||
] map concat ;
|
||||
|
||||
: prepare-method ( ret types quot -- type imp )
|
||||
[ [ encode-types ] 2keep ] dip [
|
||||
"cdecl" swap 4array % \ alien-callback ,
|
||||
] [ ] make define-temp ;
|
||||
[ [ encode-types ] 2keep ] dip
|
||||
'[ _ _ "cdecl" _ alien-callback ]
|
||||
(( -- callback )) define-temp ;
|
||||
|
||||
: prepare-methods ( methods -- methods )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -5,43 +5,43 @@ cocoa cocoa.messages cocoa.classes cocoa.types sequences
|
|||
continuations accessors ;
|
||||
IN: cocoa.views
|
||||
|
||||
: NSOpenGLPFAAllRenderers 1 ;
|
||||
: NSOpenGLPFADoubleBuffer 5 ;
|
||||
: NSOpenGLPFAStereo 6 ;
|
||||
: NSOpenGLPFAAuxBuffers 7 ;
|
||||
: NSOpenGLPFAColorSize 8 ;
|
||||
: NSOpenGLPFAAlphaSize 11 ;
|
||||
: NSOpenGLPFADepthSize 12 ;
|
||||
: NSOpenGLPFAStencilSize 13 ;
|
||||
: NSOpenGLPFAAccumSize 14 ;
|
||||
: NSOpenGLPFAMinimumPolicy 51 ;
|
||||
: NSOpenGLPFAMaximumPolicy 52 ;
|
||||
: NSOpenGLPFAOffScreen 53 ;
|
||||
: NSOpenGLPFAFullScreen 54 ;
|
||||
: NSOpenGLPFASampleBuffers 55 ;
|
||||
: NSOpenGLPFASamples 56 ;
|
||||
: NSOpenGLPFAAuxDepthStencil 57 ;
|
||||
: NSOpenGLPFAColorFloat 58 ;
|
||||
: NSOpenGLPFAMultisample 59 ;
|
||||
: NSOpenGLPFASupersample 60 ;
|
||||
: NSOpenGLPFASampleAlpha 61 ;
|
||||
: NSOpenGLPFARendererID 70 ;
|
||||
: NSOpenGLPFASingleRenderer 71 ;
|
||||
: NSOpenGLPFANoRecovery 72 ;
|
||||
: NSOpenGLPFAAccelerated 73 ;
|
||||
: NSOpenGLPFAClosestPolicy 74 ;
|
||||
: NSOpenGLPFARobust 75 ;
|
||||
: NSOpenGLPFABackingStore 76 ;
|
||||
: NSOpenGLPFAMPSafe 78 ;
|
||||
: NSOpenGLPFAWindow 80 ;
|
||||
: NSOpenGLPFAMultiScreen 81 ;
|
||||
: NSOpenGLPFACompliant 83 ;
|
||||
: NSOpenGLPFAScreenMask 84 ;
|
||||
: NSOpenGLPFAPixelBuffer 90 ;
|
||||
: NSOpenGLPFAAllowOfflineRenderers 96 ;
|
||||
: NSOpenGLPFAVirtualScreenCount 128 ;
|
||||
CONSTANT: NSOpenGLPFAAllRenderers 1
|
||||
CONSTANT: NSOpenGLPFADoubleBuffer 5
|
||||
CONSTANT: NSOpenGLPFAStereo 6
|
||||
CONSTANT: NSOpenGLPFAAuxBuffers 7
|
||||
CONSTANT: NSOpenGLPFAColorSize 8
|
||||
CONSTANT: NSOpenGLPFAAlphaSize 11
|
||||
CONSTANT: NSOpenGLPFADepthSize 12
|
||||
CONSTANT: NSOpenGLPFAStencilSize 13
|
||||
CONSTANT: NSOpenGLPFAAccumSize 14
|
||||
CONSTANT: NSOpenGLPFAMinimumPolicy 51
|
||||
CONSTANT: NSOpenGLPFAMaximumPolicy 52
|
||||
CONSTANT: NSOpenGLPFAOffScreen 53
|
||||
CONSTANT: NSOpenGLPFAFullScreen 54
|
||||
CONSTANT: NSOpenGLPFASampleBuffers 55
|
||||
CONSTANT: NSOpenGLPFASamples 56
|
||||
CONSTANT: NSOpenGLPFAAuxDepthStencil 57
|
||||
CONSTANT: NSOpenGLPFAColorFloat 58
|
||||
CONSTANT: NSOpenGLPFAMultisample 59
|
||||
CONSTANT: NSOpenGLPFASupersample 60
|
||||
CONSTANT: NSOpenGLPFASampleAlpha 61
|
||||
CONSTANT: NSOpenGLPFARendererID 70
|
||||
CONSTANT: NSOpenGLPFASingleRenderer 71
|
||||
CONSTANT: NSOpenGLPFANoRecovery 72
|
||||
CONSTANT: NSOpenGLPFAAccelerated 73
|
||||
CONSTANT: NSOpenGLPFAClosestPolicy 74
|
||||
CONSTANT: NSOpenGLPFARobust 75
|
||||
CONSTANT: NSOpenGLPFABackingStore 76
|
||||
CONSTANT: NSOpenGLPFAMPSafe 78
|
||||
CONSTANT: NSOpenGLPFAWindow 80
|
||||
CONSTANT: NSOpenGLPFAMultiScreen 81
|
||||
CONSTANT: NSOpenGLPFACompliant 83
|
||||
CONSTANT: NSOpenGLPFAScreenMask 84
|
||||
CONSTANT: NSOpenGLPFAPixelBuffer 90
|
||||
CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
|
||||
CONSTANT: NSOpenGLPFAVirtualScreenCount 128
|
||||
|
||||
: kCGLRendererGenericFloatID HEX: 00020400 ;
|
||||
CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -94,7 +94,7 @@ PRIVATE>
|
|||
USE: opengl.gl
|
||||
USE: alien.syntax
|
||||
|
||||
: NSOpenGLCPSwapInterval 222 ;
|
||||
CONSTANT: NSOpenGLCPSwapInterval 222
|
||||
|
||||
LIBRARY: OpenGL
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ M: callable test-cfg
|
|||
build-tree optimize-tree gensym build-cfg ;
|
||||
|
||||
M: word test-cfg
|
||||
[ build-tree-from-word nip optimize-tree ] keep build-cfg ;
|
||||
[ build-tree-from-word optimize-tree ] keep build-cfg ;
|
||||
|
||||
SYMBOL: allocate-registers?
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax words io parser
|
||||
assocs words.private sequences compiler.units ;
|
||||
assocs words.private sequences compiler.units quotations ;
|
||||
IN: compiler
|
||||
|
||||
HELP: enable-compiler
|
||||
|
|
@ -16,6 +16,8 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
|||
{ $subsection optimized-recompile-hook }
|
||||
"Removing a word's optimized definition:"
|
||||
{ $subsection decompile }
|
||||
"Compiling a single quotation:"
|
||||
{ $subsection compile-call }
|
||||
"Higher-level words can be found in " { $link "compilation-units" } "." ;
|
||||
|
||||
ARTICLE: "compiler" "Optimizing compiler"
|
||||
|
|
@ -48,3 +50,8 @@ HELP: optimized-recompile-hook
|
|||
{ $values { "words" "a sequence of words" } { "alist" "an association list" } }
|
||||
{ $description "Compile a set of words." }
|
||||
{ $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
|
||||
|
||||
HELP: compile-call
|
||||
{ $values { "quot" quotation } }
|
||||
{ $description "Compiles and runs a quotation." }
|
||||
{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ;
|
||||
|
|
|
|||
|
|
@ -1,46 +1,47 @@
|
|||
! 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
|
||||
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 ;
|
||||
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
|
||||
compiler.cfg.linearization compiler.cfg.two-operand
|
||||
compiler.cfg.linear-scan compiler.cfg.stack-frame
|
||||
compiler.codegen compiler.utilities ;
|
||||
IN: compiler
|
||||
|
||||
SYMBOL: compile-queue
|
||||
SYMBOL: compiled
|
||||
|
||||
: queue-compile ( word -- )
|
||||
: queue-compile? ( word -- ? )
|
||||
{
|
||||
{ [ dup "forgotten" word-prop ] [ ] }
|
||||
{ [ dup compiled get key? ] [ ] }
|
||||
{ [ dup inlined-block? ] [ ] }
|
||||
{ [ dup primitive? ] [ ] }
|
||||
[ dup compile-queue get push-front ]
|
||||
} cond drop ;
|
||||
[ "forgotten" word-prop ]
|
||||
[ compiled get key? ]
|
||||
[ inlined-block? ]
|
||||
[ primitive? ]
|
||||
} 1|| not ;
|
||||
|
||||
: queue-compile ( word -- )
|
||||
dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
|
||||
|
||||
: maybe-compile ( word -- )
|
||||
dup optimized>> [ drop ] [ queue-compile ] if ;
|
||||
|
||||
SYMBOL: +failed+
|
||||
SYMBOLS: +optimized+ +unoptimized+ ;
|
||||
|
||||
: ripple-up ( words -- )
|
||||
dup "compiled-effect" word-prop +failed+ eq?
|
||||
dup "compiled-status" word-prop +unoptimized+ eq?
|
||||
[ usage [ word? ] filter ] [ compiled-usage keys ] if
|
||||
[ queue-compile ] each ;
|
||||
|
||||
: ripple-up? ( word effect -- ? )
|
||||
#! If the word has previously been compiled and had a
|
||||
#! different stack effect, we have to recompile any callers.
|
||||
swap "compiled-effect" word-prop [ = not ] keep and ;
|
||||
: ripple-up? ( word status -- ? )
|
||||
swap "compiled-status" word-prop [ = not ] keep and ;
|
||||
|
||||
: save-effect ( word effect -- )
|
||||
: save-compiled-status ( word status -- )
|
||||
[ dupd ripple-up? [ ripple-up ] [ drop ] if ]
|
||||
[ "compiled-effect" set-word-prop ]
|
||||
[ "compiled-status" set-word-prop ]
|
||||
2bi ;
|
||||
|
||||
: start ( word -- )
|
||||
|
|
@ -49,18 +50,18 @@ SYMBOL: +failed+
|
|||
H{ } clone generic-dependencies set
|
||||
f swap compiler-error ;
|
||||
|
||||
: fail ( word error -- )
|
||||
: fail ( word error -- * )
|
||||
[ swap compiler-error ]
|
||||
[
|
||||
drop
|
||||
[ compiled-unxref ]
|
||||
[ f swap compiled get set-at ]
|
||||
[ +failed+ save-effect ]
|
||||
[ +unoptimized+ save-compiled-status ]
|
||||
tri
|
||||
] 2bi
|
||||
return ;
|
||||
|
||||
: frontend ( word -- effect nodes )
|
||||
: frontend ( word -- nodes )
|
||||
[ build-tree-from-word ] [ fail ] recover optimize-tree ;
|
||||
|
||||
! Only switch this off for debugging.
|
||||
|
|
@ -84,8 +85,8 @@ t compile-dependencies? set-global
|
|||
save-asm
|
||||
] each ;
|
||||
|
||||
: finish ( effect word -- )
|
||||
[ swap save-effect ]
|
||||
: finish ( word -- )
|
||||
[ +optimized+ save-compiled-status ]
|
||||
[ compiled-unxref ]
|
||||
[
|
||||
dup crossref?
|
||||
|
|
@ -112,6 +113,9 @@ t compile-dependencies? set-global
|
|||
: decompile ( word -- )
|
||||
f 2array 1array modify-code-heap ;
|
||||
|
||||
: compile-call ( quot -- )
|
||||
[ dup infer define-temp ] with-compilation-unit execute ;
|
||||
|
||||
: optimized-recompile-hook ( words -- alist )
|
||||
[
|
||||
<hashed-dlist> compile-queue set
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ unit-test
|
|||
\ foo [ global >n get ndrop ] compile-call
|
||||
] unit-test
|
||||
|
||||
: blech drop ;
|
||||
: blech ( x -- ) drop ;
|
||||
|
||||
[ 3 ]
|
||||
[
|
||||
|
|
@ -102,7 +102,7 @@ unit-test
|
|||
[ ] [
|
||||
[
|
||||
[ 200 dup [ 200 3array ] curry map drop ] times
|
||||
] [ define-temp ] with-compilation-unit drop
|
||||
] [ (( n -- )) define-temp ] with-compilation-unit drop
|
||||
] unit-test
|
||||
|
||||
! Test how dispatch handles the end of a basic block
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: tools.test quotations math kernel sequences
|
||||
assocs namespaces make compiler.units ;
|
||||
assocs namespaces make compiler.units compiler ;
|
||||
IN: compiler.tests
|
||||
|
||||
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
|
||||
|
|
@ -32,15 +32,15 @@ IN: compiler.tests
|
|||
compile-call
|
||||
] unit-test
|
||||
|
||||
: foobar ( quot -- )
|
||||
dup slip swap [ foobar ] [ drop ] if ; inline
|
||||
: foobar ( quot: ( -- ) -- )
|
||||
dup slip swap [ foobar ] [ drop ] if ; inline recursive
|
||||
|
||||
[ ] [ [ [ f ] foobar ] compile-call ] unit-test
|
||||
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test
|
||||
|
||||
: funky-assoc>map
|
||||
: funky-assoc>map ( assoc quot -- seq )
|
||||
[
|
||||
[ call f ] curry assoc-find 3drop
|
||||
] { } make ; inline
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: compiler.tests
|
||||
USING: compiler.units kernel kernel.private memory math
|
||||
USING: compiler.units compiler kernel kernel.private memory math
|
||||
math.private tools.test math.floats.private ;
|
||||
|
||||
[ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ strings.private system random layouts vectors
|
|||
sbufs strings.private slots.private alien math.order
|
||||
alien.accessors alien.c-types alien.syntax alien.strings
|
||||
namespaces libc sequences.private io.encodings.ascii
|
||||
classes ;
|
||||
classes compiler ;
|
||||
IN: compiler.tests
|
||||
|
||||
! Make sure that intrinsic ops compile to correct code.
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@ stack-checker kernel kernel.private math prettyprint sequences
|
|||
sbufs strings tools.test vectors words sequences.private
|
||||
quotations classes classes.algebra classes.tuple.private
|
||||
continuations growable namespaces hints alien.accessors
|
||||
compiler.tree.builder compiler.tree.optimizer sequences.deep ;
|
||||
compiler.tree.builder compiler.tree.optimizer sequences.deep
|
||||
compiler ;
|
||||
IN: optimizer.tests
|
||||
|
||||
GENERIC: xyz ( obj -- obj )
|
||||
|
|
@ -54,7 +55,7 @@ TUPLE: pred-test ;
|
|||
|
||||
! regression
|
||||
|
||||
: literal-not-branch 0 not [ ] [ ] if ;
|
||||
: literal-not-branch ( -- ) 0 not [ ] [ ] if ;
|
||||
|
||||
[ ] [ literal-not-branch ] unit-test
|
||||
|
||||
|
|
@ -107,12 +108,12 @@ GENERIC: void-generic ( obj -- * )
|
|||
[ 10 ] [ branch-fold-regression-1 ] unit-test
|
||||
|
||||
! another regression
|
||||
: constant-branch-fold-0 "hey" ; foldable
|
||||
: constant-branch-fold-0 ( -- value ) "hey" ; foldable
|
||||
: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
|
||||
[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
|
||||
|
||||
! another regression
|
||||
: foo f ;
|
||||
: foo ( -- value ) f ;
|
||||
: bar ( -- ? ) foo 4 4 = and ;
|
||||
[ f ] [ bar ] unit-test
|
||||
|
||||
|
|
@ -133,15 +134,15 @@ M: slice foozul ;
|
|||
] unit-test
|
||||
|
||||
! regression
|
||||
: constant-fold-2 f ; foldable
|
||||
: constant-fold-3 4 ; foldable
|
||||
: constant-fold-2 ( -- value ) f ; foldable
|
||||
: constant-fold-3 ( -- value ) 4 ; foldable
|
||||
|
||||
[ f t ] [
|
||||
[ constant-fold-2 constant-fold-3 4 = ] compile-call
|
||||
] unit-test
|
||||
|
||||
: constant-fold-4 f ; foldable
|
||||
: constant-fold-5 f ; foldable
|
||||
: constant-fold-4 ( -- value ) f ; foldable
|
||||
: constant-fold-5 ( -- value ) f ; foldable
|
||||
|
||||
[ f ] [
|
||||
[ constant-fold-4 constant-fold-5 or ] compile-call
|
||||
|
|
@ -208,14 +209,14 @@ USE: sorting
|
|||
USE: binary-search
|
||||
USE: binary-search.private
|
||||
|
||||
: old-binsearch ( elt quot seq -- elt quot i )
|
||||
: old-binsearch ( elt quot: ( -- ) seq -- elt quot i )
|
||||
dup length 1 <= [
|
||||
from>>
|
||||
] [
|
||||
[ midpoint swap call ] 3keep roll dup zero?
|
||||
[ drop dup from>> swap midpoint@ + ]
|
||||
[ dup midpoint@ cut-slice old-binsearch ] if
|
||||
] if ; inline
|
||||
[ drop dup midpoint@ head-slice old-binsearch ] if
|
||||
] if ; inline recursive
|
||||
|
||||
[ 10 ] [
|
||||
10 20 >vector <flat-slice>
|
||||
|
|
@ -246,7 +247,7 @@ USE: binary-search.private
|
|||
[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
|
||||
[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
|
||||
|
||||
: lift-loop-tail-test-1 ( a quot -- )
|
||||
: lift-loop-tail-test-1 ( a quot: ( -- ) -- )
|
||||
over even? [
|
||||
[ [ 3 - ] dip call ] keep lift-loop-tail-test-1
|
||||
] [
|
||||
|
|
@ -255,11 +256,13 @@ USE: binary-search.private
|
|||
] [
|
||||
[ [ 2 - ] dip call ] keep lift-loop-tail-test-1
|
||||
] if
|
||||
] if ; inline
|
||||
] if ; inline recursive
|
||||
|
||||
: lift-loop-tail-test-2
|
||||
: lift-loop-tail-test-2 ( -- a b c )
|
||||
10 [ ] lift-loop-tail-test-1 1 2 3 ;
|
||||
|
||||
\ lift-loop-tail-test-2 must-infer
|
||||
|
||||
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
|
||||
|
||||
! Forgot a recursive inline check
|
||||
|
|
@ -300,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ;
|
|||
: member-test ( obj -- ? ) { + - * / /i } member? ;
|
||||
|
||||
\ member-test must-infer
|
||||
[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
|
||||
[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
|
||||
[ t ] [ \ + member-test ] unit-test
|
||||
[ f ] [ \ append member-test ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,15 @@
|
|||
IN: compiler.tests
|
||||
USING: peg.ebnf strings tools.test ;
|
||||
|
||||
GENERIC: <times> ( times -- term' )
|
||||
M: string <times> ;
|
||||
|
||||
EBNF: parse-regexp
|
||||
|
||||
Times = .* => [[ "foo" ]]
|
||||
|
||||
Regexp = Times:t => [[ t <times> ]]
|
||||
|
||||
;EBNF
|
||||
|
||||
[ "foo" ] [ "a" parse-regexp ] unit-test
|
||||
|
|
@ -18,13 +18,13 @@ IN: compiler.tests
|
|||
[ "hey" ] [ [ "hey" ] compile-call ] unit-test
|
||||
|
||||
! Calls
|
||||
: no-op ;
|
||||
: no-op ( -- ) ;
|
||||
|
||||
[ ] [ [ no-op ] compile-call ] unit-test
|
||||
[ 3 ] [ [ no-op 3 ] compile-call ] unit-test
|
||||
[ 3 ] [ [ 3 no-op ] compile-call ] unit-test
|
||||
|
||||
: bar 4 ;
|
||||
: bar ( -- value ) 4 ;
|
||||
|
||||
[ 4 ] [ [ bar no-op ] compile-call ] unit-test
|
||||
[ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test
|
||||
|
|
@ -54,7 +54,7 @@ IN: compiler.tests
|
|||
|
||||
! Labels
|
||||
|
||||
: recursive-test ( ? -- ) [ f recursive-test ] when ; inline
|
||||
: recursive-test ( ? -- ) [ f recursive-test ] when ; inline recursive
|
||||
|
||||
[ ] [ t [ recursive-test ] compile-call ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: compiler.tests
|
||||
USING: kernel tools.test compiler.units ;
|
||||
USING: kernel tools.test compiler.units compiler ;
|
||||
|
||||
TUPLE: color red green blue ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,4 +8,4 @@ compiler.tree ;
|
|||
|
||||
: inline-recursive ( -- ) inline-recursive ; inline recursive
|
||||
|
||||
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test
|
||||
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test
|
||||
|
|
|
|||
|
|
@ -12,18 +12,18 @@ IN: compiler.tree.builder
|
|||
|
||||
: with-tree-builder ( quot -- nodes )
|
||||
'[ V{ } clone stack-visitor set @ ]
|
||||
with-infer ; inline
|
||||
with-infer nip ; inline
|
||||
|
||||
: build-tree ( quot -- nodes )
|
||||
#! Not safe to call from inference transforms.
|
||||
[ f initial-recursive-state infer-quot ] with-tree-builder nip ;
|
||||
[ f initial-recursive-state infer-quot ] with-tree-builder ;
|
||||
|
||||
: build-tree-with ( in-stack quot -- nodes out-stack )
|
||||
#! Not safe to call from inference transforms.
|
||||
[
|
||||
[ >vector \ meta-d set ]
|
||||
[ f initial-recursive-state infer-quot ] bi*
|
||||
] with-tree-builder nip
|
||||
] with-tree-builder
|
||||
unclip-last in-d>> ;
|
||||
|
||||
: build-sub-tree ( #call quot -- nodes )
|
||||
|
|
@ -45,7 +45,7 @@ IN: compiler.tree.builder
|
|||
: check-no-compile ( word -- )
|
||||
dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;
|
||||
|
||||
: build-tree-from-word ( word -- effect nodes )
|
||||
: build-tree-from-word ( word -- nodes )
|
||||
[
|
||||
[
|
||||
{
|
||||
|
|
|
|||
|
|
@ -474,7 +474,7 @@ cell-bits 32 = [
|
|||
] unit-test
|
||||
|
||||
! A reduction
|
||||
: buffalo-sauce f ;
|
||||
: buffalo-sauce ( -- value ) f ;
|
||||
|
||||
: steak ( -- )
|
||||
buffalo-sauce [ steak ] when ; inline recursive
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@ IN: compiler.tree.comparisons
|
|||
|
||||
! Some utilities for working with comparison operations.
|
||||
|
||||
: comparison-ops { < > <= >= } ;
|
||||
CONSTANT: comparison-ops { < > <= >= }
|
||||
|
||||
: generic-comparison-ops { before? after? before=? after=? } ;
|
||||
CONSTANT: generic-comparison-ops { before? after? before=? after=? }
|
||||
|
||||
: assumption ( i1 i2 op -- i3 )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -144,7 +144,7 @@ SYMBOL: node-count
|
|||
|
||||
: make-report ( word/quot -- assoc )
|
||||
[
|
||||
dup word? [ build-tree-from-word nip ] [ build-tree ] if
|
||||
dup word? [ build-tree-from-word ] [ build-tree ] if
|
||||
optimize-tree
|
||||
|
||||
H{ } clone words-called set
|
||||
|
|
|
|||
|
|
@ -87,7 +87,7 @@ compiler.tree.combinators ;
|
|||
] contains-node?
|
||||
] unit-test
|
||||
|
||||
: blah f ;
|
||||
: blah ( -- value ) f ;
|
||||
|
||||
DEFER: a
|
||||
|
||||
|
|
|
|||
|
|
@ -7,20 +7,20 @@ IN: core-foundation.strings
|
|||
TYPEDEF: void* CFStringRef
|
||||
|
||||
TYPEDEF: int CFStringEncoding
|
||||
: kCFStringEncodingMacRoman HEX: 0 ;
|
||||
: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
|
||||
: kCFStringEncodingISOLatin1 HEX: 0201 ;
|
||||
: kCFStringEncodingNextStepLatin HEX: 0B01 ;
|
||||
: kCFStringEncodingASCII HEX: 0600 ;
|
||||
: kCFStringEncodingUnicode HEX: 0100 ;
|
||||
: kCFStringEncodingUTF8 HEX: 08000100 ;
|
||||
: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
|
||||
: kCFStringEncodingUTF16 HEX: 0100 ;
|
||||
: kCFStringEncodingUTF16BE HEX: 10000100 ;
|
||||
: kCFStringEncodingUTF16LE HEX: 14000100 ;
|
||||
: kCFStringEncodingUTF32 HEX: 0c000100 ;
|
||||
: kCFStringEncodingUTF32BE HEX: 18000100 ;
|
||||
: kCFStringEncodingUTF32LE HEX: 1c000100 ;
|
||||
CONSTANT: kCFStringEncodingMacRoman HEX: 0
|
||||
CONSTANT: kCFStringEncodingWindowsLatin1 HEX: 0500
|
||||
CONSTANT: kCFStringEncodingISOLatin1 HEX: 0201
|
||||
CONSTANT: kCFStringEncodingNextStepLatin HEX: 0B01
|
||||
CONSTANT: kCFStringEncodingASCII HEX: 0600
|
||||
CONSTANT: kCFStringEncodingUnicode HEX: 0100
|
||||
CONSTANT: kCFStringEncodingUTF8 HEX: 08000100
|
||||
CONSTANT: kCFStringEncodingNonLossyASCII HEX: 0BFF
|
||||
CONSTANT: kCFStringEncodingUTF16 HEX: 0100
|
||||
CONSTANT: kCFStringEncodingUTF16BE HEX: 10000100
|
||||
CONSTANT: kCFStringEncodingUTF16LE HEX: 14000100
|
||||
CONSTANT: kCFStringEncodingUTF32 HEX: 0c000100
|
||||
CONSTANT: kCFStringEncodingUTF32BE HEX: 18000100
|
||||
CONSTANT: kCFStringEncodingUTF32LE HEX: 1c000100
|
||||
|
||||
FUNCTION: CFStringRef CFStringCreateWithBytes (
|
||||
CFAllocatorRef alloc,
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ stand-alone
|
|||
= (line | code | heading | list | table | paragraph | nl)*
|
||||
;EBNF
|
||||
|
||||
: invalid-url "javascript:alert('Invalid URL in farkup');" ;
|
||||
CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
|
||||
|
||||
: check-url ( href -- href' )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -80,9 +80,9 @@ M: object fake-quotations> ;
|
|||
scan-param parsed
|
||||
\ add-mixin-instance parsed ; parsing
|
||||
|
||||
: `inline \ inline parsed ; parsing
|
||||
: `inline [ word make-inline ] over push-all ; parsing
|
||||
|
||||
: `parsing \ parsing parsed ; parsing
|
||||
: `parsing [ word make-parsing ] over push-all ; parsing
|
||||
|
||||
: `(
|
||||
")" parse-effect effect set ; parsing
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ TUPLE: action rest init authorize display validate submit ;
|
|||
: param ( name -- value )
|
||||
params get at ;
|
||||
|
||||
: revalidate-url-key "__u" ;
|
||||
CONSTANT: revalidate-url-key "__u"
|
||||
|
||||
: revalidate-url ( -- url/f )
|
||||
revalidate-url-key param
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ furnace.auth.providers
|
|||
furnace.auth.login.permits ;
|
||||
IN: furnace.alloy
|
||||
|
||||
: state-classes { session aside conversation permit } ; inline
|
||||
CONSTANT: state-classes { session aside conversation permit }
|
||||
|
||||
: init-furnace-tables ( -- )
|
||||
state-classes ensure-tables
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ aside "ASIDES" {
|
|||
{ "post-data" "POST_DATA" FACTOR-BLOB }
|
||||
} define-persistent
|
||||
|
||||
: aside-id-key "__a" ;
|
||||
CONSTANT: aside-id-key "__a"
|
||||
|
||||
TUPLE: asides < server-state-manager ;
|
||||
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ SYMBOL: capabilities
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: flashed-variables { description capabilities } ;
|
||||
CONSTANT: flashed-variables { description capabilities }
|
||||
|
||||
: login-failed ( -- * )
|
||||
"invalid username or password" validation-error
|
||||
|
|
|
|||
|
|
@ -3,9 +3,7 @@
|
|||
USING: furnace.auth.providers kernel ;
|
||||
IN: furnace.auth.providers.null
|
||||
|
||||
TUPLE: no-users ;
|
||||
|
||||
: no-users T{ no-users } ;
|
||||
SINGLETON: no-users
|
||||
|
||||
M: no-users get-user 2drop f ;
|
||||
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ conversation "CONVERSATIONS" {
|
|||
{ "session" "SESSION" BIG-INTEGER +not-null+ }
|
||||
} define-persistent
|
||||
|
||||
: conversation-id-key "__c" ;
|
||||
CONSTANT: conversation-id-key "__c"
|
||||
|
||||
TUPLE: conversations < server-state-manager ;
|
||||
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ TUPLE: sessions < server-state-manager domain verify? ;
|
|||
[ session set ] [ save-session-after ] bi
|
||||
sessions get responder>> call-responder ;
|
||||
|
||||
: session-id-key "__s" ;
|
||||
CONSTANT: session-id-key "__s"
|
||||
|
||||
: verify-session ( session -- session )
|
||||
sessions get verify?>> [
|
||||
|
|
|
|||
|
|
@ -89,7 +89,7 @@ M: object modify-form drop f ;
|
|||
[XML <input type="hidden" value=<-> name=<->/> XML]
|
||||
] [ drop ] if ;
|
||||
|
||||
: nested-forms-key "__n" ;
|
||||
CONSTANT: nested-forms-key "__n"
|
||||
|
||||
: request-params ( request -- assoc )
|
||||
dup method>> {
|
||||
|
|
@ -131,7 +131,7 @@ M: object modify-form drop f ;
|
|||
|
||||
SYMBOL: exit-continuation
|
||||
|
||||
: exit-with ( value -- )
|
||||
: exit-with ( value -- * )
|
||||
exit-continuation get continue-with ;
|
||||
|
||||
: with-exit-continuation ( quot -- value )
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ tags [ H{ } clone ] initialize
|
|||
: CHLOE:
|
||||
scan parse-definition define-chloe-tag ; parsing
|
||||
|
||||
: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
|
||||
CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0"
|
||||
|
||||
: chloe-name? ( name -- ? )
|
||||
url>> chloe-ns = ;
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ M: io-timeout summary drop "I/O operation timed out" ;
|
|||
'[ handle>> _ wait-for-fd ] with-timeout ;
|
||||
|
||||
! Some general stuff
|
||||
: file-mode OCT: 0666 ;
|
||||
CONSTANT: file-mode OCT: 0666
|
||||
|
||||
! Readers
|
||||
: (refill) ( port -- n )
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ USING: math.parser arrays io.encodings sequences kernel assocs
|
|||
hashtables io.encodings.ascii generic parser classes.tuple words
|
||||
words.symbol io io.files splitting namespaces math
|
||||
compiler.units accessors classes.singleton classes.mixin
|
||||
io.encodings.iana ;
|
||||
io.encodings.iana fry ;
|
||||
IN: io.encodings.8-bit
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: mappings {
|
||||
CONSTANT: mappings {
|
||||
! encoding-name iana-name file-name
|
||||
{ "latin1" "ISO_8859-1:1987" "8859-1" }
|
||||
{ "latin2" "ISO_8859-2:1987" "8859-2" }
|
||||
|
|
@ -30,11 +30,10 @@ IN: io.encodings.8-bit
|
|||
{ "windows-1252" "windows-1252" "CP1252" }
|
||||
{ "ebcdic" "IBM037" "CP037" }
|
||||
{ "mac-roman" "macintosh" "ROMAN" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: encoding-file ( file-name -- stream )
|
||||
"vocab:io/encodings/8-bit/" swap ".TXT"
|
||||
3append ;
|
||||
"vocab:io/encodings/8-bit/" ".TXT" surround ;
|
||||
|
||||
: process-contents ( lines -- assoc )
|
||||
[ "#" split1 drop ] map harvest
|
||||
|
|
@ -42,7 +41,7 @@ IN: io.encodings.8-bit
|
|||
|
||||
: byte>ch ( assoc -- array )
|
||||
256 replacement-char <array>
|
||||
[ [ swapd set-nth ] curry assoc-each ] keep ;
|
||||
[ '[ swap _ set-nth ] assoc-each ] keep ;
|
||||
|
||||
: ch>byte ( assoc -- newassoc )
|
||||
[ swap ] assoc-map >hashtable ;
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ SYMBOL: log-files
|
|||
dup values [ try-dispose ] each
|
||||
clear-assoc ;
|
||||
|
||||
: keep-logs 10 ;
|
||||
CONSTANT: keep-logs 10
|
||||
|
||||
: ?delete-file ( path -- )
|
||||
dup exists? [ delete-file ] [ drop ] if ;
|
||||
|
|
|
|||
|
|
@ -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: parser kernel sequences words effects combinators assocs
|
||||
definitions quotations namespaces memoize accessors ;
|
||||
|
|
@ -7,7 +7,7 @@ IN: macros
|
|||
<PRIVATE
|
||||
|
||||
: real-macro-effect ( word -- effect' )
|
||||
"declared-effect" word-prop in>> 1 <effect> ;
|
||||
stack-effect in>> 1 <effect> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -45,13 +45,13 @@ PRIVATE>
|
|||
first2 [ imaginary-part ] dip >rect 3array ;
|
||||
|
||||
! Zero
|
||||
: q0 { 0 0 } ;
|
||||
CONSTANT: q0 { 0 0 }
|
||||
|
||||
! Units
|
||||
: q1 { 1 0 } ;
|
||||
: qi { C{ 0 1 } 0 } ;
|
||||
: qj { 0 1 } ;
|
||||
: qk { 0 C{ 0 1 } } ;
|
||||
CONSTANT: q1 { 1 0 }
|
||||
CONSTANT: qi { C{ 0 1 } 0 }
|
||||
CONSTANT: qj { 0 1 }
|
||||
CONSTANT: qk { 0 C{ 0 1 } }
|
||||
|
||||
! Euler angles
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel memoize tools.test parser generalizations
|
||||
prettyprint io.streams.string sequences eval ;
|
||||
|
|
@ -17,6 +17,10 @@ MEMO: see-test ( a -- b ) reverse ;
|
|||
[ [ \ see-test see ] with-string-writer ]
|
||||
unit-test
|
||||
|
||||
[ ] [ "IN: memoize.tests : fib ;" eval ] unit-test
|
||||
[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test
|
||||
|
||||
[ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
|
||||
|
||||
[ sq ] (( a -- b )) memoize-quot "q" set
|
||||
|
||||
[ 9 ] [ 3 "q" get call ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,47 +1,45 @@
|
|||
! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel hashtables sequences arrays words namespaces make
|
||||
parser math assocs effects definitions quotations summary
|
||||
accessors ;
|
||||
accessors fry ;
|
||||
IN: memoize
|
||||
|
||||
: packer ( n -- quot )
|
||||
{ [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
|
||||
|
||||
: unpacker ( n -- quot )
|
||||
{ [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
|
||||
|
||||
: #in ( word -- n )
|
||||
stack-effect in>> length ;
|
||||
|
||||
: #out ( word -- n )
|
||||
stack-effect out>> length ;
|
||||
|
||||
: pack/unpack ( quot word -- newquot )
|
||||
[ dup #in unpacker % swap % #out packer % ] [ ] make ;
|
||||
|
||||
: make-memoizer ( quot word -- quot )
|
||||
[
|
||||
[ #in packer % ] keep
|
||||
[ "memoize" word-prop , ] keep
|
||||
[ pack/unpack , ] keep
|
||||
\ cache ,
|
||||
#out unpacker %
|
||||
] [ ] make ;
|
||||
|
||||
ERROR: too-many-arguments ;
|
||||
|
||||
M: too-many-arguments summary
|
||||
drop "There must be no more than 4 input and 4 output arguments" ;
|
||||
|
||||
: check-memoized ( word -- )
|
||||
[ #in ] [ #out ] bi [ 4 > ] either? [ too-many-arguments ] when ;
|
||||
<PRIVATE
|
||||
|
||||
: packer ( seq -- quot )
|
||||
length { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
|
||||
|
||||
: unpacker ( seq -- quot )
|
||||
length { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
|
||||
|
||||
: pack/unpack ( quot effect -- newquot )
|
||||
[ in>> packer ] [ out>> unpacker ] bi surround ;
|
||||
|
||||
: unpack/pack ( quot effect -- newquot )
|
||||
[ in>> unpacker ] [ out>> packer ] bi surround ;
|
||||
|
||||
: check-memoized ( effect -- )
|
||||
[ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ;
|
||||
|
||||
: make-memoizer ( table quot effect -- quot )
|
||||
[ check-memoized ] keep
|
||||
[ unpack/pack '[ _ _ cache ] ] keep
|
||||
pack/unpack ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-memoized ( word quot -- )
|
||||
over check-memoized
|
||||
2dup "memo-quot" set-word-prop
|
||||
over H{ } clone "memoize" set-word-prop
|
||||
over make-memoizer define ;
|
||||
[ H{ } clone ] dip
|
||||
[ pick stack-effect make-memoizer define ]
|
||||
[ nip "memo-quot" set-word-prop ]
|
||||
[ drop "memoize" set-word-prop ]
|
||||
3tri ;
|
||||
|
||||
: MEMO: (:) define-memoized ; parsing
|
||||
|
||||
|
|
@ -57,11 +55,10 @@ M: memoized reset-word
|
|||
bi ;
|
||||
|
||||
: memoize-quot ( quot effect -- memo-quot )
|
||||
gensym swap dupd "declared-effect" set-word-prop
|
||||
dup rot define-memoized 1quotation ;
|
||||
[ H{ } clone ] 2dip make-memoizer ;
|
||||
|
||||
: reset-memoized ( word -- )
|
||||
"memoize" word-prop clear-assoc ;
|
||||
|
||||
: invalidate-memoized ( inputs... word -- )
|
||||
[ #in packer call ] [ "memoize" word-prop delete-at ] bi ;
|
||||
[ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Just a dummy shell for the -run switch...
|
||||
IN: none
|
||||
|
||||
: none ;
|
||||
: none ( -- ) ;
|
||||
|
||||
MAIN: none
|
||||
|
|
|
|||
|
|
@ -11,183 +11,183 @@ TYPEDEF: void* GLubyte*
|
|||
TYPEDEF: void* GLUfuncptr
|
||||
|
||||
! StringName
|
||||
: GLU_VERSION 100800 ;
|
||||
: GLU_EXTENSIONS 100801 ;
|
||||
CONSTANT: GLU_VERSION 100800
|
||||
CONSTANT: GLU_EXTENSIONS 100801
|
||||
|
||||
! ErrorCode
|
||||
: GLU_INVALID_ENUM 100900 ;
|
||||
: GLU_INVALID_VALUE 100901 ;
|
||||
: GLU_OUT_OF_MEMORY 100902 ;
|
||||
: GLU_INCOMPATIBLE_GL_VERSION 100903 ;
|
||||
: GLU_INVALID_OPERATION 100904 ;
|
||||
CONSTANT: GLU_INVALID_ENUM 100900
|
||||
CONSTANT: GLU_INVALID_VALUE 100901
|
||||
CONSTANT: GLU_OUT_OF_MEMORY 100902
|
||||
CONSTANT: GLU_INCOMPATIBLE_GL_VERSION 100903
|
||||
CONSTANT: GLU_INVALID_OPERATION 100904
|
||||
|
||||
! NurbsDisplay
|
||||
: GLU_OUTLINE_POLYGON 100240 ;
|
||||
: GLU_OUTLINE_PATCH 100241 ;
|
||||
CONSTANT: GLU_OUTLINE_POLYGON 100240
|
||||
CONSTANT: GLU_OUTLINE_PATCH 100241
|
||||
|
||||
! NurbsCallback
|
||||
: GLU_NURBS_ERROR 100103 ;
|
||||
: GLU_ERROR 100103 ;
|
||||
: GLU_NURBS_BEGIN 100164 ;
|
||||
: GLU_NURBS_BEGIN_EXT 100164 ;
|
||||
: GLU_NURBS_VERTEX 100165 ;
|
||||
: GLU_NURBS_VERTEX_EXT 100165 ;
|
||||
: GLU_NURBS_NORMAL 100166 ;
|
||||
: GLU_NURBS_NORMAL_EXT 100166 ;
|
||||
: GLU_NURBS_COLOR 100167 ;
|
||||
: GLU_NURBS_COLOR_EXT 100167 ;
|
||||
: GLU_NURBS_TEXTURE_COORD 100168 ;
|
||||
: GLU_NURBS_TEX_COORD_EXT 100168 ;
|
||||
: GLU_NURBS_END 100169 ;
|
||||
: GLU_NURBS_END_EXT 100169 ;
|
||||
: GLU_NURBS_BEGIN_DATA 100170 ;
|
||||
: GLU_NURBS_BEGIN_DATA_EXT 100170 ;
|
||||
: GLU_NURBS_VERTEX_DATA 100171 ;
|
||||
: GLU_NURBS_VERTEX_DATA_EXT 100171 ;
|
||||
: GLU_NURBS_NORMAL_DATA 100172 ;
|
||||
: GLU_NURBS_NORMAL_DATA_EXT 100172 ;
|
||||
: GLU_NURBS_COLOR_DATA 100173 ;
|
||||
: GLU_NURBS_COLOR_DATA_EXT 100173 ;
|
||||
: GLU_NURBS_TEXTURE_COORD_DATA 100174 ;
|
||||
: GLU_NURBS_TEX_COORD_DATA_EXT 100174 ;
|
||||
: GLU_NURBS_END_DATA 100175 ;
|
||||
: GLU_NURBS_END_DATA_EXT 100175 ;
|
||||
CONSTANT: GLU_NURBS_ERROR 100103
|
||||
CONSTANT: GLU_ERROR 100103
|
||||
CONSTANT: GLU_NURBS_BEGIN 100164
|
||||
CONSTANT: GLU_NURBS_BEGIN_EXT 100164
|
||||
CONSTANT: GLU_NURBS_VERTEX 100165
|
||||
CONSTANT: GLU_NURBS_VERTEX_EXT 100165
|
||||
CONSTANT: GLU_NURBS_NORMAL 100166
|
||||
CONSTANT: GLU_NURBS_NORMAL_EXT 100166
|
||||
CONSTANT: GLU_NURBS_COLOR 100167
|
||||
CONSTANT: GLU_NURBS_COLOR_EXT 100167
|
||||
CONSTANT: GLU_NURBS_TEXTURE_COORD 100168
|
||||
CONSTANT: GLU_NURBS_TEX_COORD_EXT 100168
|
||||
CONSTANT: GLU_NURBS_END 100169
|
||||
CONSTANT: GLU_NURBS_END_EXT 100169
|
||||
CONSTANT: GLU_NURBS_BEGIN_DATA 100170
|
||||
CONSTANT: GLU_NURBS_BEGIN_DATA_EXT 100170
|
||||
CONSTANT: GLU_NURBS_VERTEX_DATA 100171
|
||||
CONSTANT: GLU_NURBS_VERTEX_DATA_EXT 100171
|
||||
CONSTANT: GLU_NURBS_NORMAL_DATA 100172
|
||||
CONSTANT: GLU_NURBS_NORMAL_DATA_EXT 100172
|
||||
CONSTANT: GLU_NURBS_COLOR_DATA 100173
|
||||
CONSTANT: GLU_NURBS_COLOR_DATA_EXT 100173
|
||||
CONSTANT: GLU_NURBS_TEXTURE_COORD_DATA 100174
|
||||
CONSTANT: GLU_NURBS_TEX_COORD_DATA_EXT 100174
|
||||
CONSTANT: GLU_NURBS_END_DATA 100175
|
||||
CONSTANT: GLU_NURBS_END_DATA_EXT 100175
|
||||
|
||||
! NurbsError
|
||||
: GLU_NURBS_ERROR1 100251 ;
|
||||
: GLU_NURBS_ERROR2 100252 ;
|
||||
: GLU_NURBS_ERROR3 100253 ;
|
||||
: GLU_NURBS_ERROR4 100254 ;
|
||||
: GLU_NURBS_ERROR5 100255 ;
|
||||
: GLU_NURBS_ERROR6 100256 ;
|
||||
: GLU_NURBS_ERROR7 100257 ;
|
||||
: GLU_NURBS_ERROR8 100258 ;
|
||||
: GLU_NURBS_ERROR9 100259 ;
|
||||
: GLU_NURBS_ERROR10 100260 ;
|
||||
: GLU_NURBS_ERROR11 100261 ;
|
||||
: GLU_NURBS_ERROR12 100262 ;
|
||||
: GLU_NURBS_ERROR13 100263 ;
|
||||
: GLU_NURBS_ERROR14 100264 ;
|
||||
: GLU_NURBS_ERROR15 100265 ;
|
||||
: GLU_NURBS_ERROR16 100266 ;
|
||||
: GLU_NURBS_ERROR17 100267 ;
|
||||
: GLU_NURBS_ERROR18 100268 ;
|
||||
: GLU_NURBS_ERROR19 100269 ;
|
||||
: GLU_NURBS_ERROR20 100270 ;
|
||||
: GLU_NURBS_ERROR21 100271 ;
|
||||
: GLU_NURBS_ERROR22 100272 ;
|
||||
: GLU_NURBS_ERROR23 100273 ;
|
||||
: GLU_NURBS_ERROR24 100274 ;
|
||||
: GLU_NURBS_ERROR25 100275 ;
|
||||
: GLU_NURBS_ERROR26 100276 ;
|
||||
: GLU_NURBS_ERROR27 100277 ;
|
||||
: GLU_NURBS_ERROR28 100278 ;
|
||||
: GLU_NURBS_ERROR29 100279 ;
|
||||
: GLU_NURBS_ERROR30 100280 ;
|
||||
: GLU_NURBS_ERROR31 100281 ;
|
||||
: GLU_NURBS_ERROR32 100282 ;
|
||||
: GLU_NURBS_ERROR33 100283 ;
|
||||
: GLU_NURBS_ERROR34 100284 ;
|
||||
: GLU_NURBS_ERROR35 100285 ;
|
||||
: GLU_NURBS_ERROR36 100286 ;
|
||||
: GLU_NURBS_ERROR37 100287 ;
|
||||
CONSTANT: GLU_NURBS_ERROR1 100251
|
||||
CONSTANT: GLU_NURBS_ERROR2 100252
|
||||
CONSTANT: GLU_NURBS_ERROR3 100253
|
||||
CONSTANT: GLU_NURBS_ERROR4 100254
|
||||
CONSTANT: GLU_NURBS_ERROR5 100255
|
||||
CONSTANT: GLU_NURBS_ERROR6 100256
|
||||
CONSTANT: GLU_NURBS_ERROR7 100257
|
||||
CONSTANT: GLU_NURBS_ERROR8 100258
|
||||
CONSTANT: GLU_NURBS_ERROR9 100259
|
||||
CONSTANT: GLU_NURBS_ERROR10 100260
|
||||
CONSTANT: GLU_NURBS_ERROR11 100261
|
||||
CONSTANT: GLU_NURBS_ERROR12 100262
|
||||
CONSTANT: GLU_NURBS_ERROR13 100263
|
||||
CONSTANT: GLU_NURBS_ERROR14 100264
|
||||
CONSTANT: GLU_NURBS_ERROR15 100265
|
||||
CONSTANT: GLU_NURBS_ERROR16 100266
|
||||
CONSTANT: GLU_NURBS_ERROR17 100267
|
||||
CONSTANT: GLU_NURBS_ERROR18 100268
|
||||
CONSTANT: GLU_NURBS_ERROR19 100269
|
||||
CONSTANT: GLU_NURBS_ERROR20 100270
|
||||
CONSTANT: GLU_NURBS_ERROR21 100271
|
||||
CONSTANT: GLU_NURBS_ERROR22 100272
|
||||
CONSTANT: GLU_NURBS_ERROR23 100273
|
||||
CONSTANT: GLU_NURBS_ERROR24 100274
|
||||
CONSTANT: GLU_NURBS_ERROR25 100275
|
||||
CONSTANT: GLU_NURBS_ERROR26 100276
|
||||
CONSTANT: GLU_NURBS_ERROR27 100277
|
||||
CONSTANT: GLU_NURBS_ERROR28 100278
|
||||
CONSTANT: GLU_NURBS_ERROR29 100279
|
||||
CONSTANT: GLU_NURBS_ERROR30 100280
|
||||
CONSTANT: GLU_NURBS_ERROR31 100281
|
||||
CONSTANT: GLU_NURBS_ERROR32 100282
|
||||
CONSTANT: GLU_NURBS_ERROR33 100283
|
||||
CONSTANT: GLU_NURBS_ERROR34 100284
|
||||
CONSTANT: GLU_NURBS_ERROR35 100285
|
||||
CONSTANT: GLU_NURBS_ERROR36 100286
|
||||
CONSTANT: GLU_NURBS_ERROR37 100287
|
||||
|
||||
! NurbsProperty
|
||||
: GLU_AUTO_LOAD_MATRIX 100200 ;
|
||||
: GLU_CULLING 100201 ;
|
||||
: GLU_SAMPLING_TOLERANCE 100203 ;
|
||||
: GLU_DISPLAY_MODE 100204 ;
|
||||
: GLU_PARAMETRIC_TOLERANCE 100202 ;
|
||||
: GLU_SAMPLING_METHOD 100205 ;
|
||||
: GLU_U_STEP 100206 ;
|
||||
: GLU_V_STEP 100207 ;
|
||||
: GLU_NURBS_MODE 100160 ;
|
||||
: GLU_NURBS_MODE_EXT 100160 ;
|
||||
: GLU_NURBS_TESSELLATOR 100161 ;
|
||||
: GLU_NURBS_TESSELLATOR_EXT 100161 ;
|
||||
: GLU_NURBS_RENDERER 100162 ;
|
||||
: GLU_NURBS_RENDERER_EXT 100162 ;
|
||||
CONSTANT: GLU_AUTO_LOAD_MATRIX 100200
|
||||
CONSTANT: GLU_CULLING 100201
|
||||
CONSTANT: GLU_SAMPLING_TOLERANCE 100203
|
||||
CONSTANT: GLU_DISPLAY_MODE 100204
|
||||
CONSTANT: GLU_PARAMETRIC_TOLERANCE 100202
|
||||
CONSTANT: GLU_SAMPLING_METHOD 100205
|
||||
CONSTANT: GLU_U_STEP 100206
|
||||
CONSTANT: GLU_V_STEP 100207
|
||||
CONSTANT: GLU_NURBS_MODE 100160
|
||||
CONSTANT: GLU_NURBS_MODE_EXT 100160
|
||||
CONSTANT: GLU_NURBS_TESSELLATOR 100161
|
||||
CONSTANT: GLU_NURBS_TESSELLATOR_EXT 100161
|
||||
CONSTANT: GLU_NURBS_RENDERER 100162
|
||||
CONSTANT: GLU_NURBS_RENDERER_EXT 100162
|
||||
|
||||
! NurbsSampling
|
||||
: GLU_OBJECT_PARAMETRIC_ERROR 100208 ;
|
||||
: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208 ;
|
||||
: GLU_OBJECT_PATH_LENGTH 100209 ;
|
||||
: GLU_OBJECT_PATH_LENGTH_EXT 100209 ;
|
||||
: GLU_PATH_LENGTH 100215 ;
|
||||
: GLU_PARAMETRIC_ERROR 100216 ;
|
||||
: GLU_DOMAIN_DISTANCE 100217 ;
|
||||
CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR 100208
|
||||
CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208
|
||||
CONSTANT: GLU_OBJECT_PATH_LENGTH 100209
|
||||
CONSTANT: GLU_OBJECT_PATH_LENGTH_EXT 100209
|
||||
CONSTANT: GLU_PATH_LENGTH 100215
|
||||
CONSTANT: GLU_PARAMETRIC_ERROR 100216
|
||||
CONSTANT: GLU_DOMAIN_DISTANCE 100217
|
||||
|
||||
! NurbsTrim
|
||||
: GLU_MAP1_TRIM_2 100210 ;
|
||||
: GLU_MAP1_TRIM_3 100211 ;
|
||||
CONSTANT: GLU_MAP1_TRIM_2 100210
|
||||
CONSTANT: GLU_MAP1_TRIM_3 100211
|
||||
|
||||
! QuadricDrawStyle
|
||||
: GLU_POINT 100010 ;
|
||||
: GLU_LINE 100011 ;
|
||||
: GLU_FILL 100012 ;
|
||||
: GLU_SILHOUETTE 100013 ;
|
||||
CONSTANT: GLU_POINT 100010
|
||||
CONSTANT: GLU_LINE 100011
|
||||
CONSTANT: GLU_FILL 100012
|
||||
CONSTANT: GLU_SILHOUETTE 100013
|
||||
|
||||
! QuadricNormal
|
||||
: GLU_SMOOTH 100000 ;
|
||||
: GLU_FLAT 100001 ;
|
||||
: GLU_NONE 100002 ;
|
||||
CONSTANT: GLU_SMOOTH 100000
|
||||
CONSTANT: GLU_FLAT 100001
|
||||
CONSTANT: GLU_NONE 100002
|
||||
|
||||
! QuadricOrientation
|
||||
: GLU_OUTSIDE 100020 ;
|
||||
: GLU_INSIDE 100021 ;
|
||||
CONSTANT: GLU_OUTSIDE 100020
|
||||
CONSTANT: GLU_INSIDE 100021
|
||||
|
||||
! TessCallback
|
||||
: GLU_TESS_BEGIN 100100 ;
|
||||
: GLU_BEGIN 100100 ;
|
||||
: GLU_TESS_VERTEX 100101 ;
|
||||
: GLU_VERTEX 100101 ;
|
||||
: GLU_TESS_END 100102 ;
|
||||
: GLU_END 100102 ;
|
||||
: GLU_TESS_ERROR 100103 ;
|
||||
: GLU_TESS_EDGE_FLAG 100104 ;
|
||||
: GLU_EDGE_FLAG 100104 ;
|
||||
: GLU_TESS_COMBINE 100105 ;
|
||||
: GLU_TESS_BEGIN_DATA 100106 ;
|
||||
: GLU_TESS_VERTEX_DATA 100107 ;
|
||||
: GLU_TESS_END_DATA 100108 ;
|
||||
: GLU_TESS_ERROR_DATA 100109 ;
|
||||
: GLU_TESS_EDGE_FLAG_DATA 100110 ;
|
||||
: GLU_TESS_COMBINE_DATA 100111 ;
|
||||
CONSTANT: GLU_TESS_BEGIN 100100
|
||||
CONSTANT: GLU_BEGIN 100100
|
||||
CONSTANT: GLU_TESS_VERTEX 100101
|
||||
CONSTANT: GLU_VERTEX 100101
|
||||
CONSTANT: GLU_TESS_END 100102
|
||||
CONSTANT: GLU_END 100102
|
||||
CONSTANT: GLU_TESS_ERROR 100103
|
||||
CONSTANT: GLU_TESS_EDGE_FLAG 100104
|
||||
CONSTANT: GLU_EDGE_FLAG 100104
|
||||
CONSTANT: GLU_TESS_COMBINE 100105
|
||||
CONSTANT: GLU_TESS_BEGIN_DATA 100106
|
||||
CONSTANT: GLU_TESS_VERTEX_DATA 100107
|
||||
CONSTANT: GLU_TESS_END_DATA 100108
|
||||
CONSTANT: GLU_TESS_ERROR_DATA 100109
|
||||
CONSTANT: GLU_TESS_EDGE_FLAG_DATA 100110
|
||||
CONSTANT: GLU_TESS_COMBINE_DATA 100111
|
||||
|
||||
! TessContour
|
||||
: GLU_CW 100120 ;
|
||||
: GLU_CCW 100121 ;
|
||||
: GLU_INTERIOR 100122 ;
|
||||
: GLU_EXTERIOR 100123 ;
|
||||
: GLU_UNKNOWN 100124 ;
|
||||
CONSTANT: GLU_CW 100120
|
||||
CONSTANT: GLU_CCW 100121
|
||||
CONSTANT: GLU_INTERIOR 100122
|
||||
CONSTANT: GLU_EXTERIOR 100123
|
||||
CONSTANT: GLU_UNKNOWN 100124
|
||||
|
||||
! TessProperty
|
||||
: GLU_TESS_WINDING_RULE 100140 ;
|
||||
: GLU_TESS_BOUNDARY_ONLY 100141 ;
|
||||
: GLU_TESS_TOLERANCE 100142 ;
|
||||
CONSTANT: GLU_TESS_WINDING_RULE 100140
|
||||
CONSTANT: GLU_TESS_BOUNDARY_ONLY 100141
|
||||
CONSTANT: GLU_TESS_TOLERANCE 100142
|
||||
|
||||
! TessError
|
||||
: GLU_TESS_ERROR1 100151 ;
|
||||
: GLU_TESS_ERROR2 100152 ;
|
||||
: GLU_TESS_ERROR3 100153 ;
|
||||
: GLU_TESS_ERROR4 100154 ;
|
||||
: GLU_TESS_ERROR5 100155 ;
|
||||
: GLU_TESS_ERROR6 100156 ;
|
||||
: GLU_TESS_ERROR7 100157 ;
|
||||
: GLU_TESS_ERROR8 100158 ;
|
||||
: GLU_TESS_MISSING_BEGIN_POLYGON 100151 ;
|
||||
: GLU_TESS_MISSING_BEGIN_CONTOUR 100152 ;
|
||||
: GLU_TESS_MISSING_END_POLYGON 100153 ;
|
||||
: GLU_TESS_MISSING_END_CONTOUR 100154 ;
|
||||
: GLU_TESS_COORD_TOO_LARGE 100155 ;
|
||||
: GLU_TESS_NEED_COMBINE_CALLBACK 100156 ;
|
||||
CONSTANT: GLU_TESS_ERROR1 100151
|
||||
CONSTANT: GLU_TESS_ERROR2 100152
|
||||
CONSTANT: GLU_TESS_ERROR3 100153
|
||||
CONSTANT: GLU_TESS_ERROR4 100154
|
||||
CONSTANT: GLU_TESS_ERROR5 100155
|
||||
CONSTANT: GLU_TESS_ERROR6 100156
|
||||
CONSTANT: GLU_TESS_ERROR7 100157
|
||||
CONSTANT: GLU_TESS_ERROR8 100158
|
||||
CONSTANT: GLU_TESS_MISSING_BEGIN_POLYGON 100151
|
||||
CONSTANT: GLU_TESS_MISSING_BEGIN_CONTOUR 100152
|
||||
CONSTANT: GLU_TESS_MISSING_END_POLYGON 100153
|
||||
CONSTANT: GLU_TESS_MISSING_END_CONTOUR 100154
|
||||
CONSTANT: GLU_TESS_COORD_TOO_LARGE 100155
|
||||
CONSTANT: GLU_TESS_NEED_COMBINE_CALLBACK 100156
|
||||
|
||||
! TessWinding
|
||||
: GLU_TESS_WINDING_ODD 100130 ;
|
||||
: GLU_TESS_WINDING_NONZERO 100131 ;
|
||||
: GLU_TESS_WINDING_POSITIVE 100132 ;
|
||||
: GLU_TESS_WINDING_NEGATIVE 100133 ;
|
||||
: GLU_TESS_WINDING_ABS_GEQ_TWO 100134 ;
|
||||
CONSTANT: GLU_TESS_WINDING_ODD 100130
|
||||
CONSTANT: GLU_TESS_WINDING_NONZERO 100131
|
||||
CONSTANT: GLU_TESS_WINDING_POSITIVE 100132
|
||||
CONSTANT: GLU_TESS_WINDING_NEGATIVE 100133
|
||||
CONSTANT: GLU_TESS_WINDING_ABS_GEQ_TWO 100134
|
||||
|
||||
LIBRARY: glu
|
||||
|
||||
|
|
|
|||
|
|
@ -99,7 +99,7 @@ FUNCTION: void* BIO_f_buffer ( ) ;
|
|||
! evp.h
|
||||
! ===============================================
|
||||
|
||||
: EVP_MAX_MD_SIZE 64 ;
|
||||
CONSTANT: EVP_MAX_MD_SIZE 64
|
||||
|
||||
C-STRUCT: EVP_MD_CTX
|
||||
{ "EVP_MD*" "digest" }
|
||||
|
|
|
|||
|
|
@ -7,12 +7,12 @@ IN: peg.parsers
|
|||
|
||||
TUPLE: just-parser p1 ;
|
||||
|
||||
: just-pattern
|
||||
CONSTANT: just-pattern
|
||||
[
|
||||
execute dup [
|
||||
dup remaining>> empty? [ drop f ] unless
|
||||
] when
|
||||
] ;
|
||||
]
|
||||
|
||||
|
||||
M: just-parser (compile) ( parser -- quot )
|
||||
|
|
|
|||
|
|
@ -124,18 +124,13 @@ M: object apply-object push-literal ;
|
|||
: undo-infer ( -- )
|
||||
recorded get [ f "inferred-effect" set-word-prop ] each ;
|
||||
|
||||
: consume/produce ( effect quot -- )
|
||||
#! quot is ( inputs outputs -- )
|
||||
[
|
||||
[
|
||||
[ in>> length consume-d ]
|
||||
[ out>> length produce-d ]
|
||||
bi
|
||||
] dip call
|
||||
] [
|
||||
drop
|
||||
terminated?>> [ terminate ] when
|
||||
] 2bi ; inline
|
||||
: (consume/produce) ( effect -- inputs outputs )
|
||||
[ in>> length consume-d ] [ out>> length produce-d ] bi ;
|
||||
|
||||
: consume/produce ( effect quot: ( inputs outputs -- ) -- )
|
||||
'[ (consume/produce) @ ]
|
||||
[ terminated?>> [ terminate ] when ]
|
||||
bi ; inline
|
||||
|
||||
: infer-word-def ( word -- )
|
||||
[ specialized-def ] [ add-recursive-state ] bi infer-quot ;
|
||||
|
|
@ -143,30 +138,18 @@ M: object apply-object push-literal ;
|
|||
: end-infer ( -- )
|
||||
meta-d clone #return, ;
|
||||
|
||||
: effect-required? ( word -- ? )
|
||||
{
|
||||
{ [ dup deferred? ] [ drop f ] }
|
||||
{ [ dup crossref? not ] [ drop f ] }
|
||||
[ def>> [ word? ] any? ]
|
||||
} cond ;
|
||||
|
||||
: ?missing-effect ( word -- )
|
||||
dup effect-required?
|
||||
[ missing-effect inference-error ] [ drop ] if ;
|
||||
: required-stack-effect ( word -- effect )
|
||||
dup stack-effect [ ] [ missing-effect inference-error ] ?if ;
|
||||
|
||||
: check-effect ( word effect -- )
|
||||
over stack-effect {
|
||||
{ [ dup not ] [ 2drop ?missing-effect ] }
|
||||
{ [ 2dup effect<= ] [ 3drop ] }
|
||||
[ effect-error ]
|
||||
} cond ;
|
||||
over required-stack-effect 2dup effect<=
|
||||
[ 3drop ] [ effect-error ] if ;
|
||||
|
||||
: finish-word ( word -- )
|
||||
current-effect
|
||||
[ check-effect ]
|
||||
[ drop recorded get push ]
|
||||
[ "inferred-effect" set-word-prop ]
|
||||
2tri ;
|
||||
[ current-effect check-effect ]
|
||||
[ recorded get push ]
|
||||
[ t "inferred-effect" set-word-prop ]
|
||||
tri ;
|
||||
|
||||
: cannot-infer-effect ( word -- * )
|
||||
"cannot-infer" word-prop throw ;
|
||||
|
|
@ -183,22 +166,20 @@ M: object apply-object push-literal ;
|
|||
dependencies off
|
||||
generic-dependencies off
|
||||
[ infer-word-def end-infer ]
|
||||
[ finish-word current-effect ]
|
||||
bi
|
||||
[ finish-word ]
|
||||
[ stack-effect ]
|
||||
tri
|
||||
] with-scope
|
||||
] maybe-cannot-infer ;
|
||||
|
||||
: apply-word/effect ( word effect -- )
|
||||
swap '[ _ #call, ] consume/produce ;
|
||||
|
||||
: required-stack-effect ( word -- effect )
|
||||
dup stack-effect [ ] [ \ missing-effect inference-error ] ?if ;
|
||||
|
||||
: call-recursive-word ( word -- )
|
||||
dup required-stack-effect apply-word/effect ;
|
||||
|
||||
: cached-infer ( word -- )
|
||||
dup "inferred-effect" word-prop apply-word/effect ;
|
||||
dup stack-effect apply-word/effect ;
|
||||
|
||||
: with-infer ( quot -- effect visitor )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -319,12 +319,18 @@ M: object infer-call*
|
|||
\ fixnum/i { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum/i make-foldable
|
||||
|
||||
\ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum/i-fast make-foldable
|
||||
|
||||
\ fixnum-mod { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-mod make-foldable
|
||||
|
||||
\ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive
|
||||
\ fixnum/mod make-foldable
|
||||
|
||||
\ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive
|
||||
\ fixnum/mod-fast make-foldable
|
||||
|
||||
\ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-bitand make-foldable
|
||||
|
||||
|
|
|
|||
|
|
@ -118,7 +118,7 @@ DEFER: stop
|
|||
[ ] while
|
||||
drop ;
|
||||
|
||||
: start ( namestack thread -- )
|
||||
: start ( namestack thread -- * )
|
||||
[
|
||||
set-self
|
||||
set-namestack
|
||||
|
|
|
|||
|
|
@ -14,12 +14,12 @@ SYMBOL: deploy-threads?
|
|||
|
||||
SYMBOL: deploy-io
|
||||
|
||||
: deploy-io-options
|
||||
CONSTANT: deploy-io-options
|
||||
{
|
||||
{ 1 "Level 1 - No input/output" }
|
||||
{ 2 "Level 2 - Basic ANSI C streams" }
|
||||
{ 3 "Level 3 - Non-blocking streams and networking" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: strip-io? ( -- ? ) deploy-io get 1 = ;
|
||||
|
||||
|
|
@ -27,7 +27,7 @@ SYMBOL: deploy-io
|
|||
|
||||
SYMBOL: deploy-reflection
|
||||
|
||||
: deploy-reflection-options
|
||||
CONSTANT: deploy-reflection-options
|
||||
{
|
||||
{ 1 "Level 1 - No reflection" }
|
||||
{ 2 "Level 2 - Retain word names" }
|
||||
|
|
@ -35,7 +35,7 @@ SYMBOL: deploy-reflection
|
|||
{ 4 "Level 4 - Debugger" }
|
||||
{ 5 "Level 5 - Parser" }
|
||||
{ 6 "Level 6 - Full environment" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: strip-word-names? ( -- ? ) deploy-reflection get 2 < ;
|
||||
: strip-prettyprint? ( -- ? ) deploy-reflection get 3 < ;
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@ IN: tools.deploy.shaker
|
|||
"cannot-infer"
|
||||
"coercer"
|
||||
"combination"
|
||||
"compiled-effect"
|
||||
"compiled-status"
|
||||
"compiled-generic-uses"
|
||||
"compiled-uses"
|
||||
"constraints"
|
||||
|
|
@ -190,7 +190,7 @@ IN: tools.deploy.shaker
|
|||
"Stripping default methods" show
|
||||
[
|
||||
[ generic? ] instances
|
||||
[ "No method" throw ] define-temp
|
||||
[ "No method" throw ] (( -- * )) define-temp
|
||||
dup t "default" set-word-prop
|
||||
'[
|
||||
[ _ "default-method" set-word-prop ] [ make-generic ] bi
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
IN: tools.profiler.tests
|
||||
USING: accessors tools.profiler tools.test kernel memory math
|
||||
threads alien tools.profiler.private sequences compiler.units
|
||||
threads alien tools.profiler.private sequences compiler
|
||||
words ;
|
||||
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -14,15 +14,15 @@ IN: ui.cocoa.views
|
|||
#! Cocoa -> Factor UI button mapping
|
||||
-> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } at ;
|
||||
|
||||
: modifiers
|
||||
CONSTANT: modifiers
|
||||
{
|
||||
{ S+ HEX: 20000 }
|
||||
{ C+ HEX: 40000 }
|
||||
{ A+ HEX: 100000 }
|
||||
{ M+ HEX: 80000 }
|
||||
} ;
|
||||
}
|
||||
|
||||
: key-codes
|
||||
CONSTANT: key-codes
|
||||
H{
|
||||
{ 71 "CLEAR" }
|
||||
{ 36 "RET" }
|
||||
|
|
@ -47,7 +47,7 @@ IN: ui.cocoa.views
|
|||
{ 126 "UP" }
|
||||
{ 116 "PAGE_UP" }
|
||||
{ 121 "PAGE_DOWN" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: key-code ( event -- string ? )
|
||||
dup -> keyCode key-codes at
|
||||
|
|
|
|||
|
|
@ -173,7 +173,7 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: circle-steps 8 ;
|
||||
CONSTANT: circle-steps 8
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -13,16 +13,16 @@ M: glue pref-dim* drop { 0 0 } ;
|
|||
|
||||
: <frame-grid> ( -- grid ) 9 [ <glue> ] replicate 3 group ;
|
||||
|
||||
: @center 1 1 ; inline
|
||||
: @left 0 1 ; inline
|
||||
: @right 2 1 ; inline
|
||||
: @top 1 0 ; inline
|
||||
: @bottom 1 2 ; inline
|
||||
: @center ( -- i j ) 1 1 ; inline
|
||||
: @left ( -- i j ) 0 1 ; inline
|
||||
: @right ( -- i j ) 2 1 ; inline
|
||||
: @top ( -- i j ) 1 0 ; inline
|
||||
: @bottom ( -- i j ) 1 2 ; inline
|
||||
|
||||
: @top-left 0 0 ; inline
|
||||
: @top-right 2 0 ; inline
|
||||
: @bottom-left 0 2 ; inline
|
||||
: @bottom-right 2 2 ; inline
|
||||
: @top-left ( -- i j ) 0 0 ; inline
|
||||
: @top-right ( -- i j ) 2 0 ; inline
|
||||
: @bottom-left ( -- i j ) 0 2 ; inline
|
||||
: @bottom-right ( -- i j ) 2 2 ; inline
|
||||
|
||||
TUPLE: frame < grid ;
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ TUPLE: slider < frame elevator thumb saved line ;
|
|||
: elevator-length ( slider -- n )
|
||||
[ elevator>> dim>> ] [ orientation>> ] bi v. ;
|
||||
|
||||
: min-thumb-dim 15 ;
|
||||
CONSTANT: min-thumb-dim 15
|
||||
|
||||
: slider-value ( gadget -- n ) model>> range-value >fixnum ;
|
||||
: slider-page ( gadget -- n ) model>> range-page-value ;
|
||||
|
|
|
|||
|
|
@ -56,6 +56,6 @@ IN: ui.gadgets.theme
|
|||
T{ gray f 0.5 1.0 }
|
||||
} <gradient> ;
|
||||
|
||||
: sans-serif-font { "sans-serif" plain 12 } ;
|
||||
CONSTANT: sans-serif-font { "sans-serif" plain 12 }
|
||||
|
||||
: monospace-font { "monospace" plain 12 } ;
|
||||
CONSTANT: monospace-font { "monospace" plain 12 }
|
||||
|
|
|
|||
|
|
@ -191,11 +191,11 @@ M: polygon draw-interior
|
|||
[ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ]
|
||||
tri ;
|
||||
|
||||
: arrow-up { { 3 0 } { 6 6 } { 0 6 } } ;
|
||||
: arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;
|
||||
: arrow-down { { 0 0 } { 6 0 } { 3 6 } } ;
|
||||
: arrow-left { { 0 3 } { 6 0 } { 6 6 } } ;
|
||||
: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } ;
|
||||
CONSTANT: arrow-up { { 3 0 } { 6 6 } { 0 6 } }
|
||||
CONSTANT: arrow-right { { 0 0 } { 6 3 } { 0 6 } }
|
||||
CONSTANT: arrow-down { { 0 0 } { 6 0 } { 3 6 } }
|
||||
CONSTANT: arrow-left { { 0 3 } { 6 0 } { 6 6 } }
|
||||
CONSTANT: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } }
|
||||
|
||||
: <polygon-gadget> ( color points -- gadget )
|
||||
dup max-dim
|
||||
|
|
|
|||
|
|
@ -97,8 +97,8 @@ VALUE: properties
|
|||
[ nip zero? not ] assoc-filter
|
||||
>hashtable ;
|
||||
|
||||
: categories ( -- names )
|
||||
! For non-existent characters, use Cn
|
||||
! For non-existent characters, use Cn
|
||||
CONSTANT: categories
|
||||
{ "Cn"
|
||||
"Lu" "Ll" "Lt" "Lm" "Lo"
|
||||
"Mn" "Mc" "Me"
|
||||
|
|
@ -106,9 +106,9 @@ VALUE: properties
|
|||
"Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
|
||||
"Sm" "Sc" "Sk" "So"
|
||||
"Zs" "Zl" "Zp"
|
||||
"Cc" "Cf" "Cs" "Co" } ;
|
||||
"Cc" "Cf" "Cs" "Co" }
|
||||
|
||||
: num-chars HEX: 2FA1E ;
|
||||
CONSTANT: num-chars HEX: 2FA1E
|
||||
|
||||
! the maximum unicode char in the first 3 planes
|
||||
|
||||
|
|
|
|||
|
|
@ -993,8 +993,8 @@ FUNCTION: BOOL DuplicateHandle (
|
|||
BOOL bInheritHandle,
|
||||
DWORD dwOptions ) ;
|
||||
|
||||
: DUPLICATE_CLOSE_SOURCE 1 ;
|
||||
: DUPLICATE_SAME_ACCESS 2 ;
|
||||
CONSTANT: DUPLICATE_CLOSE_SOURCE 1
|
||||
CONSTANT: DUPLICATE_SAME_ACCESS 2
|
||||
|
||||
! FUNCTION: EncodePointer
|
||||
! FUNCTION: EncodeSystemPointer
|
||||
|
|
|
|||
|
|
@ -12,17 +12,17 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! Reserved Resource and Constant Definitions
|
||||
|
||||
: ParentRelative 1 ;
|
||||
: CopyFromParent 0 ;
|
||||
: PointerWindow 0 ;
|
||||
: InputFocus 1 ;
|
||||
: PointerRoot 1 ;
|
||||
: AnyPropertyType 0 ;
|
||||
: AnyKey 0 ;
|
||||
: AnyButton 0 ;
|
||||
: AllTemporary 0 ;
|
||||
: CurrentTime 0 ;
|
||||
: NoSymbol 0 ;
|
||||
CONSTANT: ParentRelative 1
|
||||
CONSTANT: CopyFromParent 0
|
||||
CONSTANT: PointerWindow 0
|
||||
CONSTANT: InputFocus 1
|
||||
CONSTANT: PointerRoot 1
|
||||
CONSTANT: AnyPropertyType 0
|
||||
CONSTANT: AnyKey 0
|
||||
CONSTANT: AnyButton 0
|
||||
CONSTANT: AllTemporary 0
|
||||
CONSTANT: CurrentTime 0
|
||||
CONSTANT: NoSymbol 0
|
||||
|
||||
! Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer,
|
||||
! state in various key-, mouse-, and button-related events.
|
||||
|
|
@ -31,14 +31,14 @@ TYPEDEF: uchar KeyCode
|
|||
! modifier names. Used to build a SetModifierMapping request or
|
||||
! to read a GetModifierMapping request. These correspond to the
|
||||
! masks defined above.
|
||||
: ShiftMapIndex 0 ;
|
||||
: LockMapIndex 1 ;
|
||||
: ControlMapIndex 2 ;
|
||||
: Mod1MapIndex 3 ;
|
||||
: Mod2MapIndex 4 ;
|
||||
: Mod3MapIndex 5 ;
|
||||
: Mod4MapIndex 6 ;
|
||||
: Mod5MapIndex 7 ;
|
||||
CONSTANT: ShiftMapIndex 0
|
||||
CONSTANT: LockMapIndex 1
|
||||
CONSTANT: ControlMapIndex 2
|
||||
CONSTANT: Mod1MapIndex 3
|
||||
CONSTANT: Mod2MapIndex 4
|
||||
CONSTANT: Mod3MapIndex 5
|
||||
CONSTANT: Mod4MapIndex 6
|
||||
CONSTANT: Mod5MapIndex 7
|
||||
|
||||
|
||||
! button masks. Used in same manner as Key masks above. Not to be confused
|
||||
|
|
@ -53,100 +53,100 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! Notify modes
|
||||
|
||||
: NotifyNormal 0 ;
|
||||
: NotifyGrab 1 ;
|
||||
: NotifyUngrab 2 ;
|
||||
: NotifyWhileGrabbed 3 ;
|
||||
CONSTANT: NotifyNormal 0
|
||||
CONSTANT: NotifyGrab 1
|
||||
CONSTANT: NotifyUngrab 2
|
||||
CONSTANT: NotifyWhileGrabbed 3
|
||||
|
||||
: NotifyHint 1 ; ! for MotionNotify events
|
||||
CONSTANT: NotifyHint 1 ! for MotionNotify events
|
||||
|
||||
! Notify detail
|
||||
|
||||
: NotifyAncestor 0 ;
|
||||
: NotifyVirtual 1 ;
|
||||
: NotifyInferior 2 ;
|
||||
: NotifyNonlinear 3 ;
|
||||
: NotifyNonlinearVirtual 4 ;
|
||||
: NotifyPointer 5 ;
|
||||
: NotifyPointerRoot 6 ;
|
||||
: NotifyDetailNone 7 ;
|
||||
CONSTANT: NotifyAncestor 0
|
||||
CONSTANT: NotifyVirtual 1
|
||||
CONSTANT: NotifyInferior 2
|
||||
CONSTANT: NotifyNonlinear 3
|
||||
CONSTANT: NotifyNonlinearVirtual 4
|
||||
CONSTANT: NotifyPointer 5
|
||||
CONSTANT: NotifyPointerRoot 6
|
||||
CONSTANT: NotifyDetailNone 7
|
||||
|
||||
! Visibility notify
|
||||
|
||||
: VisibilityUnobscured 0 ;
|
||||
: VisibilityPartiallyObscured 1 ;
|
||||
: VisibilityFullyObscured 2 ;
|
||||
CONSTANT: VisibilityUnobscured 0
|
||||
CONSTANT: VisibilityPartiallyObscured 1
|
||||
CONSTANT: VisibilityFullyObscured 2
|
||||
|
||||
! Circulation request
|
||||
|
||||
: PlaceOnTop 0 ;
|
||||
: PlaceOnBottom 1 ;
|
||||
CONSTANT: PlaceOnTop 0
|
||||
CONSTANT: PlaceOnBottom 1
|
||||
|
||||
! protocol families
|
||||
|
||||
: FamilyInternet 0 ; ! IPv4
|
||||
: FamilyDECnet 1 ;
|
||||
: FamilyChaos 2 ;
|
||||
: FamilyInternet6 6 ; ! IPv6
|
||||
CONSTANT: FamilyInternet 0 ! IPv4
|
||||
CONSTANT: FamilyDECnet 1
|
||||
CONSTANT: FamilyChaos 2
|
||||
CONSTANT: FamilyInternet6 6 ! IPv6
|
||||
|
||||
! authentication families not tied to a specific protocol
|
||||
: FamilyServerInterpreted 5 ;
|
||||
CONSTANT: FamilyServerInterpreted 5
|
||||
|
||||
! Property notification
|
||||
|
||||
: PropertyNewValue 0 ;
|
||||
: PropertyDelete 1 ;
|
||||
CONSTANT: PropertyNewValue 0
|
||||
CONSTANT: PropertyDelete 1
|
||||
|
||||
! Color Map notification
|
||||
|
||||
: ColormapUninstalled 0 ;
|
||||
: ColormapInstalled 1 ;
|
||||
CONSTANT: ColormapUninstalled 0
|
||||
CONSTANT: ColormapInstalled 1
|
||||
|
||||
! GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes
|
||||
|
||||
: GrabModeSync 0 ;
|
||||
: GrabModeAsync 1 ;
|
||||
CONSTANT: GrabModeSync 0
|
||||
CONSTANT: GrabModeAsync 1
|
||||
|
||||
! GrabPointer, GrabKeyboard reply status
|
||||
|
||||
: GrabSuccess 0 ;
|
||||
: AlreadyGrabbed 1 ;
|
||||
: GrabInvalidTime 2 ;
|
||||
: GrabNotViewable 3 ;
|
||||
: GrabFrozen 4 ;
|
||||
CONSTANT: GrabSuccess 0
|
||||
CONSTANT: AlreadyGrabbed 1
|
||||
CONSTANT: GrabInvalidTime 2
|
||||
CONSTANT: GrabNotViewable 3
|
||||
CONSTANT: GrabFrozen 4
|
||||
|
||||
! AllowEvents modes
|
||||
|
||||
: AsyncPointer 0 ;
|
||||
: SyncPointer 1 ;
|
||||
: ReplayPointer 2 ;
|
||||
: AsyncKeyboard 3 ;
|
||||
: SyncKeyboard 4 ;
|
||||
: ReplayKeyboard 5 ;
|
||||
: AsyncBoth 6 ;
|
||||
: SyncBoth 7 ;
|
||||
CONSTANT: AsyncPointer 0
|
||||
CONSTANT: SyncPointer 1
|
||||
CONSTANT: ReplayPointer 2
|
||||
CONSTANT: AsyncKeyboard 3
|
||||
CONSTANT: SyncKeyboard 4
|
||||
CONSTANT: ReplayKeyboard 5
|
||||
CONSTANT: AsyncBoth 6
|
||||
CONSTANT: SyncBoth 7
|
||||
|
||||
! Used in SetInputFocus, GetInputFocus
|
||||
|
||||
: RevertToNone ( -- n ) None ;
|
||||
: RevertToPointerRoot ( -- n ) PointerRoot ;
|
||||
: RevertToParent 2 ;
|
||||
CONSTANT: RevertToParent 2
|
||||
|
||||
! *****************************************************************
|
||||
! * ERROR CODES
|
||||
! *****************************************************************
|
||||
|
||||
: Success 0 ; ! everything's okay
|
||||
: BadRequest 1 ; ! bad request code
|
||||
: BadValue 2 ; ! int parameter out of range
|
||||
: BadWindow 3 ; ! parameter not a Window
|
||||
: BadPixmap 4 ; ! parameter not a Pixmap
|
||||
: BadAtom 5 ; ! parameter not an Atom
|
||||
: BadCursor 6 ; ! parameter not a Cursor
|
||||
: BadFont 7 ; ! parameter not a Font
|
||||
: BadMatch 8 ; ! parameter mismatch
|
||||
: BadDrawable 9 ; ! parameter not a Pixmap or Window
|
||||
: BadAccess 10 ; ! depending on context:
|
||||
CONSTANT: Success 0 ! everything's okay
|
||||
CONSTANT: BadRequest 1 ! bad request code
|
||||
CONSTANT: BadValue 2 ! int parameter out of range
|
||||
CONSTANT: BadWindow 3 ! parameter not a Window
|
||||
CONSTANT: BadPixmap 4 ! parameter not a Pixmap
|
||||
CONSTANT: BadAtom 5 ! parameter not an Atom
|
||||
CONSTANT: BadCursor 6 ! parameter not a Cursor
|
||||
CONSTANT: BadFont 7 ! parameter not a Font
|
||||
CONSTANT: BadMatch 8 ! parameter mismatch
|
||||
CONSTANT: BadDrawable 9 ! parameter not a Pixmap or Window
|
||||
CONSTANT: BadAccess 10 ! depending on context:
|
||||
! - key/button already grabbed
|
||||
! - attempt to free an illegal
|
||||
! cmap entry
|
||||
|
|
@ -154,16 +154,16 @@ TYPEDEF: uchar KeyCode
|
|||
! color map entry.
|
||||
! - attempt to modify the access control
|
||||
! list from other than the local host.
|
||||
: BadAlloc 11 ; ! insufficient resources
|
||||
: BadColor 12 ; ! no such colormap
|
||||
: BadGC 13 ; ! parameter not a GC
|
||||
: BadIDChoice 14 ; ! choice not in range or already used
|
||||
: BadName 15 ; ! font or color name doesn't exist
|
||||
: BadLength 16 ; ! Request length incorrect
|
||||
: BadImplementation 17 ; ! server is defective
|
||||
CONSTANT: BadAlloc 11 ! insufficient resources
|
||||
CONSTANT: BadColor 12 ! no such colormap
|
||||
CONSTANT: BadGC 13 ! parameter not a GC
|
||||
CONSTANT: BadIDChoice 14 ! choice not in range or already used
|
||||
CONSTANT: BadName 15 ! font or color name doesn't exist
|
||||
CONSTANT: BadLength 16 ! Request length incorrect
|
||||
CONSTANT: BadImplementation 17 ! server is defective
|
||||
|
||||
: FirstExtensionError 128 ;
|
||||
: LastExtensionError 255 ;
|
||||
CONSTANT: FirstExtensionError 128
|
||||
CONSTANT: LastExtensionError 255
|
||||
|
||||
! *****************************************************************
|
||||
! * WINDOW DEFINITIONS
|
||||
|
|
@ -172,44 +172,44 @@ TYPEDEF: uchar KeyCode
|
|||
! Window classes used by CreateWindow
|
||||
! Note that CopyFromParent is already defined as 0 above
|
||||
|
||||
: InputOutput 1 ;
|
||||
: InputOnly 2 ;
|
||||
CONSTANT: InputOutput 1
|
||||
CONSTANT: InputOnly 2
|
||||
|
||||
! Used in CreateWindow for backing-store hint
|
||||
|
||||
: NotUseful 0 ;
|
||||
: WhenMapped 1 ;
|
||||
: Always 2 ;
|
||||
CONSTANT: NotUseful 0
|
||||
CONSTANT: WhenMapped 1
|
||||
CONSTANT: Always 2
|
||||
|
||||
! Used in ChangeSaveSet
|
||||
|
||||
: SetModeInsert 0 ;
|
||||
: SetModeDelete 1 ;
|
||||
CONSTANT: SetModeInsert 0
|
||||
CONSTANT: SetModeDelete 1
|
||||
|
||||
! Used in ChangeCloseDownMode
|
||||
|
||||
: DestroyAll 0 ;
|
||||
: RetainPermanent 1 ;
|
||||
: RetainTemporary 2 ;
|
||||
CONSTANT: DestroyAll 0
|
||||
CONSTANT: RetainPermanent 1
|
||||
CONSTANT: RetainTemporary 2
|
||||
|
||||
! Window stacking method (in configureWindow)
|
||||
|
||||
: Above 0 ;
|
||||
: Below 1 ;
|
||||
: TopIf 2 ;
|
||||
: BottomIf 3 ;
|
||||
: Opposite 4 ;
|
||||
CONSTANT: Above 0
|
||||
CONSTANT: Below 1
|
||||
CONSTANT: TopIf 2
|
||||
CONSTANT: BottomIf 3
|
||||
CONSTANT: Opposite 4
|
||||
|
||||
! Circulation direction
|
||||
|
||||
: RaiseLowest 0 ;
|
||||
: LowerHighest 1 ;
|
||||
CONSTANT: RaiseLowest 0
|
||||
CONSTANT: LowerHighest 1
|
||||
|
||||
! Property modes
|
||||
|
||||
: PropModeReplace 0 ;
|
||||
: PropModePrepend 1 ;
|
||||
: PropModeAppend 2 ;
|
||||
CONSTANT: PropModeReplace 0
|
||||
CONSTANT: PropModePrepend 1
|
||||
CONSTANT: PropModeAppend 2
|
||||
|
||||
! *****************************************************************
|
||||
! * GRAPHICS DEFINITIONS
|
||||
|
|
@ -217,62 +217,62 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! LineStyle
|
||||
|
||||
: LineSolid 0 ;
|
||||
: LineOnOffDash 1 ;
|
||||
: LineDoubleDash 2 ;
|
||||
CONSTANT: LineSolid 0
|
||||
CONSTANT: LineOnOffDash 1
|
||||
CONSTANT: LineDoubleDash 2
|
||||
|
||||
! capStyle
|
||||
|
||||
: CapNotLast 0 ;
|
||||
: CapButt 1 ;
|
||||
: CapRound 2 ;
|
||||
: CapProjecting 3 ;
|
||||
CONSTANT: CapNotLast 0
|
||||
CONSTANT: CapButt 1
|
||||
CONSTANT: CapRound 2
|
||||
CONSTANT: CapProjecting 3
|
||||
|
||||
! joinStyle
|
||||
|
||||
: JoinMiter 0 ;
|
||||
: JoinRound 1 ;
|
||||
: JoinBevel 2 ;
|
||||
CONSTANT: JoinMiter 0
|
||||
CONSTANT: JoinRound 1
|
||||
CONSTANT: JoinBevel 2
|
||||
|
||||
! fillStyle
|
||||
|
||||
: FillSolid 0 ;
|
||||
: FillTiled 1 ;
|
||||
: FillStippled 2 ;
|
||||
: FillOpaqueStippled 3 ;
|
||||
CONSTANT: FillSolid 0
|
||||
CONSTANT: FillTiled 1
|
||||
CONSTANT: FillStippled 2
|
||||
CONSTANT: FillOpaqueStippled 3
|
||||
|
||||
! fillRule
|
||||
|
||||
: EvenOddRule 0 ;
|
||||
: WindingRule 1 ;
|
||||
CONSTANT: EvenOddRule 0
|
||||
CONSTANT: WindingRule 1
|
||||
|
||||
! subwindow mode
|
||||
|
||||
: ClipByChildren 0 ;
|
||||
: IncludeInferiors 1 ;
|
||||
CONSTANT: ClipByChildren 0
|
||||
CONSTANT: IncludeInferiors 1
|
||||
|
||||
! SetClipRectangles ordering
|
||||
|
||||
: Unsorted 0 ;
|
||||
: YSorted 1 ;
|
||||
: YXSorted 2 ;
|
||||
: YXBanded 3 ;
|
||||
CONSTANT: Unsorted 0
|
||||
CONSTANT: YSorted 1
|
||||
CONSTANT: YXSorted 2
|
||||
CONSTANT: YXBanded 3
|
||||
|
||||
! CoordinateMode for drawing routines
|
||||
|
||||
: CoordModeOrigin 0 ; ! relative to the origin
|
||||
: CoordModePrevious 1 ; ! relative to previous point
|
||||
CONSTANT: CoordModeOrigin 0 ! relative to the origin
|
||||
CONSTANT: CoordModePrevious 1 ! relative to previous point
|
||||
|
||||
! Polygon shapes
|
||||
|
||||
: Complex 0 ; ! paths may intersect
|
||||
: Nonconvex 1 ; ! no paths intersect, but not convex
|
||||
: Convex 2 ; ! wholly convex
|
||||
CONSTANT: Complex 0 ! paths may intersect
|
||||
CONSTANT: Nonconvex 1 ! no paths intersect, but not convex
|
||||
CONSTANT: Convex 2 ! wholly convex
|
||||
|
||||
! Arc modes for PolyFillArc
|
||||
|
||||
: ArcChord 0 ; ! join endpoints of arc
|
||||
: ArcPieSlice 1 ; ! join endpoints to center of arc
|
||||
CONSTANT: ArcChord 0 ! join endpoints of arc
|
||||
CONSTANT: ArcPieSlice 1 ! join endpoints to center of arc
|
||||
|
||||
! *****************************************************************
|
||||
! * FONTS
|
||||
|
|
@ -280,10 +280,10 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! used in QueryFont -- draw direction
|
||||
|
||||
: FontLeftToRight 0 ;
|
||||
: FontRightToLeft 1 ;
|
||||
CONSTANT: FontLeftToRight 0
|
||||
CONSTANT: FontRightToLeft 1
|
||||
|
||||
: FontChange 255 ;
|
||||
CONSTANT: FontChange 255
|
||||
|
||||
! *****************************************************************
|
||||
! * IMAGING
|
||||
|
|
@ -291,9 +291,9 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! ImageFormat -- PutImage, GetImage
|
||||
|
||||
: XYBitmap 0 ; ! depth 1, XYFormat
|
||||
: XYPixmap 1 ; ! depth == drawable depth
|
||||
: ZPixmap 2 ; ! depth == drawable depth
|
||||
CONSTANT: XYBitmap 0 ! depth 1, XYFormat
|
||||
CONSTANT: XYPixmap 1 ! depth == drawable depth
|
||||
CONSTANT: ZPixmap 2 ! depth == drawable depth
|
||||
|
||||
! *****************************************************************
|
||||
! * COLOR MAP STUFF
|
||||
|
|
@ -301,8 +301,8 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! For CreateColormap
|
||||
|
||||
: AllocNone 0 ; ! create map with no entries
|
||||
: AllocAll 1 ; ! allocate entire map writeable
|
||||
CONSTANT: AllocNone 0 ! create map with no entries
|
||||
CONSTANT: AllocAll 1 ! allocate entire map writeable
|
||||
|
||||
|
||||
! Flags used in StoreNamedColor, StoreColors
|
||||
|
|
@ -317,20 +317,20 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! QueryBestSize Class
|
||||
|
||||
: CursorShape 0 ; ! largest size that can be displayed
|
||||
: TileShape 1 ; ! size tiled fastest
|
||||
: StippleShape 2 ; ! size stippled fastest
|
||||
CONSTANT: CursorShape 0 ! largest size that can be displayed
|
||||
CONSTANT: TileShape 1 ! size tiled fastest
|
||||
CONSTANT: StippleShape 2 ! size stippled fastest
|
||||
|
||||
! *****************************************************************
|
||||
! * KEYBOARD/POINTER STUFF
|
||||
! *****************************************************************
|
||||
|
||||
: AutoRepeatModeOff 0 ;
|
||||
: AutoRepeatModeOn 1 ;
|
||||
: AutoRepeatModeDefault 2 ;
|
||||
CONSTANT: AutoRepeatModeOff 0
|
||||
CONSTANT: AutoRepeatModeOn 1
|
||||
CONSTANT: AutoRepeatModeDefault 2
|
||||
|
||||
: LedModeOff 0 ;
|
||||
: LedModeOn 1 ;
|
||||
CONSTANT: LedModeOff 0
|
||||
CONSTANT: LedModeOn 1
|
||||
|
||||
! masks for ChangeKeyboardControl
|
||||
|
||||
|
|
@ -343,33 +343,33 @@ TYPEDEF: uchar KeyCode
|
|||
: KBKey ( -- n ) 6 2^ ;
|
||||
: KBAutoRepeatMode ( -- n ) 7 2^ ;
|
||||
|
||||
: MappingSuccess 0 ;
|
||||
: MappingBusy 1 ;
|
||||
: MappingFailed 2 ;
|
||||
CONSTANT: MappingSuccess 0
|
||||
CONSTANT: MappingBusy 1
|
||||
CONSTANT: MappingFailed 2
|
||||
|
||||
: MappingModifier 0 ;
|
||||
: MappingKeyboard 1 ;
|
||||
: MappingPointer 2 ;
|
||||
CONSTANT: MappingModifier 0
|
||||
CONSTANT: MappingKeyboard 1
|
||||
CONSTANT: MappingPointer 2
|
||||
|
||||
! *****************************************************************
|
||||
! * SCREEN SAVER STUFF
|
||||
! *****************************************************************
|
||||
|
||||
: DontPreferBlanking 0 ;
|
||||
: PreferBlanking 1 ;
|
||||
: DefaultBlanking 2 ;
|
||||
CONSTANT: DontPreferBlanking 0
|
||||
CONSTANT: PreferBlanking 1
|
||||
CONSTANT: DefaultBlanking 2
|
||||
|
||||
: DisableScreenSaver 0 ;
|
||||
: DisableScreenInterval 0 ;
|
||||
CONSTANT: DisableScreenSaver 0
|
||||
CONSTANT: DisableScreenInterval 0
|
||||
|
||||
: DontAllowExposures 0 ;
|
||||
: AllowExposures 1 ;
|
||||
: DefaultExposures 2 ;
|
||||
CONSTANT: DontAllowExposures 0
|
||||
CONSTANT: AllowExposures 1
|
||||
CONSTANT: DefaultExposures 2
|
||||
|
||||
! for ForceScreenSaver
|
||||
|
||||
: ScreenSaverReset 0 ;
|
||||
: ScreenSaverActive 1 ;
|
||||
CONSTANT: ScreenSaverReset 0
|
||||
CONSTANT: ScreenSaverActive 1
|
||||
|
||||
! *****************************************************************
|
||||
! * HOSTS AND CONNECTIONS
|
||||
|
|
@ -377,30 +377,30 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! for ChangeHosts
|
||||
|
||||
: HostInsert 0 ;
|
||||
: HostDelete 1 ;
|
||||
CONSTANT: HostInsert 0
|
||||
CONSTANT: HostDelete 1
|
||||
|
||||
! for ChangeAccessControl
|
||||
|
||||
: EnableAccess 1 ;
|
||||
: DisableAccess 0 ;
|
||||
CONSTANT: EnableAccess 1
|
||||
CONSTANT: DisableAccess 0
|
||||
|
||||
! Display classes used in opening the connection
|
||||
! Note that the statically allocated ones are even numbered and the
|
||||
! dynamically changeable ones are odd numbered
|
||||
|
||||
: StaticGray 0 ;
|
||||
: GrayScale 1 ;
|
||||
: StaticColor 2 ;
|
||||
: PseudoColor 3 ;
|
||||
: TrueColor 4 ;
|
||||
: DirectColor 5 ;
|
||||
CONSTANT: StaticGray 0
|
||||
CONSTANT: GrayScale 1
|
||||
CONSTANT: StaticColor 2
|
||||
CONSTANT: PseudoColor 3
|
||||
CONSTANT: TrueColor 4
|
||||
CONSTANT: DirectColor 5
|
||||
|
||||
|
||||
! Byte order used in imageByteOrder and bitmapBitOrder
|
||||
|
||||
: LSBFirst 0 ;
|
||||
: MSBFirst 1 ;
|
||||
CONSTANT: LSBFirst 0
|
||||
CONSTANT: MSBFirst 1
|
||||
|
||||
! *****************************************************************
|
||||
! * EXTENDED WINDOW MANAGER HINTS
|
||||
|
|
|
|||
|
|
@ -9,23 +9,23 @@ IN: x11.glx
|
|||
LIBRARY: glx
|
||||
|
||||
! Visual Config Attributes (glXGetConfig, glXGetFBConfigAttrib)
|
||||
: GLX_USE_GL 1 ; ! support GLX rendering
|
||||
: GLX_BUFFER_SIZE 2 ; ! depth of the color buffer
|
||||
: GLX_LEVEL 3 ; ! level in plane stacking
|
||||
: GLX_RGBA 4 ; ! true if RGBA mode
|
||||
: GLX_DOUBLEBUFFER 5 ; ! double buffering supported
|
||||
: GLX_STEREO 6 ; ! stereo buffering supported
|
||||
: GLX_AUX_BUFFERS 7 ; ! number of aux buffers
|
||||
: GLX_RED_SIZE 8 ; ! number of red component bits
|
||||
: GLX_GREEN_SIZE 9 ; ! number of green component bits
|
||||
: GLX_BLUE_SIZE 10 ; ! number of blue component bits
|
||||
: GLX_ALPHA_SIZE 11 ; ! number of alpha component bits
|
||||
: GLX_DEPTH_SIZE 12 ; ! number of depth bits
|
||||
: GLX_STENCIL_SIZE 13 ; ! number of stencil bits
|
||||
: GLX_ACCUM_RED_SIZE 14 ; ! number of red accum bits
|
||||
: GLX_ACCUM_GREEN_SIZE 15 ; ! number of green accum bits
|
||||
: GLX_ACCUM_BLUE_SIZE 16 ; ! number of blue accum bits
|
||||
: GLX_ACCUM_ALPHA_SIZE 17 ; ! number of alpha accum bits
|
||||
CONSTANT: GLX_USE_GL 1 ! support GLX rendering
|
||||
CONSTANT: GLX_BUFFER_SIZE 2 ! depth of the color buffer
|
||||
CONSTANT: GLX_LEVEL 3 ! level in plane stacking
|
||||
CONSTANT: GLX_RGBA 4 ! true if RGBA mode
|
||||
CONSTANT: GLX_DOUBLEBUFFER 5 ! double buffering supported
|
||||
CONSTANT: GLX_STEREO 6 ! stereo buffering supported
|
||||
CONSTANT: GLX_AUX_BUFFERS 7 ! number of aux buffers
|
||||
CONSTANT: GLX_RED_SIZE 8 ! number of red component bits
|
||||
CONSTANT: GLX_GREEN_SIZE 9 ! number of green component bits
|
||||
CONSTANT: GLX_BLUE_SIZE 10 ! number of blue component bits
|
||||
CONSTANT: GLX_ALPHA_SIZE 11 ! number of alpha component bits
|
||||
CONSTANT: GLX_DEPTH_SIZE 12 ! number of depth bits
|
||||
CONSTANT: GLX_STENCIL_SIZE 13 ! number of stencil bits
|
||||
CONSTANT: GLX_ACCUM_RED_SIZE 14 ! number of red accum bits
|
||||
CONSTANT: GLX_ACCUM_GREEN_SIZE 15 ! number of green accum bits
|
||||
CONSTANT: GLX_ACCUM_BLUE_SIZE 16 ! number of blue accum bits
|
||||
CONSTANT: GLX_ACCUM_ALPHA_SIZE 17 ! number of alpha accum bits
|
||||
|
||||
TYPEDEF: XID GLXContextID
|
||||
TYPEDEF: XID GLXPixmap
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ SYMBOL: xim
|
|||
XNResourceClass over 0 XCreateIC
|
||||
[ "XCreateIC() failed" throw ] unless* ;
|
||||
|
||||
: buf-size 100 ;
|
||||
CONSTANT: buf-size 100
|
||||
|
||||
SYMBOL: keybuf
|
||||
SYMBOL: keysym
|
||||
|
|
|
|||
|
|
@ -4,20 +4,20 @@ USING: namespaces make kernel assocs sequences fry values
|
|||
io.files io.encodings.binary xml.state ;
|
||||
IN: xml.entities
|
||||
|
||||
: entities-out
|
||||
CONSTANT: entities-out
|
||||
H{
|
||||
{ CHAR: < "<" }
|
||||
{ CHAR: > ">" }
|
||||
{ CHAR: & "&" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: quoted-entities-out
|
||||
CONSTANT: quoted-entities-out
|
||||
H{
|
||||
{ CHAR: & "&" }
|
||||
{ CHAR: ' "'" }
|
||||
{ CHAR: " """ }
|
||||
{ CHAR: < "<" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: escape-string-by ( str table -- escaped )
|
||||
#! Convert <, >, &, ' and " to HTML entities.
|
||||
|
|
@ -29,14 +29,14 @@ IN: xml.entities
|
|||
: escape-quoted-string ( str -- newstr )
|
||||
quoted-entities-out escape-string-by ;
|
||||
|
||||
: entities
|
||||
CONSTANT: entities
|
||||
H{
|
||||
{ "lt" CHAR: < }
|
||||
{ "gt" CHAR: > }
|
||||
{ "amp" CHAR: & }
|
||||
{ "apos" CHAR: ' }
|
||||
{ "quot" CHAR: " }
|
||||
} ;
|
||||
}
|
||||
|
||||
: with-entities ( entities quot -- )
|
||||
[ swap extra-entities set call ] with-scope ; inline
|
||||
|
|
|
|||
|
|
@ -290,7 +290,7 @@ M: quoteless-attr summary
|
|||
|
||||
TUPLE: attr-w/< < xml-error-at ;
|
||||
|
||||
: attr-w/< ( value -- * )
|
||||
: attr-w/< ( -- * )
|
||||
\ attr-w/< xml-error-at throw ;
|
||||
|
||||
M: attr-w/< summary
|
||||
|
|
@ -299,7 +299,7 @@ M: attr-w/< summary
|
|||
|
||||
TUPLE: text-w/]]> < xml-error-at ;
|
||||
|
||||
: text-w/]]> ( text -- * )
|
||||
: text-w/]]> ( -- * )
|
||||
\ text-w/]]> xml-error-at throw ;
|
||||
|
||||
M: text-w/]]> summary
|
||||
|
|
|
|||
|
|
@ -538,4 +538,4 @@ tuple
|
|||
[ [ first2 ] dip make-primitive ] each-index
|
||||
|
||||
! Bump build number
|
||||
"build" "kernel" create build 1+ 1quotation define
|
||||
"build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared
|
||||
|
|
|
|||
|
|
@ -67,7 +67,3 @@ HELP: modify-code-heap ( alist -- )
|
|||
HELP: compile
|
||||
{ $values { "words" "a sequence of words" } }
|
||||
{ $description "Compiles a set of words." } ;
|
||||
|
||||
HELP: compile-call
|
||||
{ $values { "quot" "a quotation" } }
|
||||
{ $description "Compiles and runs a quotation." } ;
|
||||
|
|
|
|||
|
|
@ -172,9 +172,6 @@ SYMBOL: remake-generics-hook
|
|||
] [ ] cleanup
|
||||
] with-scope ; inline
|
||||
|
||||
: compile-call ( quot -- )
|
||||
[ define-temp ] with-compilation-unit execute ;
|
||||
|
||||
: default-recompile-hook ( words -- alist )
|
||||
[ f ] { } map>assoc ;
|
||||
|
||||
|
|
|
|||
|
|
@ -92,10 +92,10 @@ C: <continuation> continuation
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: continue-with ( obj continuation -- )
|
||||
: continue-with ( obj continuation -- * )
|
||||
[ (continue-with) ] 2 (throw) ;
|
||||
|
||||
: continue ( continuation -- )
|
||||
: continue ( continuation -- * )
|
||||
f swap continue-with ;
|
||||
|
||||
SYMBOL: return-continuation
|
||||
|
|
@ -103,7 +103,7 @@ SYMBOL: return-continuation
|
|||
: with-return ( quot -- )
|
||||
[ [ return-continuation set ] prepose callcc0 ] with-scope ; inline
|
||||
|
||||
: return ( -- )
|
||||
: return ( -- * )
|
||||
return-continuation get continue ;
|
||||
|
||||
: with-datastack ( stack quot -- newstack )
|
||||
|
|
@ -173,7 +173,7 @@ TUPLE: restart name obj continuation ;
|
|||
|
||||
C: <restart> restart
|
||||
|
||||
: restart ( restart -- )
|
||||
: restart ( restart -- * )
|
||||
[ obj>> ] [ continuation>> ] bi continue-with ;
|
||||
|
||||
M: object compute-restarts drop { } ;
|
||||
|
|
|
|||
|
|
@ -44,9 +44,9 @@ M: effect effect>string ( effect -- string )
|
|||
|
||||
GENERIC: stack-effect ( word -- effect/f )
|
||||
|
||||
M: word stack-effect
|
||||
{ "declared-effect" "inferred-effect" }
|
||||
swap props>> [ at ] curry map [ ] find nip ;
|
||||
M: word stack-effect "declared-effect" word-prop ;
|
||||
|
||||
M: deferred stack-effect call-next-method (( -- * )) or ;
|
||||
|
||||
M: effect clone
|
||||
[ in>> clone ] [ out>> clone ] bi <effect> ;
|
||||
|
|
|
|||
|
|
@ -50,16 +50,16 @@ ERROR: no-method object generic ;
|
|||
convert-hi-tag-methods
|
||||
<lo-tag-dispatch-engine> ;
|
||||
|
||||
: mangle-method ( method -- quot )
|
||||
1quotation generic get extra-values \ drop <repetition>
|
||||
prepend [ ] like ;
|
||||
|
||||
: find-default ( methods -- quot )
|
||||
#! Side-effects methods.
|
||||
object bootstrap-word swap delete-at* [
|
||||
drop generic get "default-method" word-prop 1quotation
|
||||
drop generic get "default-method" word-prop mangle-method
|
||||
] unless ;
|
||||
|
||||
: mangle-method ( method generic -- quot )
|
||||
[ 1quotation ] [ extra-values \ drop <repetition> ] bi*
|
||||
prepend [ ] like ;
|
||||
|
||||
: <standard-engine> ( word -- engine )
|
||||
object bootstrap-word assumed set {
|
||||
[ generic set ]
|
||||
|
|
@ -67,7 +67,7 @@ ERROR: no-method object generic ;
|
|||
[ V{ } clone "engines" set-word-prop ]
|
||||
[
|
||||
"methods" word-prop
|
||||
[ generic get mangle-method ] assoc-map
|
||||
[ mangle-method ] assoc-map
|
||||
[ find-default default set ]
|
||||
[ <big-dispatch-engine> ]
|
||||
bi
|
||||
|
|
|
|||
|
|
@ -288,12 +288,12 @@ HELP: define-declared
|
|||
{ $side-effects "word" } ;
|
||||
|
||||
HELP: define-temp
|
||||
{ $values { "quot" quotation } { "word" word } }
|
||||
{ $values { "quot" quotation } { "effect" effect } { "word" word } }
|
||||
{ $description "Creates an uninterned word that will call " { $snippet "quot" } " when executed." }
|
||||
{ $notes
|
||||
"The following phrases are equivalent:"
|
||||
{ $code "[ 2 2 + . ] call" }
|
||||
{ $code "[ 2 2 + . ] define-temp execute" }
|
||||
{ $code "[ 2 2 + . ] (( -- )) define-temp execute" }
|
||||
"This word must be called from inside " { $link with-compilation-unit } "."
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -212,8 +212,8 @@ M: word subwords drop f ;
|
|||
: gensym ( -- word )
|
||||
"( gensym )" f <word> ;
|
||||
|
||||
: define-temp ( quot -- word )
|
||||
[ gensym dup ] dip define ;
|
||||
: define-temp ( quot effect -- word )
|
||||
[ gensym dup ] 2dip define-declared ;
|
||||
|
||||
: reveal ( word -- )
|
||||
dup [ name>> ] [ vocabulary>> ] bi dup vocab-words
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ arrays words quotations accessors math.parser backtrack assocs ;
|
|||
|
||||
IN: 24-game
|
||||
SYMBOL: commands
|
||||
: nop ;
|
||||
: nop ( -- ) ;
|
||||
: do-something ( a b -- c ) { + - * } amb-execute ;
|
||||
: maybe-swap ( a b -- a b ) { nop swap } amb-execute ;
|
||||
: some-rots ( a b c -- a b c )
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: benchmark.backtrack
|
|||
! placing them on the stack, and applying the operations
|
||||
! +, -, * and rot as many times as we wish.
|
||||
|
||||
: nop ;
|
||||
: nop ( -- ) ;
|
||||
|
||||
: do-something ( a b -- c )
|
||||
{ + - * } amb-execute ;
|
||||
|
|
@ -42,7 +42,7 @@ MEMO: 24-from-4 ( a b c d -- ? )
|
|||
] sigma
|
||||
] sigma ;
|
||||
|
||||
: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
|
||||
CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 }
|
||||
|
||||
: backtrack-benchmark ( -- )
|
||||
words [ reset-memoized ] each
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ CONSTANT: IC 29573
|
|||
CONSTANT: initial-seed 42
|
||||
CONSTANT: line-length 60
|
||||
|
||||
USE: math.private
|
||||
|
||||
: random ( seed -- n seed )
|
||||
>float IA * IC + IM mod [ IM /f ] keep ; inline
|
||||
|
||||
|
|
@ -19,7 +17,7 @@ HINTS: random fixnum ;
|
|||
|
||||
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
|
||||
|
||||
: IUB
|
||||
CONSTANT: IUB
|
||||
{
|
||||
{ CHAR: a 0.27 }
|
||||
{ CHAR: c 0.12 }
|
||||
|
|
@ -37,15 +35,15 @@ CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC
|
|||
{ CHAR: V 0.02 }
|
||||
{ CHAR: W 0.02 }
|
||||
{ CHAR: Y 0.02 }
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: homo-sapiens
|
||||
CONSTANT: homo-sapiens
|
||||
{
|
||||
{ CHAR: a 0.3029549426680 }
|
||||
{ CHAR: c 0.1979883004921 }
|
||||
{ CHAR: g 0.1975473066391 }
|
||||
{ CHAR: t 0.3015094502008 }
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: make-cumulative ( freq -- chars floats )
|
||||
dup keys >byte-array
|
||||
|
|
|
|||
|
|
@ -8,13 +8,14 @@ hints ;
|
|||
IN: benchmark.raytracer
|
||||
|
||||
! parameters
|
||||
: light
|
||||
#! Normalized { -1 -3 2 }.
|
||||
|
||||
! Normalized { -1 -3 2 }.
|
||||
CONSTANT: light
|
||||
double-array{
|
||||
-0.2672612419124244
|
||||
-0.8017837257372732
|
||||
0.5345224838248488
|
||||
} ; inline
|
||||
}
|
||||
|
||||
CONSTANT: oversampling 4
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ SYMBOL: counter
|
|||
SYMBOL: port-promise
|
||||
SYMBOL: server
|
||||
|
||||
: number-of-requests 1000 ;
|
||||
CONSTANT: number-of-requests 1000
|
||||
|
||||
: server-addr ( -- addr )
|
||||
"127.0.0.1" port-promise get ?promise <inet4> ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
|
|||
compiler.cfg.optimizer fry ;
|
||||
IN: galois-talk
|
||||
|
||||
: galois-slides
|
||||
CONSTANT: galois-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -305,7 +305,7 @@ IN: galois-talk
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
: galois-talk ( -- ) galois-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -121,12 +121,12 @@ CONSTANT: hat-switch-matching-hash
|
|||
: hat-switch? ( {usage-page,usage} -- ? )
|
||||
{ 1 HEX: 39 } = ; inline
|
||||
|
||||
: pov-values
|
||||
CONSTANT: pov-values
|
||||
{
|
||||
pov-up pov-up-right pov-right pov-down-right
|
||||
pov-down pov-down-left pov-left pov-up-left
|
||||
pov-neutral
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: button-value ( value -- f/(0,1] )
|
||||
IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
|
|||
compiler.cfg.optimizer fry ;
|
||||
IN: google-tech-talk
|
||||
|
||||
: google-slides
|
||||
CONSTANT: google-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -562,7 +562,7 @@ IN: google-tech-talk
|
|||
"Put your prejudices aside and give it a shot!"
|
||||
}
|
||||
{ $slide "Questions?" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: google-talk ( -- ) google-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ IN: irc.client
|
|||
! Setup and running objects
|
||||
! ======================================
|
||||
|
||||
: irc-port 6667 ; ! Default irc port
|
||||
CONSTANT: irc-port 6667 ! Default irc port
|
||||
|
||||
TUPLE: irc-profile server port nickname password ;
|
||||
C: <irc-profile> irc-profile
|
||||
|
|
|
|||
|
|
@ -28,9 +28,9 @@ TUPLE: irc-tab < frame chat client window ;
|
|||
|
||||
: write-color ( str color -- )
|
||||
foreground associate format ;
|
||||
: dark-red T{ rgba f 0.5 0.0 0.0 1 } ;
|
||||
: dark-green T{ rgba f 0.0 0.5 0.0 1 } ;
|
||||
: dark-blue T{ rgba f 0.0 0.0 0.5 1 } ;
|
||||
CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 }
|
||||
CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 }
|
||||
CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 }
|
||||
|
||||
: dot-or-parens ( string -- string )
|
||||
[ "." ]
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ calendar locals strings ui.gadgets.buttons
|
|||
combinators math.parser assocs threads ;
|
||||
IN: joystick-demo
|
||||
|
||||
: SIZE { 151 151 } ;
|
||||
: INDICATOR-SIZE { 4 4 } ;
|
||||
CONSTANT: SIZE { 151 151 }
|
||||
CONSTANT: INDICATOR-SIZE { 4 4 }
|
||||
: FREQUENCY ( -- f ) 30 recip seconds ;
|
||||
|
||||
TUPLE: axis-gadget < gadget indicator z-indicator pov ;
|
||||
|
|
@ -21,7 +21,7 @@ M: axis-gadget pref-dim* drop SIZE ;
|
|||
: indicator-polygon ( -- polygon )
|
||||
{ 0 0 } INDICATOR-SIZE (rect-polygon) ;
|
||||
|
||||
: pov-polygons
|
||||
CONSTANT: pov-polygons
|
||||
V{
|
||||
{ pov-neutral { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } }
|
||||
{ pov-up { { 70 65 } { 75 60 } { 80 65 } } }
|
||||
|
|
@ -32,7 +32,7 @@ M: axis-gadget pref-dim* drop SIZE ;
|
|||
{ pov-down-left { { 67 90 } { 60 90 } { 60 83 } } }
|
||||
{ pov-left { { 65 70 } { 60 75 } { 65 80 } } }
|
||||
{ pov-up-left { { 67 60 } { 60 60 } { 60 67 } } }
|
||||
} ;
|
||||
}
|
||||
|
||||
: <indicator-gadget> ( color -- indicator )
|
||||
indicator-polygon <polygon-gadget> ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ words arrays assocs math calendar fry alarms ui
|
|||
ui.gadgets.borders ui.gestures ;
|
||||
IN: key-caps
|
||||
|
||||
: key-locations H{
|
||||
CONSTANT: key-locations H{
|
||||
{ key-escape { { 0 0 } { 10 10 } } }
|
||||
|
||||
{ key-f1 { { 20 0 } { 10 10 } } }
|
||||
|
|
@ -129,9 +129,9 @@ IN: key-caps
|
|||
|
||||
{ key-keypad-0 { { 190 55 } { 20 10 } } }
|
||||
{ key-keypad-. { { 210 55 } { 10 10 } } }
|
||||
} ;
|
||||
}
|
||||
|
||||
: KEYBOARD-SIZE { 230 65 } ;
|
||||
CONSTANT: KEYBOARD-SIZE { 230 65 }
|
||||
: FREQUENCY ( -- f ) 30 recip seconds ;
|
||||
|
||||
TUPLE: key-caps-gadget < gadget keys alarm ;
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ SYMBOL: def-hash-keys
|
|||
set-alien-float alien-float
|
||||
} ;
|
||||
|
||||
: trivial-defs
|
||||
: trivial-defs ( -- seq )
|
||||
{
|
||||
[ drop ] [ 2array ]
|
||||
[ bitand ]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: arrays kernel xml-rpc ;
|
||||
IN: lisppaste
|
||||
|
||||
: url "http://www.common-lisp.net:8185/RPC2" ;
|
||||
CONSTANT: url "http://www.common-lisp.net:8185/RPC2"
|
||||
|
||||
: channels ( -- seq )
|
||||
{ } "listchannels" url invoke-method ;
|
||||
|
|
|
|||
|
|
@ -67,24 +67,24 @@ SYMBOL: stamp
|
|||
: ?prepare-build-machine ( -- )
|
||||
builds/factor exists? [ prepare-build-machine ] unless ;
|
||||
|
||||
: load-everything-vocabs-file "load-everything-vocabs" ;
|
||||
: load-everything-errors-file "load-everything-errors" ;
|
||||
CONSTANT: load-everything-vocabs-file "load-everything-vocabs"
|
||||
CONSTANT: load-everything-errors-file "load-everything-errors"
|
||||
|
||||
: test-all-vocabs-file "test-all-vocabs" ;
|
||||
: test-all-errors-file "test-all-errors" ;
|
||||
CONSTANT: test-all-vocabs-file "test-all-vocabs"
|
||||
CONSTANT: test-all-errors-file "test-all-errors"
|
||||
|
||||
: help-lint-vocabs-file "help-lint-vocabs" ;
|
||||
: help-lint-errors-file "help-lint-errors" ;
|
||||
CONSTANT: help-lint-vocabs-file "help-lint-vocabs"
|
||||
CONSTANT: help-lint-errors-file "help-lint-errors"
|
||||
|
||||
: boot-time-file "boot-time" ;
|
||||
: load-time-file "load-time" ;
|
||||
: compiler-errors-file "compiler-errors" ;
|
||||
: test-time-file "test-time" ;
|
||||
: help-lint-time-file "help-lint-time" ;
|
||||
: benchmark-time-file "benchmark-time" ;
|
||||
: html-help-time-file "html-help-time" ;
|
||||
CONSTANT: boot-time-file "boot-time"
|
||||
CONSTANT: load-time-file "load-time"
|
||||
CONSTANT: compiler-errors-file "compiler-errors"
|
||||
CONSTANT: test-time-file "test-time"
|
||||
CONSTANT: help-lint-time-file "help-lint-time"
|
||||
CONSTANT: benchmark-time-file "benchmark-time"
|
||||
CONSTANT: html-help-time-file "html-help-time"
|
||||
|
||||
: benchmarks-file "benchmarks" ;
|
||||
CONSTANT: benchmarks-file "benchmarks"
|
||||
|
||||
SYMBOL: status
|
||||
|
||||
|
|
|
|||
|
|
@ -11,11 +11,11 @@ IN: math.analysis
|
|||
|
||||
CONSTANT: gamma-g6 5.15
|
||||
|
||||
: gamma-p6
|
||||
CONSTANT: gamma-p6
|
||||
{
|
||||
2.50662827563479526904 225.525584619175212544 -268.295973841304927459
|
||||
80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: gamma-z ( x n -- seq )
|
||||
[ + recip ] with map 1.0 0 pick set-nth ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
|
|||
math.order math.geometry.rect ;
|
||||
IN: maze
|
||||
|
||||
: line-width 8 ;
|
||||
CONSTANT: line-width 8
|
||||
|
||||
SYMBOL: visited
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: slides help.markup math arrays hashtables namespaces
|
|||
sequences kernel sequences parser memoize ;
|
||||
IN: minneapolis-talk
|
||||
|
||||
: minneapolis-slides
|
||||
CONSTANT: minneapolis-slides
|
||||
{
|
||||
{ $slide "What is Factor?"
|
||||
"Dynamically typed, stack language"
|
||||
|
|
@ -175,7 +175,7 @@ IN: minneapolis-talk
|
|||
"Mailing list: factor-talk@lists.sf.net"
|
||||
}
|
||||
{ $slide "Questions?" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: minneapolis-talk ( -- ) minneapolis-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,116 +0,0 @@
|
|||
- how to create a small module
|
||||
- editor integration
|
||||
- presentations
|
||||
- module system
|
||||
- copy and paste factoring, inverse
|
||||
- help system
|
||||
- tetris
|
||||
- memoization
|
||||
- editing inspector demo
|
||||
- dynamic scope, lexical scope
|
||||
|
||||
Factor: contradictions?
|
||||
-----------------------
|
||||
|
||||
Have our cake and eat it too
|
||||
|
||||
Research -vs- practical
|
||||
High level -vs- fast
|
||||
Interactive -vs- deployment
|
||||
|
||||
Factor from 10,000 feet
|
||||
-----------------------
|
||||
|
||||
word: named function
|
||||
vocabulary: module
|
||||
quotation: anonymous function
|
||||
classes, objects, etc.
|
||||
|
||||
The stack
|
||||
---------
|
||||
|
||||
- Stack -vs- applicative
|
||||
- Pass by reference, dynamically typed
|
||||
- Stack languages: you can omit names where they're not needed
|
||||
- More compositional style
|
||||
- If you need to name things for clarity, you can:
|
||||
lexical vars, dynamic vars, sequences, assocs, objects...
|
||||
|
||||
Functional programming
|
||||
----------------------
|
||||
|
||||
Quotations
|
||||
Curry
|
||||
Continuations
|
||||
|
||||
Object-oriented programming
|
||||
---------------------------
|
||||
|
||||
Generic words: sort of like open classes
|
||||
Tuple reshaping
|
||||
Editing inspector
|
||||
|
||||
Meta programming
|
||||
----------------
|
||||
|
||||
Simple, orthogonal core
|
||||
|
||||
Why use a stack at all?
|
||||
-----------------------
|
||||
|
||||
Nice idioms: 10 days ago
|
||||
Copy and paste factoring
|
||||
Easy meta-programming
|
||||
Sequence operations correspond to functional operations:
|
||||
- curry is adding at the front
|
||||
- compose is append
|
||||
|
||||
UI
|
||||
--
|
||||
|
||||
Written in Factor
|
||||
renders with OpenGL
|
||||
Windows, X11, Cocoa backends
|
||||
You can call Windows, X11, Cocoa APIs directly
|
||||
OpenGL 2.1 shaders, OpenAL 3D audio...
|
||||
|
||||
Tools
|
||||
-----
|
||||
|
||||
Edit
|
||||
Usages
|
||||
Profiler
|
||||
Easy to make your own tools
|
||||
|
||||
Implementation
|
||||
--------------
|
||||
|
||||
Two compilers
|
||||
Generational garbage collector
|
||||
Non-blocking I/O
|
||||
|
||||
Hands on
|
||||
--------
|
||||
|
||||
Community
|
||||
---------
|
||||
|
||||
Factor started in 2003
|
||||
About a dozen contributors
|
||||
Handful of "core contributors"
|
||||
Web site: http://factorcode.org
|
||||
IRC: #concatenative on irc.freenode.net
|
||||
Mailing list: factor-talk@lists.sf.net
|
||||
|
||||
C library interface
|
||||
-------------------
|
||||
|
||||
Efficient
|
||||
No need to write C code
|
||||
Supports floats, structs, unions, ...
|
||||
Function pointers, callbacks
|
||||
Here is an example
|
||||
|
||||
TerminateProcess
|
||||
|
||||
process-handle TerminateProcess
|
||||
|
|
@ -4,8 +4,8 @@ IN: nehe.2
|
|||
|
||||
TUPLE: nehe2-gadget < gadget ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
|
||||
: <nehe2-gadget> ( -- gadget )
|
||||
nehe2-gadget new-gadget ;
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@ IN: nehe.3
|
|||
|
||||
TUPLE: nehe3-gadget < gadget ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
|
||||
: <nehe3-gadget> ( -- gadget )
|
||||
nehe3-gadget new-gadget ;
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ IN: nehe.4
|
|||
|
||||
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
: redraw-interval ( -- dt ) 10 milliseconds ;
|
||||
|
||||
: <nehe4-gadget> ( -- gadget )
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue