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

Merge remote-tracking branch 'upstream/master'

db4
John Benediktsson 2011-08-01 13:42:47 -07:00
parent e1649f24ac 4b545a316a
commit 15f2a86e0f
18 changed files with 82 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/core-foundation/strings/strings.factor
View File

@ -3,7 +3,7 @@
USING: alien.c-types alien.data alien.syntax alien.strings
io.encodings.string kernel sequences byte-arrays
io.encodings.utf8 math core-foundation core-foundation.arrays
destructors parser fry alien words ;
core-foundation.data destructors parser fry alien words ;
IN: core-foundation.strings
TYPEDEF: void* CFStringRef
@ -60,6 +60,9 @@ FUNCTION: CFStringRef CFStringCreateWithCString (
CFStringEncoding encoding
) ;
FUNCTION: CFStringRef CFCopyDescription ( CFTypeRef cf ) ;
FUNCTION: CFStringRef CFCopyTypeIDDescription ( CFTypeID type_id ) ;
: prepare-CFString ( string -- byte-array )
[
dup HEX: 10ffff >
@ -88,6 +91,11 @@ FUNCTION: CFStringRef CFStringCreateWithCString (
: <CFStringArray> ( seq -- alien )
[ [ <CFString> &CFRelease ] map <CFArray> ] with-destructors ;
: CF>description ( cf -- description )
[ CFCopyDescription &CFRelease CF>string ] with-destructors ;
: CFType>description ( cf -- description )
CFGetTypeID [ CFCopyTypeIDDescription &CFRelease CF>string ] with-destructors ;
SYNTAX: CFSTRING:
CREATE scan-object
[ drop ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi

2
basis/editors/vim/vim.factor
View File

@ -16,7 +16,7 @@ M: vim vim-command
] { } make ;
: vim ( file line -- )
vim-command run-detached drop ;
vim-command run-process drop ;
"vim" vim-path set-global
[ vim ] edit-hook set-global

22
basis/game/input/iokit/iokit.factor
View File

@ -1,5 +1,6 @@
USING: cocoa cocoa.plists core-foundation iokit iokit.hid
kernel cocoa.enumeration destructors math.parser cocoa.application
core-foundation.data core-foundation.strings
sequences locals combinators.short-circuit threads
namespaces assocs arrays combinators hints alien
core-foundation.run-loop accessors sequences.private
@ -270,11 +271,26 @@ M: iokit-game-input-backend reset-mouse
: device-removed-callback ( -- alien )
[ (device-removed-callback) ] IOHIDDeviceCallback ;
! Lion sends the input callback an IOHIDQueue as the "sender".
! Leopard and Snow Leopard send an IOHIDDevice.
! This function gets the IOHIDDevice regardless of which is received
: get-input-device ( sender -- device )
dup CFGetTypeID {
{ [ dup IOHIDDeviceGetTypeID = ] [ drop ] }
{ [ dup IOHIDQueueGetTypeID = ] [ drop IOHIDQueueGetDevice ] }
[
drop
"input callback doesn't know how to deal with "
swap CF>description append throw
]
} cond ;
:: (device-input-callback) ( context result sender value -- )
sender get-input-device :> device
{
{ [ sender mouse-device? ] [ +mouse-state+ get-global value record-mouse ] }
{ [ sender controller-device? ] [
sender +controller-states+ get-global at value record-controller
{ [ device mouse-device? ] [ +mouse-state+ get-global value record-mouse ] }
{ [ device controller-device? ] [
device +controller-states+ get-global at value record-controller
] }
[ +keyboard-state+ get-global value record-keyboard ]
} cond ;

5
basis/iokit/hid/hid.factor
View File

@ -125,6 +125,7 @@ TYPEDEF: uint IOHIDQueueOptionsType
TYPEDEF: uint IOHIDElementFlags
TYPEDEF: void* IOHIDDeviceRef
TYPEDEF: void* IOHIDElementRef
TYPEDEF: void* IOHIDQueueRef
TYPEDEF: void* IOHIDValueRef
TYPEDEF: void* IOHIDManagerRef
TYPEDEF: void* IOHIDTransactionRef
@ -253,3 +254,7 @@ FUNCTION: IOReturn IOHIDTransactionCommit ( IOHIDTransactionRef transaction ) ;
FUNCTION: IOReturn IOHIDTransactionCommitWithCallback ( IOHIDTransactionRef transaction, CFTimeInterval timeout, IOHIDCallback callback, void* context ) ;
FUNCTION: void IOHIDTransactionClear ( IOHIDTransactionRef transaction ) ;
! IOHIDQueue
FUNCTION: CFTypeID IOHIDQueueGetTypeID ( ) ;
FUNCTION: IOHIDDeviceRef IOHIDQueueGetDevice ( IOHIDQueueRef queue ) ;

1
basis/math/functions/functions-tests.factor
View File

@ -32,6 +32,7 @@ IN: math.functions.tests
[ 0.0 ] [ 0.0 1.0 ^ ] unit-test
[ 1/0. ] [ 0 -2 ^ ] unit-test
[ t ] [ 0 0.0 ^ fp-nan? ] unit-test
[ t ] [ 0.0 0.0 ^ fp-nan? ] unit-test
[ 1/0. ] [ 0 -2.0 ^ ] unit-test
[ 0 ] [ 0 3.0 ^ ] unit-test
[ 0 ] [ 0 3 ^ ] unit-test

6
basis/math/functions/functions.factor
View File

@ -82,8 +82,8 @@ M: complex exp >rect [ exp ] dip polar> ; inline
: real^? ( x y -- ? )
2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline
: 0^ ( x -- z )
[ 0/0. ] [ 0 < 1/0. 0 ? ] if-zero ; inline
: 0^ ( zero x -- z )
swap [ 0/0. ] swap '[ 0 < 1/0. _ ? ] if-zero ; inline
: (^mod) ( x y n -- z )
[ make-bits 1 ] dip dup
@ -100,7 +100,7 @@ PRIVATE>
: ^ ( x y -- z )
{
{ [ over 0 = ] [ nip 0^ ] }
{ [ over zero? ] [ 0^ ] }
{ [ dup integer? ] [ integer^ ] }
{ [ 2dup real^? ] [ [ >float ] bi@ fpow ] }
[ ^complex ]

2
basis/opengl/gl/extensions/extensions.factor
View File

@ -50,6 +50,6 @@ reset-gl-function-number-counter
SYNTAX: GL-FUNCTION:
gl-function-calling-convention
scan-function-name
"{" expect "}" parse-tokens over prefix
"{" expect "}" parse-tokens over suffix
gl-function-counter '[ _ _ gl-function-pointer ]
";" scan-c-args define-indirect ;

2
build-support/factor.sh
View File

@ -539,7 +539,7 @@ update_bootstrap() {
}
refresh_image() {
./$FACTOR_BINARY -script -e="USING: vocabs.loader system memory ; refresh-all USE: memory save 0 exit"
./$FACTOR_BINARY -script -e="USING: vocabs.loader vocabs.refresh system memory ; refresh-all save 0 exit"
check_ret factor
}

6
core/strings/strings-tests.factor
View File

@ -67,6 +67,10 @@ unit-test
[ ] [ HEX: 4321 3 "s" get set-nth ] unit-test
[ ] [ HEX: 654321 5 "s" get set-nth ] unit-test
[ ] [ HEX: -1 5 "s" get set-nth ] unit-test
[ ] [ HEX: 80,0000 5 "s" get set-nth ] unit-test
[ ] [ HEX: 100,0000 5 "s" get set-nth ] unit-test
[
{
CHAR: h
@ -121,5 +125,3 @@ unit-test
[ <string> clone resize-string first ] keep =
] all-integers?
] unit-test
[ HEX: 7fffff ] [ { -1 } >string first ] unit-test

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

@ -8,6 +8,7 @@ arrays words quotations accessors math.parser backtrack assocs ;
IN: 24-game
SYMBOL: commands
: nop ( -- ) ;
: spin ( a b c -- c b a ) swapd swap swap ;
: 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 )

15
extra/mason/child/child-tests.factor
View File

@ -1,26 +1,27 @@
IN: mason.child.tests
USING: mason.child mason.config tools.test namespaces io kernel sequences ;
USING: mason.child mason.config tools.test namespaces io kernel
sequences system ;
[ { "nmake" "/f" "nmakefile" "x86-32" } ] [
[
"winnt" target-os set
"x86.32" target-cpu set
winnt target-os set
x86.32 target-cpu set
make-cmd
] with-scope
] unit-test
[ { "make" "macosx-x86-32" } ] [
[
"macosx" target-os set
"x86.32" target-cpu set
macosx target-os set
x86.32 target-cpu set
make-cmd
] with-scope
] unit-test
[ { "./factor.com" "-i=boot.winnt-x86.32.image" "-no-user-init" } ] [
[
"winnt" target-os set
"x86.32" target-cpu set
winnt target-os set
x86.32 target-cpu set
boot-cmd
] with-scope
] unit-test

6
extra/mason/child/child.factor
View File

@ -9,14 +9,14 @@ IN: mason.child
: nmake-cmd ( -- args )
{ "nmake" "/f" "nmakefile" }
target-cpu get "." split "-" join suffix ;
target-cpu get name>> "." split "-" join suffix ;
: gnu-make-cmd ( -- args )
gnu-make platform 2array ;
: make-cmd ( -- args )
{
{ [ target-os get "winnt" = ] [ nmake-cmd ] }
{ [ target-os get winnt = ] [ nmake-cmd ] }
[ gnu-make-cmd ]
} cond ;
@ -30,7 +30,7 @@ IN: mason.child
] with-directory ;
: factor-vm ( -- string )
target-os get "winnt" = "./factor.com" "./factor" ? ;
target-os get winnt = "./factor.com" "./factor" ? ;
: boot-cmd ( -- cmd )
[

7
extra/mason/email/email-tests.factor
View File

@ -1,10 +1,11 @@
IN: mason.email.tests
USING: mason.email mason.common mason.config namespaces tools.test ;
USING: mason.email mason.common mason.config namespaces
tools.test system ;
[ "mason on linux-x86-64: 12345 -- error" ] [
[
"linux" target-os set
"x86.64" target-cpu set
linux target-os set
x86.64 target-cpu set
"12345" current-git-id set
status-error report-subject
] with-scope

3
extra/mason/platform/platform.factor
View File

@ -5,13 +5,14 @@ mason.config bootstrap.image assocs ;
IN: mason.platform
: (platform) ( os cpu -- string )
[ name>> ] bi@
{ { CHAR: . CHAR: - } } substitute "-" glue ;
: platform ( -- string )
target-os get target-cpu get (platform) ;
: gnu-make ( -- string )
target-os get { "freebsd" "openbsd" "netbsd" } member? "gmake" "make" ? ;
target-os get { freebsd openbsd netbsd } member? "gmake" "make" ? ;
: boot-image-arch ( -- string )
target-os get target-cpu get arch ;

11
extra/mason/release/branch/branch-tests.factor
View File

@ -1,13 +1,14 @@
IN: mason.release.branch.tests
USING: mason.release.branch mason.config tools.test namespaces ;
USING: mason.release.branch mason.config tools.test namespaces
system ;
[ { "git" "push" "-f" "joe@blah.com:/my/git" "master:clean-linux-x86-32" } ] [
[
"joe" branch-username set
"blah.com" branch-host set
"/my/git" branch-directory set
"linux" target-os set
"x86.32" target-cpu set
linux target-os set
x86.32 target-cpu set
push-to-clean-branch-cmd
] with-scope
] unit-test
@ -18,8 +19,8 @@ USING: mason.release.branch mason.config tools.test namespaces ;
"joe" image-username set
"blah.com" image-host set
"/stuff/clean" image-directory set
"netbsd" target-os set
"x86.64" target-cpu set
netbsd target-os set
x86.64 target-cpu set
upload-clean-image-cmd
] with-scope
] unit-test

2
extra/trees/avl/avl.factor
View File

@ -136,7 +136,7 @@ GENERIC: avl-delete ( key node -- node shorter? deleted? )
M: f avl-delete ( key f -- f f f ) nip f f ;
: (avl-delete) ( key node -- node shorter? deleted? )
tuck node-link avl-delete [
swap over node-link avl-delete [
[ over set-node-link ] dip [ balance-delete ] [ f ] if
] dip ;

14
misc/vim/syntax/factor.vim
View File

@ -48,8 +48,8 @@ syn keyword factorBoolean f t
syn keyword factorBreakpoint B
syn keyword factorFrySpecifier @ _ contained
syn keyword factorDeclaration delimiter deprecated final flushable foldable inline recursive
syn match factorCallQuotation /\<call(\s\(\S*\s\)\?--\(\s\S*\)\?\s)\>/
syn match factorExecute /\<execute(\s\(\S*\s\)\?--\(\s\S*\)\?\s)\>/
syn match factorCallQuotation /\<call(\s\+\(\S*\s\+\)*--\(\s\+\S*\)*\s\+)\>/ contained contains=factorStackEffect
syn match factorExecute /\<execute(\s\+\(\S*\s\+\)*--\(\s\+\S*\)*\s\+)\>/ contained contains=factorStackEffect
syn keyword factorCallNextMethod call-next-method
syn keyword factorKeyword or 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry tri-curry* tri-curry@ swap and 2nip throw bi-curry (clone) hashcode* compose 2dip if 3tri unless compose? tuple keep 2curry equal? assert tri 2drop most <wrapper> boolean? identity-hashcode identity-tuple? null new dip bi-curry@ rot xor identity-tuple boolean
@ -148,8 +148,11 @@ syn match factorMultiStringContents /.*/ contained
"syn match factorStackEffectErr /\<)\>/
"syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/
"syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
syn match factorStackEffect /\<(\s\(\S*\s\)\?--\(\s\S*\)\?\s)\>/ contained
syn match factorLiteralStackEffect /\<((\s\(\S*\s\)\?--\(\s\S*\)\?\s))\>/
syn match factorStackEffect /(\s\+\(\S*\s\+\)*--\(\s\+\S*\)*\s\+)\>/ contained contains=factorStackDelims,factorStackItems,factorCallExecuteDelim
syn match factorLiteralStackEffect /((\s\+\(\S*\s\+\)*--\(\s\+\S*\)*\s\+))\>/ contained contains=factorStackDelims,factorStackItems
syn match factorStackItems contained "\<\S\+\>"
syn keyword factorStackDelims contained ( ) (( )) --
syn match factorCallExecuteDelim contained /(\s/
"adapted from lisp.vim
if exists("g:factor_norainbow")
@ -199,6 +202,9 @@ if version >= 508 || !exists("did_factor_syn_inits")
HiLink factorShebang PreProc
HiLink factorShebangErr Error
HiLink factorStackEffect Typedef
HiLink factorStackDelims Delimiter
HiLink factorCallExecuteDelim Delimiter
HiLink factorStackItems Identifier
HiLink factorLiteralStackEffect Typedef
HiLink factorTodo Todo
HiLink factorInclude Include

2
vm/Config.macosx
View File

@ -14,7 +14,7 @@ else
LIBS = -lm -framework Cocoa -framework AppKit
endif
LINKER = $(CPP) $(CFLAGS) -dynamiclib -single_module -std=gnu99 \
LINKER = $(CPP) $(CFLAGS) -dynamiclib -single_module \
-current_version $(VERSION) \
-compatibility_version $(VERSION) \
-fvisibility=hidden \