Merge git://factorcode.org/git/factor
commit
b23c3bdce7
|
@ -5,6 +5,8 @@ IN: temporary
|
|||
|
||||
MATCH-VARS: ?a ?b ;
|
||||
|
||||
[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
|
||||
|
||||
[ H{ { ?a 1 } { ?b 2 } } ] [
|
||||
{ ?a ?b } { 1 2 } match
|
||||
] unit-test
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
!
|
||||
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
|
||||
USING: parser kernel words namespaces sequences tuples
|
||||
combinators macros ;
|
||||
combinators macros assocs ;
|
||||
IN: match
|
||||
|
||||
SYMBOL: _
|
||||
|
@ -22,10 +22,13 @@ SYMBOL: _
|
|||
: match-var? ( symbol -- bool )
|
||||
dup word? [ "match-var" word-prop ] [ drop f ] if ;
|
||||
|
||||
: set-match-var ( value var -- ? )
|
||||
dup namespace key? [ get = ] [ set t ] if ;
|
||||
|
||||
: (match) ( value1 value2 -- matched? )
|
||||
{
|
||||
{ [ dup match-var? ] [ set t ] }
|
||||
{ [ over match-var? ] [ swap set t ] }
|
||||
{ [ dup match-var? ] [ set-match-var ] }
|
||||
{ [ over match-var? ] [ swap set-match-var ] }
|
||||
{ [ 2dup = ] [ 2drop t ] }
|
||||
{ [ 2dup [ _ eq? ] either? ] [ 2drop t ] }
|
||||
{ [ 2dup [ sequence? ] both? ] [
|
||||
|
@ -58,4 +61,6 @@ MACRO: match-cond ( assoc -- )
|
|||
} cond ;
|
||||
|
||||
: match-replace ( object pattern1 pattern2 -- result )
|
||||
-rot match [ replace-patterns ] bind ;
|
||||
-rot
|
||||
match [ "Pattern does not match" throw ] unless*
|
||||
[ replace-patterns ] bind ;
|
||||
|
|
|
@ -39,7 +39,7 @@ TUPLE: walker model interpreter history ;
|
|||
|
||||
: com-back ( walker -- )
|
||||
dup walker-history
|
||||
dup empty? [ drop ] [ pop swap call-tool* ] if ;
|
||||
dup empty? [ 2drop ] [ pop swap call-tool* ] if ;
|
||||
|
||||
: reset-walker ( walker -- )
|
||||
<interpreter> over set-walker-interpreter
|
||||
|
|
|
@ -14,21 +14,18 @@ TUPLE: windows-ui-backend ;
|
|||
: crlf>lf CHAR: \r swap remove ;
|
||||
: lf>crlf [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
|
||||
|
||||
: (enum-clipboard) ( n -- n )
|
||||
EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;
|
||||
|
||||
: enum-clipboard ( -- seq )
|
||||
[ 0 (enum-clipboard) ] { } make nip ;
|
||||
0 [ EnumClipboardFormats win32-error dup dup 0 > ] [ ]
|
||||
{ } unfold nip ;
|
||||
|
||||
: with-clipboard ( quot -- )
|
||||
f OpenClipboard win32-error=0/f
|
||||
call
|
||||
CloseClipboard win32-error=0/f ; inline
|
||||
|
||||
|
||||
: paste ( -- str )
|
||||
[
|
||||
CF_UNICODETEXT IsClipboardFormatAvailable 0 = [
|
||||
CF_UNICODETEXT IsClipboardFormatAvailable zero? [
|
||||
! nothing to paste
|
||||
""
|
||||
] [
|
||||
|
@ -132,7 +129,7 @@ SYMBOL: mouse-captured
|
|||
} ;
|
||||
|
||||
: key-state-down?
|
||||
GetKeyState 1 16 shift bitand 0 > ;
|
||||
GetKeyState 16 bit? ;
|
||||
|
||||
: left-shift? ( -- ? ) VK_LSHIFT key-state-down? ;
|
||||
: left-ctrl? ( -- ? ) VK_LCONTROL key-state-down? ;
|
||||
|
@ -309,8 +306,6 @@ SYMBOL: hWnd
|
|||
"uint" { "void*" "uint" "long" "long" } "stdcall" [
|
||||
[
|
||||
pick
|
||||
! "Message: " write dup get-windows-message-name write
|
||||
! " " write dup unparse print flush
|
||||
{
|
||||
{ [ dup WM_CLOSE = ] [ drop handle-wm-close 0 ] }
|
||||
{ [ dup WM_PAINT = ]
|
||||
|
@ -319,7 +314,7 @@ SYMBOL: hWnd
|
|||
|
||||
! Keyboard events
|
||||
{ [ dup WM_KEYDOWN = over WM_SYSKEYDOWN = or ]
|
||||
[ drop 4dup handle-wm-keydown DefWindowProc ] }
|
||||
[ drop 4dup handle-wm-keydown DefWindowProc ] }
|
||||
{ [ dup WM_CHAR = over WM_SYSCHAR = or ]
|
||||
[ drop 4dup handle-wm-char DefWindowProc ] }
|
||||
{ [ dup WM_KEYUP = over WM_SYSKEYUP = or ]
|
||||
|
@ -343,7 +338,6 @@ SYMBOL: hWnd
|
|||
{ [ t ] [ drop DefWindowProc ] }
|
||||
} cond
|
||||
] ui-try
|
||||
! "finished handling message" print .s flush
|
||||
] alien-callback ;
|
||||
|
||||
: do-events ( -- )
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
CC = arm-wince-mingw32ce-gcc
|
||||
DLL_SUFFIX=-ce
|
||||
EXE_SUFFIX=-ce
|
||||
PLAF_DLL_OBJS += vm/os-windows-ce-arm.o
|
||||
include vm/Config.windows.ce vm/Config.arm
|
||||
|
|
|
@ -37,7 +37,7 @@ char *getenv(char *name)
|
|||
return 0; /* unreachable */
|
||||
}
|
||||
|
||||
long exception_handler(PEXCEPTION_RECORD rec, void *frame, void *ctx, void *dispatch)
|
||||
void c_to_factor_toplevel(CELL quot)
|
||||
{
|
||||
return 0;
|
||||
c_to_factor(quot);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue