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

Fixing conflicts from stack checker changes

db4
Slava Pestov 2009-02-24 01:21:10 -06:00
parent 91d0c4ed1f e8361b9980
commit ce1bc1d6ed
111 changed files with 1040 additions and 1330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/alien/c-types/c-types.factor
View File

@ -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>

2
basis/bootstrap/image/download/download.factor
View File

@ -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

6
basis/cairo/ffi/ffi.factor
View File

@ -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 )

4
basis/checksums/openssl/openssl.factor
View File

@ -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

4
basis/cocoa/dialogs/dialogs.factor
View File

@ -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>

12
basis/cocoa/messages/messages.factor
View File

@ -1,11 +1,11 @@
! 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

2
basis/cocoa/pasteboard/pasteboard.factor
View File

@ -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? ;

18
basis/cocoa/runtime/runtime.factor
View File

@ -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 ) ;

6
basis/cocoa/subclassing/subclassing.factor
View File

@ -39,9 +39,9 @@ IN: cocoa.subclassing
swap prefix [ encode-type "0" append ] 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 )
[

4
basis/cocoa/views/views.factor
View File

@ -40,10 +40,6 @@ CONSTANT: NSOpenGLPFAScreenMask 84
CONSTANT: NSOpenGLPFAPixelBuffer 90
CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
CONSTANT: NSOpenGLPFAVirtualScreenCount 128
CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
CONSTANT: NSOpenGLCPSwapInterval 222
<PRIVATE

2
basis/compiler/cfg/debugger/debugger.factor
View File

@ -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?

9
basis/compiler/compiler-docs.factor
View File

@ -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." } ;

62
basis/compiler/compiler.factor
View File

@ -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

4
basis/compiler/tests/codegen.factor
View File

@ -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

8
basis/compiler/tests/curry.factor
View File

@ -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

2
basis/compiler/tests/float.factor
View File

@ -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

2
basis/compiler/tests/intrinsics.factor
View File

@ -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.

33
basis/compiler/tests/optimizer.factor
View File

@ -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

15
basis/compiler/tests/peg-regression-2.factor Normal file
View File

@ -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

6
basis/compiler/tests/simple.factor
View File

@ -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

2
basis/compiler/tests/tuples.factor
View File

@ -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 ;

2
basis/compiler/tree/builder/builder-tests.factor
View File

@ -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

8
basis/compiler/tree/builder/builder.factor
View File

@ -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 )
[
[
{

2
basis/compiler/tree/cleanup/cleanup-tests.factor
View File

@ -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

4
basis/compiler/tree/comparisons/comparisons.factor
View File

@ -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 )
{

2
basis/compiler/tree/debugger/debugger.factor
View File

@ -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

2
basis/compiler/tree/recursive/recursive-tests.factor
View File

@ -87,7 +87,7 @@ compiler.tree.combinators ;
] contains-node?
] unit-test
: blah f ;
: blah ( -- value ) f ;
DEFER: a

6
basis/core-graphics/core-graphics.factor
View File

@ -99,10 +99,12 @@ FUNCTION: void CGContextSetShouldSmoothFonts (
bool shouldSmoothFonts
) ;
FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
FUNCTION: void* CGBitmapContextGetData ( CGContextRef c ) ;
CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
<PRIVATE
: bitmap-flags ( -- flags )

4
basis/db/errors/postgresql/postgresql-tests.factor
View File

@ -5,7 +5,7 @@ db.errors.postgresql db.postgresql io.files.unique kernel namespaces
tools.test db.tester continuations ;
IN: db.errors.postgresql.tests
postgresql-test-db [
[
[ "drop table foo;" sql-command ] ignore-errors
[ "drop table ship;" sql-command ] ignore-errors
@ -29,4 +29,4 @@ postgresql-test-db [
sql-syntax-error?
] must-fail-with
] with-db
] test-postgresql

4
basis/editors/emacs/emacs.factor
View File

@ -1,6 +1,6 @@
USING: definitions io.launcher kernel parser words sequences math
math.parser namespaces editors make system combinators.short-circuit
fry threads ;
fry threads vocabs.loader ;
IN: editors.emacs
SYMBOL: emacsclient-path
@ -22,3 +22,5 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
where first2 emacsclient ;
[ emacsclient ] edit-hook set-global
os windows? [ "editors.emacs.windows" require ] when

2
basis/farkup/farkup.factor
View File

@ -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' )
{

4
basis/functors/functors.factor
View File

@ -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

2
basis/furnace/actions/actions.factor
View File

@ -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

2
basis/furnace/alloy/alloy.factor
View File

@ -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

2
basis/furnace/asides/asides.factor
View File

@ -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 ;

2
basis/furnace/auth/login/login.factor
View File

@ -64,7 +64,7 @@ SYMBOL: capabilities
PRIVATE>
: flashed-variables { description capabilities } ;
CONSTANT: flashed-variables { description capabilities }
: login-failed ( -- * )
"invalid username or password" validation-error

4
basis/furnace/auth/providers/null/null.factor
View File

@ -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 ;

2
basis/furnace/conversations/conversations.factor
View File

@ -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 ;

2
basis/furnace/sessions/sessions.factor
View File

@ -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?>> [

4
basis/furnace/utilities/utilities.factor
View File

@ -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 )

2
basis/html/templates/chloe/syntax/syntax.factor
View File

@ -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 = ;

2
basis/io/backend/unix/unix.factor
View File

@ -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 )

11
basis/io/encodings/8-bit/8-bit.factor
View File

@ -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 ;

2
basis/logging/server/server.factor
View File

@ -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 ;

4
basis/macros/macros.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: 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>

10
basis/math/quaternions/quaternions.factor
View File

@ -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

8
basis/memoize/memoize-tests.factor
View File

@ -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

67
basis/memoize/memoize.factor
View File

@ -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 ;

2
basis/none/none.factor
View File

@ -1,6 +1,6 @@
! Just a dummy shell for the -run switch...
IN: none
: none ;
: none ( -- ) ;
MAIN: none

294
basis/opengl/glu/glu.factor
View File

@ -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

2
basis/openssl/libcrypto/libcrypto.factor
View File

@ -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" }

4
basis/peg/parsers/parsers.factor
View File

@ -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 )

57
basis/stack-checker/backend/backend.factor
View File

@ -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 )
[

6
basis/stack-checker/known-words/known-words.factor
View File

@ -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

2
basis/threads/threads.factor
View File

@ -118,7 +118,7 @@ DEFER: stop
[ ] while
drop ;
: start ( namestack thread -- )
: start ( namestack thread -- * )
[
set-self
set-namestack

8
basis/tools/deploy/config/config.factor
View File

@ -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 < ;

4
basis/tools/deploy/shaker/shaker.factor
View File

@ -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

2
basis/tools/profiler/profiler-tests.factor
View File

@ -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
basis/ui/backend/windows/windows.factor
View File

@ -104,7 +104,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
[ lo-word ] keep hi-word 2array
swap window (>>window-loc) ;
: wm-keydown-codes ( -- key )
CONSTANT: wm-keydown-codes
H{
{ 8 "BACKSPACE" }
{ 9 "TAB" }
@ -132,7 +132,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
{ 121 "F10" }
{ 122 "F11" }
{ 123 "F12" }
} ;
}
: key-state-down? ( key -- ? )
GetKeyState 16 bit? ;
@ -155,22 +155,22 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
alt? [ A+ , ] when
] { } make [ empty? not ] keep f ? ;
: exclude-keys-wm-keydown
CONSTANT: exclude-keys-wm-keydown
H{
{ 16 "SHIFT" }
{ 17 "CTRL" }
{ 18 "ALT" }
{ 20 "CAPS-LOCK" }
} ;
}
: exclude-keys-wm-char
! Values are ignored
! Values are ignored
CONSTANT: exclude-keys-wm-char
H{
{ 8 "BACKSPACE" }
{ 9 "TAB" }
{ 13 "RET" }
{ 27 "ESC" }
} ;
}
: exclude-key-wm-keydown? ( n -- ? )
exclude-keys-wm-keydown key? ;

12
basis/ui/backend/x11/x11.factor
View File

@ -29,14 +29,14 @@ M: world configure-event
! In case dimensions didn't change
relayout-1 ;
: modifiers
CONSTANT: modifiers
{
{ S+ HEX: 1 }
{ C+ HEX: 4 }
{ A+ HEX: 8 }
} ;
: key-codes
}
CONSTANT: key-codes
H{
{ HEX: FF08 "BACKSPACE" }
{ HEX: FF09 "TAB" }
@ -62,7 +62,7 @@ M: world configure-event
{ HEX: FFC4 "F7" }
{ HEX: FFC5 "F8" }
{ HEX: FFC6 "F9" }
} ;
}
: key-code ( keysym -- keycode action? )
dup key-codes at [ t ] [ 1string f ] ?if ;
@ -91,7 +91,7 @@ M: world key-down-event
3bi ;
: key-up-event>gesture ( event -- gesture )
dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
[ event-modifiers ] [ 0 XLookupKeysym key-code ] bi <key-up> ;
M: world key-up-event
[ key-up-event>gesture ] dip propagate-key-gesture ;

3
basis/ui/gadgets/frames/frames.factor
View File

@ -22,9 +22,6 @@ M: glue pref-dim* drop { 0 0 } ;
: (fill- ( frame grid-layout quot1 quot2 -- pref-dim gap filled-cell dims )
[ '[ [ dim>> ] [ gap>> ] [ filled-cell>> ] tri _ tri@ ] dip ] dip call ; inline
: available-space ( pref-dim gap dims -- avail )
length 1+ * [-] ; inline
: -center) ( pref-dim gap filled-cell dims -- )
[ nip available-space ] 2keep [ remove-nth sum [-] ] 2keep set-nth ; inline

2
basis/ui/render/render.factor
View File

@ -112,4 +112,4 @@ M: gadget draw-children
CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 }
CONSTANT: focus-border-color COLOR: dark-gray
CONSTANT: focus-border-color COLOR: dark-gray

297
basis/ui/x11/x11.factor Executable file
View File

@ -0,0 +1,297 @@
! Copyright (C) 2005, 2008 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays ui ui.gadgets
ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
ui.event-loop assocs kernel math namespaces opengl sequences
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
x11.constants x11.windows io.encodings.string io.encodings.ascii
io.encodings.utf8 combinators command-line
math.vectors classes.tuple opengl.gl threads math.geometry.rect
environment ascii ;
IN: ui.x11
SINGLETON: x11-ui-backend
: XA_NET_WM_NAME ( -- atom ) "_NET_WM_NAME" x-atom ;
TUPLE: x11-handle-base glx ;
TUPLE: x11-handle < x11-handle-base xic window ;
TUPLE: x11-pixmap-handle < x11-handle-base pixmap glx-pixmap ;
C: <x11-handle> x11-handle
C: <x11-pixmap-handle> x11-pixmap-handle
M: world expose-event nip relayout ;
M: world configure-event
over configured-loc >>window-loc
swap configured-dim >>dim
! In case dimensions didn't change
relayout-1 ;
CONSTANT: modifiers
{
{ S+ HEX: 1 }
{ C+ HEX: 4 }
{ A+ HEX: 8 }
}
CONSTANT: key-codes
H{
{ HEX: FF08 "BACKSPACE" }
{ HEX: FF09 "TAB" }
{ HEX: FF0D "RET" }
{ HEX: FF8D "ENTER" }
{ HEX: FF1B "ESC" }
{ HEX: FFFF "DELETE" }
{ HEX: FF50 "HOME" }
{ HEX: FF51 "LEFT" }
{ HEX: FF52 "UP" }
{ HEX: FF53 "RIGHT" }
{ HEX: FF54 "DOWN" }
{ HEX: FF55 "PAGE_UP" }
{ HEX: FF56 "PAGE_DOWN" }
{ HEX: FF57 "END" }
{ HEX: FF58 "BEGIN" }
{ HEX: FFBE "F1" }
{ HEX: FFBF "F2" }
{ HEX: FFC0 "F3" }
{ HEX: FFC1 "F4" }
{ HEX: FFC2 "F5" }
{ HEX: FFC3 "F6" }
{ HEX: FFC4 "F7" }
{ HEX: FFC5 "F8" }
{ HEX: FFC6 "F9" }
}
: key-code ( keysym -- keycode action? )
dup key-codes at [ t ] [ 1string f ] ?if ;
: event-modifiers ( event -- seq )
XKeyEvent-state modifiers modifier ;
: valid-input? ( string gesture -- ? )
over empty? [ 2drop f ] [
mods>> { f { S+ } } member? [
[ [ 127 = not ] [ CHAR: \s >= ] bi and ] all?
] [
[ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all?
] if
] if ;
: key-down-event>gesture ( event world -- string gesture )
dupd
handle>> xic>> lookup-string
[ swap event-modifiers ] dip key-code <key-down> ;
M: world key-down-event
[ key-down-event>gesture ] keep
[ propagate-key-gesture drop ]
[ 2over valid-input? [ nip user-input ] [ 3drop ] if ]
3bi ;
: key-up-event>gesture ( event -- gesture )
dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
M: world key-up-event
[ key-up-event>gesture ] dip propagate-key-gesture ;
: mouse-event>gesture ( event -- modifiers button loc )
[ event-modifiers ]
[ XButtonEvent-button ]
[ mouse-event-loc ]
tri ;
M: world button-down-event
[ mouse-event>gesture [ <button-down> ] dip ] dip
send-button-down ;
M: world button-up-event
[ mouse-event>gesture [ <button-up> ] dip ] dip
send-button-up ;
: mouse-event>scroll-direction ( event -- pair )
XButtonEvent-button {
{ 4 { 0 -1 } }
{ 5 { 0 1 } }
{ 6 { -1 0 } }
{ 7 { 1 0 } }
} at ;
M: world wheel-event
[ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
send-wheel ;
M: world enter-event motion-event ;
M: world leave-event 2drop forget-rollover ;
M: world motion-event
[ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
move-hand fire-motion ;
M: world focus-in-event
nip
dup handle>> xic>> XSetICFocus focus-world ;
M: world focus-out-event
nip
dup handle>> xic>> XUnsetICFocus unfocus-world ;
M: world selection-notify-event
[ handle>> window>> selection-from-event ] keep
user-input ;
: supported-type? ( atom -- ? )
{ "UTF8_STRING" "STRING" "TEXT" }
[ x-atom = ] with any? ;
: clipboard-for-atom ( atom -- clipboard )
{
{ XA_PRIMARY [ selection get ] }
{ XA_CLIPBOARD [ clipboard get ] }
[ drop <clipboard> ]
} case ;
: encode-clipboard ( string type -- bytes )
XSelectionRequestEvent-target
XA_UTF8_STRING = utf8 ascii ? encode ;
: set-selection-prop ( evt -- )
dpy get swap
[ XSelectionRequestEvent-requestor ] keep
[ XSelectionRequestEvent-property ] keep
[ XSelectionRequestEvent-target ] keep
[ 8 PropModeReplace ] dip
[
XSelectionRequestEvent-selection
clipboard-for-atom contents>>
] keep encode-clipboard dup length XChangeProperty drop ;
M: world selection-request-event
drop dup XSelectionRequestEvent-target {
{ [ dup supported-type? ] [ drop dup set-selection-prop send-notify-success ] }
{ [ dup "TARGETS" x-atom = ] [ drop dup set-targets-prop send-notify-success ] }
{ [ dup "TIMESTAMP" x-atom = ] [ drop dup set-timestamp-prop send-notify-success ] }
[ drop send-notify-failure ]
} cond ;
M: x11-ui-backend (close-window) ( handle -- )
dup xic>> XDestroyIC
dup glx>> destroy-glx
window>> dup unregister-window
destroy-window ;
M: world client-event
swap close-box? [ ungraft ] [ drop ] if ;
: gadget-window ( world -- )
dup window-loc>> over rect-dim glx-window
over "Factor" create-xic rot <x11-handle>
2dup window>> register-window
>>handle drop ;
: wait-event ( -- event )
QueuedAfterFlush events-queued 0 > [
next-event dup
None XFilterEvent zero? [ drop wait-event ] unless
] [
ui-wait wait-event
] if ;
M: x11-ui-backend do-events
wait-event dup XAnyEvent-window window dup
[ handle-event ] [ 2drop ] if ;
: x-clipboard@ ( gadget clipboard -- prop win )
atom>> swap
find-world handle>> window>> ;
M: x-clipboard copy-clipboard
[ x-clipboard@ own-selection ] keep
(>>contents) ;
M: x-clipboard paste-clipboard
[ find-world handle>> window>> ] dip atom>> convert-selection ;
: init-clipboard ( -- )
XA_PRIMARY <x-clipboard> selection set-global
XA_CLIPBOARD <x-clipboard> clipboard set-global ;
: set-title-old ( dpy window string -- )
dup [ 127 <= ] all? [ XStoreName drop ] [ 3drop ] if ;
: set-title-new ( dpy window string -- )
[ XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace ] dip
utf8 encode dup length XChangeProperty drop ;
M: x11-ui-backend set-title ( string world -- )
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
M: x11-ui-backend set-fullscreen* ( ? world -- )
handle>> window>> "XClientMessageEvent" <c-object>
tuck set-XClientMessageEvent-window
swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
over set-XClientMessageEvent-data0
ClientMessage over set-XClientMessageEvent-type
dpy get over set-XClientMessageEvent-display
"_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
32 over set-XClientMessageEvent-format
"_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
[ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
M: x11-ui-backend (open-window) ( world -- )
dup gadget-window
handle>> window>> dup set-closable map-window ;
M: x11-ui-backend raise-window* ( world -- )
handle>> [
dpy get swap window>> XRaiseWindow drop
] when* ;
M: x11-handle select-gl-context ( handle -- )
dpy get swap
[ window>> ] [ glx>> ] bi glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-handle flush-gl-context ( handle -- )
dpy get swap window>> glXSwapBuffers ;
M: x11-pixmap-handle select-gl-context ( handle -- )
dpy get swap
[ glx-pixmap>> ] [ glx>> ] bi glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-pixmap-handle flush-gl-context ( handle -- )
drop ;
M: x11-ui-backend (open-offscreen-buffer) ( world -- )
dup dim>> glx-pixmap <x11-pixmap-handle> >>handle drop ;
M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
dpy get swap
[ glx-pixmap>> glXDestroyGLXPixmap ]
[ pixmap>> XFreePixmap drop ]
[ glx>> glXDestroyContext ] 2tri ;
M: x11-ui-backend offscreen-pixels ( world -- alien w h )
[ [ dim>> ] [ handle>> pixmap>> ] bi pixmap-bits ] [ dim>> first2 ] bi ;
M: x11-ui-backend ui ( -- )
[
f [
[
init-clipboard
start-ui
event-loop
] with-xim
] with-x
] ui-running ;
M: x11-ui-backend beep ( -- )
dpy get 100 XBell drop ;
x11-ui-backend ui-backend set-global
[ "DISPLAY" os-env "ui" "listener" ? ]
main-vocab-hook set-global

8
basis/unicode/data/data.factor
View File

@ -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

4
basis/windows/kernel32/kernel32.factor
View File

@ -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

5
basis/windows/winsock/winsock.factor Normal file → Executable file
View File

@ -257,12 +257,11 @@ TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO
TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
: FD_MAX_EVENTS 10 ;
CONSTANT: FD_MAX_EVENTS 10
C-STRUCT: WSANETWORKEVENTS
{ "long" "lNetworkEvents" }
! { { "int" "FD_MAX_EVENTS" } "iErrorCode" } ;
{ { "int" 10 } "iErrorCode" } ;
{ { "int" FD_MAX_EVENTS } "iErrorCode" } ;
TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS

350
basis/x11/constants/constants.factor
View File

@ -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

34
basis/x11/glx/glx.factor
View File

@ -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

2
basis/x11/xim/xim.factor
View File

@ -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

12
basis/xml/entities/entities.factor
View File

@ -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: < "&lt;" }
{ CHAR: > "&gt;" }
{ CHAR: & "&amp;" }
} ;
}
: quoted-entities-out
CONSTANT: quoted-entities-out
H{
{ CHAR: & "&amp;" }
{ CHAR: ' "&apos;" }
{ CHAR: " "&quot;" }
{ CHAR: < "&lt;" }
} ;
}
: 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

4
basis/xml/errors/errors.factor
View File

@ -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

2
core/bootstrap/primitives.factor
View File

@ -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

4
core/compiler/units/units-docs.factor
View File

@ -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." } ;

3
core/compiler/units/units.factor
View File

@ -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 ;

8
core/continuations/continuations.factor
View File

@ -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 { } ;

6
core/effects/effects.factor
View File

@ -45,9 +45,9 @@ M: effect effect>string ( effect -- string )
GENERIC: stack-effect ( word -- effect/f )
M: word stack-effect
"declared-effect" "inferred-effect"
[ word-prop ] bi-curry@ bi or ;
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> ;

12
core/generic/standard/standard.factor
View File

@ -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

5
core/io/encodings/encodings-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax io quotations ;
USING: help.markup help.syntax io quotations math ;
IN: io.encodings
HELP: <encoder>
@ -71,6 +71,9 @@ HELP: with-encoded-output
{ $description "Creates a new encoder with the given encoding descriptor and calls the quotation using this encoder. The original encoder object is restored after the quotation returns and the stream is kept open for future output operations." } ;
HELP: replacement-char
{ $values
{ "value" integer }
}
{ $description "A code point that replaces input that could not be decoded. The presence of this character in the decoded data usually signifies an error." } ;
ARTICLE: "encodings-descriptors" "Encoding descriptors"

4
core/words/words-docs.factor
View File

@ -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 } "."
} ;

