From 748cb2c3184c7456ffb2f1ab26700cfa8d840e49 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 00:28:46 -0400 Subject: [PATCH 1/6] Fix bug in match --- extra/match/match-tests.factor | 2 ++ extra/match/match.factor | 9 ++++++--- 2 files changed, 8 insertions(+), 3 deletions(-) mode change 100644 => 100755 extra/match/match-tests.factor mode change 100644 => 100755 extra/match/match.factor diff --git a/extra/match/match-tests.factor b/extra/match/match-tests.factor old mode 100644 new mode 100755 index 6761557cbe..d9162ae286 --- a/extra/match/match-tests.factor +++ b/extra/match/match-tests.factor @@ -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 diff --git a/extra/match/match.factor b/extra/match/match.factor old mode 100644 new mode 100755 index 296bcf778b..0b4b2f1a0d --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -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? ] [ From 4a2a214cb028469af54e20ab0612a530ca59f34f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 00:42:36 -0400 Subject: [PATCH 2/6] Another fix --- extra/match/match.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/match/match.factor b/extra/match/match.factor index 0b4b2f1a0d..527d7f2465 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -61,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 ; From 346937a31a7b5b3e2afc0ee7cd370c35bb810bcd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 01:19:19 -0400 Subject: [PATCH 3/6] Fix stack effect error in com-back --- extra/ui/tools/walker/walker.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 extra/ui/tools/walker/walker.factor diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor old mode 100644 new mode 100755 index fabdf26818..3ff9b284e5 --- a/extra/ui/tools/walker/walker.factor +++ b/extra/ui/tools/walker/walker.factor @@ -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 -- ) over set-walker-interpreter From 738672be9fec87e073d77b85d736b3c2c4c24947 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 01:19:33 -0400 Subject: [PATCH 4/6] ui.windows cleanup --- extra/ui/windows/windows.factor | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index bbcf96e0b2..cba9c427b7 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -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? ; @@ -319,7 +316,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 ] From da4c77b445a0e228854fad72187c8f98f96c972b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 01:21:26 -0400 Subject: [PATCH 5/6] Remove commented-out code --- extra/ui/windows/windows.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index cba9c427b7..6b19085a1c 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -306,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 = ] @@ -340,7 +338,6 @@ SYMBOL: hWnd { [ t ] [ drop DefWindowProc ] } } cond ] ui-try - ! "finished handling message" print .s flush ] alien-callback ; : do-events ( -- ) From d69ad235f6ffc740cb0bbf7d4b7da82d317e52e6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Oct 2007 01:21:37 -0400 Subject: [PATCH 6/6] Remove non-working Windows CE SEH code --- vm/Config.windows.ce.arm | 1 - vm/os-windows-ce.c | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) mode change 100644 => 100755 vm/Config.windows.ce.arm diff --git a/vm/Config.windows.ce.arm b/vm/Config.windows.ce.arm old mode 100644 new mode 100755 index 1026968674..98e08e8f61 --- a/vm/Config.windows.ce.arm +++ b/vm/Config.windows.ce.arm @@ -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 diff --git a/vm/os-windows-ce.c b/vm/os-windows-ce.c index 7113cd4498..e6ef8b1108 100755 --- a/vm/os-windows-ce.c +++ b/vm/os-windows-ce.c @@ -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); }