4
core/words/words.factor
View File

@ -211,8 +211,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

2
extra/24-game/24-game.factor
View File

@ -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 )

4
extra/benchmark/backtrack/backtrack.factor
View File

@ -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
extra/benchmark/fasta/fasta.factor
View File

@ -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

7
extra/benchmark/raytracer/raytracer.factor
View File

@ -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

2
extra/benchmark/sockets/sockets.factor
View File

@ -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> ;

82
extra/cairo-demo/cairo-demo.factor
View File

@ -6,68 +6,80 @@
! http://cairographics.org/samples/text/
USING: cairo.ffi math math.constants byte-arrays kernel ui ui.render
ui.gadgets opengl.gl accessors ;
USING: cairo.ffi math math.constants byte-arrays kernel ui
ui.render combinators ui.gadgets opengl.gl accessors
namespaces opengl ;
IN: cairo-demo
: make-image-array ( -- array )
384 256 4 * * <byte-array> ;
384 256 4 * * <byte-array> ;
: convert-array-to-surface ( array -- cairo_surface_t )
CAIRO_FORMAT_ARGB32 384 256 over 4 *
cairo_image_surface_create_for_data ;
CAIRO_FORMAT_ARGB32 384 256 over 4 *
cairo_image_surface_create_for_data ;
TUPLE: cairo-demo-gadget < gadget image-array cairo-t ;
M: cairo-demo-gadget draw-gadget* ( gadget -- )
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
[ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip
image-array>> glDrawPixels ;
origin get [
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
[ 384 256 GL_RGBA GL_UNSIGNED_BYTE ] dip
image-array>> glDrawPixels
] with-translation ;
: create-surface ( gadget -- cairo_surface_t )
make-image-array [ swap (>>image-array) ] keep
convert-array-to-surface ;
: init-cairo ( gadget -- cairo_t )
create-surface cairo_create ;
create-surface cairo_create ;
M: cairo-demo-gadget pref-dim* drop { 384 256 0 } ;
M: cairo-demo-gadget pref-dim* drop { 384 256 } ;
ERROR: no-cairo-t ;
<PRIVATE
: draw-hello-world ( gadget -- )
cairo-t>>
dup "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face
dup 90.0 cairo_set_font_size
dup 10.0 135.0 cairo_move_to
dup "Hello" cairo_show_text
dup 70.0 165.0 cairo_move_to
dup "World" cairo_text_path
dup 0.5 0.5 1 cairo_set_source_rgb
dup cairo_fill_preserve
dup 0 0 0 cairo_set_source_rgb
dup 2.56 cairo_set_line_width
dup cairo_stroke
dup 1 0.2 0.2 0.6 cairo_set_source_rgba
dup 10.0 135.0 5.12 0 pi 2 * cairo_arc
dup cairo_close_path
dup 70.0 165.0 5.12 0 pi 2 * cairo_arc
cairo_fill ;
cairo-t>> [ no-cairo-t ] unless*
{
[
"Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD
cairo_select_font_face
]
[ 90.0 cairo_set_font_size ]
[ 10.0 135.0 cairo_move_to ]
[ "Hello" cairo_show_text ]
[ 70.0 165.0 cairo_move_to ]
[ "World" cairo_text_path ]
[ 0.5 0.5 1 cairo_set_source_rgb ]
[ cairo_fill_preserve ]
[ 0 0 0 cairo_set_source_rgb ]
[ 2.56 cairo_set_line_width ]
[ cairo_stroke ]
[ 1 0.2 0.2 0.6 cairo_set_source_rgba ]
[ 10.0 135.0 5.12 0 pi 2 * cairo_arc ]
[ cairo_close_path ]
[ 70.0 165.0 5.12 0 pi 2 * cairo_arc ]
[ cairo_fill ]
} cleave ;
PRIVATE>
M: cairo-demo-gadget graft* ( gadget -- )
dup dup init-cairo swap (>>cairo-t) draw-hello-world ;
dup dup init-cairo swap (>>cairo-t) draw-hello-world ;
M: cairo-demo-gadget ungraft* ( gadget -- )
cairo-t>> cairo_destroy ;
cairo-t>> cairo_destroy ;
: <cairo-demo-gadget> ( -- gadget )
cairo-demo-gadget new-gadget ;
cairo-demo-gadget new-gadget ;
: run ( -- )
[
[
<cairo-demo-gadget> "Hello World from Factor!" open-window
] with-ui ;
] with-ui ;
MAIN: run

4
extra/galois-talk/galois-talk.factor
View File

@ -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 ;

4
extra/game-input/iokit/iokit.factor
View File

@ -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 ;

4
extra/google-tech-talk/google-tech-talk.factor
View File

@ -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 ;

2
extra/irc/client/client.factor
View File

@ -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

6
extra/irc/ui/ui.factor
View File

@ -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 )
[ "." ]

8
extra/joystick-demo/joystick-demo.factor
View File

@ -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> ;

6
extra/key-caps/key-caps.factor
View File

@ -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 ;

2
extra/lint/lint.factor
View File

@ -42,7 +42,7 @@ SYMBOL: def-hash-keys
set-alien-float alien-float
} ;
: trivial-defs
: trivial-defs ( -- seq )
{
[ drop ] [ 2array ]
[ bitand ]

2
extra/lisppaste/lisppaste.factor
View File

@ -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 ;

28
extra/mason/common/common.factor
View File

@ -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

4
extra/math/analysis/analysis.factor
View File

@ -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 ;

2
extra/maze/maze.factor
View File

@ -4,7 +4,7 @@ arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
math.order math.rectangles ;
IN: maze
: line-width 8 ;
CONSTANT: line-width 8
SYMBOL: visited

4
extra/minneapolis-talk/minneapolis-talk.factor
View File

@ -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 ;

116
extra/minneapolis-talk/minneapolis-talk.txt
View File

@ -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

Some files were not shown because too many files have changed in this diff Show More