From 9f0434f30f1e82081dafe7934652a0191533f02d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Sep 2005 03:21:09 +0000 Subject: [PATCH] some UI tweaking --- library/continuations.factor | 18 +++++++++++++----- library/sdl/sdl-utils.factor | 7 +++++-- library/test/benchmark/hashtables.factor | 9 +++++---- library/test/benchmark/image.factor | 2 +- library/test/test.factor | 4 +--- library/tools/interpreter.factor | 8 ++++---- library/tools/walker.factor | 13 ++++--------- library/ui/fonts.factor | 2 +- library/ui/gadgets.factor | 5 +++++ library/ui/listener.factor | 5 +---- library/ui/load.factor | 1 + library/ui/menus.factor | 6 ++++++ library/ui/mindmap.factor | 18 ++++++++---------- library/ui/presentations.factor | 15 ++++++++------- native/unix/ffi.c | 5 +++++ 15 files changed, 68 insertions(+), 50 deletions(-) diff --git a/library/continuations.factor b/library/continuations.factor index 59aa824c78..714712e649 100644 --- a/library/continuations.factor +++ b/library/continuations.factor @@ -3,8 +3,8 @@ IN: errors USING: kernel-internals ; -: catchstack ( -- cs ) 6 getenv ; -: set-catchstack ( cs -- ) 6 setenv ; +: catchstack ( -- cs ) 6 getenv ; inline +: set-catchstack ( cs -- ) 6 setenv ; inline IN: kernel USING: namespaces sequences ; @@ -19,10 +19,16 @@ TUPLE: continuation data c call name catch ; : set-c-stack ( c-stack -- ) [ "not supported" throw ] when ; +: interpret ( quot -- ) + #! Call the quotation in the interpreter. When compiled, + #! the quotation is ignored. + call ; + : continuation ( -- interp ) #! The continuation is reified from after the *caller* of - #! this word returns. - datastack c-stack callstack dup pop* dup pop* + #! this word returns. It must be declared inline for this + #! invariant to be preserved in compiled code too. + datastack c-stack callstack [ dup pop* dup pop* ] interpret namestack catchstack ; inline : >continuation< ( continuation -- data c call name catch ) @@ -33,9 +39,11 @@ TUPLE: continuation data c call name catch ; continuation-catch ; inline : ifcc ( terminator balance -- | quot: continuation -- ) + #! Note that the branch at the end must not be optimized out + #! by the compiler. [ continuation - dup continuation-data f over push f swap push t + dup continuation-data f over push f swap push dup ] call 2swap if ; inline : callcc0 ( quot -- | quot: continuation -- ) diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor index c575f756b6..a212b76741 100644 --- a/library/sdl/sdl-utils.factor +++ b/library/sdl/sdl-utils.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: sdl -USING: kernel lists math namespaces sequences ; +USING: errors kernel lists math namespaces sequences ; SYMBOL: surface SYMBOL: width @@ -12,9 +12,12 @@ SYMBOL: bpp >r 3dup bpp set height set width set r> SDL_SetVideoMode surface set ; +: sdl-error ( 0/-1 -- ) + 0 = [ SDL_GetError throw ] unless ; + : with-screen ( width height bpp flags quot -- ) #! Set up SDL graphics and call the quotation. - SDL_INIT_EVERYTHING SDL_Init drop + SDL_INIT_EVERYTHING SDL_Init sdl-error 1 SDL_EnableUNICODE drop SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL SDL_EnableKeyRepeat drop diff --git a/library/test/benchmark/hashtables.factor b/library/test/benchmark/hashtables.factor index 57334e448b..f65965a71c 100644 --- a/library/test/benchmark/hashtables.factor +++ b/library/test/benchmark/hashtables.factor @@ -1,14 +1,15 @@ USING: compiler hashtables kernel math namespaces sequences test ; : store-hash ( hashtable n -- ) - [ >float dup pick set-hash ] each drop ; + [ dup pick set-hash ] each drop ; : lookup-hash ( hashtable n -- ) - [ >float over hash drop ] each drop ; + [ over hash drop ] each drop ; : hashtable-benchmark ( -- ) 100 [ - 80000 1000 swap 2dup store-hash lookup-hash - ] times ; compiled + drop + 80000 100000 swap 2dup store-hash lookup-hash + ] each ; compiled [ ] [ hashtable-benchmark ] unit-test diff --git a/library/test/benchmark/image.factor b/library/test/benchmark/image.factor index b4812ec96b..182dd6c52f 100644 --- a/library/test/benchmark/image.factor +++ b/library/test/benchmark/image.factor @@ -2,7 +2,7 @@ IN: temporary USING: generic image kernel math namespaces parser test ; [ - "/library/bootstrap/boot-stage1.factor" run-resource + "/library/bootstrap/boot-stage1.factor" run-resource drop ] with-image drop [ fixnum ] [ 4 class ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index 64c64de025..7e8bcf7c10 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -111,10 +111,8 @@ SYMBOL: failures { "io/buffer" "compiler/optimizer" "compiler/simple" - "compiler/stack" "compiler/if" + "compiler/stack" "compiler/ifte" "compiler/generic" "compiler/bail-out" "compiler/linearizer" "compiler/intrinsics" "compiler/identities" } run-tests ; - -: all-tests tests compiler-tests benchmarks ; diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor index e9e890f30e..4d649f2084 100644 --- a/library/tools/interpreter.factor +++ b/library/tools/interpreter.factor @@ -54,10 +54,10 @@ SYMBOL: meta-executing : host-word ( word -- ) [ - \ call push-r continuation [ - continuation over continuation-data push continue - ] cons cons push-r meta-interp continue - ] call set-meta-interp pop-d 2drop ; + \ call push-r + [ continuation swap continue-with ] cons cons push-r + meta-interp continue + ] callcc1 set-meta-interp pop-d 2drop ; : meta-call ( quot -- ) #! Note we do tail call optimization here. diff --git a/library/tools/walker.factor b/library/tools/walker.factor index dd8085bec6..5aa0ca39d4 100644 --- a/library/tools/walker.factor +++ b/library/tools/walker.factor @@ -36,23 +36,17 @@ sequences io strings vectors words ; #! Step into current word. next do report ; -: continue +: end-walk #! Continue executing the single-stepped continuation in the #! primary interpreter. - meta-d get set-datastack - meta-c get set-catchstack - meta-cf get - meta-r get - meta-n get set-namestack - set-callstack call ; + \ call push-r meta-cf get push-r meta-interp continue ; : walk-banner ( -- ) "&s &r show stepper stacks" print "&get ( var -- value ) get stepper variable value" print "step -- single step over" print "into -- single step into" print - "continue -- continue execution" print - "bye -- exit single-stepper" print + "bye -- continue execution" print report ; : walk-listener walk-banner "walk " listener-prompt set listener ; @@ -71,4 +65,5 @@ sequences io strings vectors words ; callstack namestack [ init-walk walk-listener + end-walk ] with-scope ; diff --git a/library/ui/fonts.factor b/library/ui/fonts.factor index b080d78920..7bca0a8b23 100644 --- a/library/ui/fonts.factor +++ b/library/ui/fonts.factor @@ -35,7 +35,7 @@ SYMBOL: open-fonts global [ open-fonts nest drop ] bind : ttf-init ( -- ) - TTF_Init -1 = [ SDL_GetError throw ] when + TTF_Init sdl-error global [ open-fonts [ [ cdr expired? not ] hash-subset ] change ] bind ; diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 26fcdbfea2..28838a900e 100644 --- a/library/ui/gadgets.factor +++ b/library/ui/gadgets.factor @@ -74,3 +74,8 @@ M: gadget children-on ( rect/point gadget -- list ) [ nip pick-up ] [ rot 2drop ] if ] with-scope ] [ 2drop f ] if ; + +! Mind-map/outliner node protocol +GENERIC: node-gadget ( node -- gadget ) +GENERIC: node-left ( node -- seq ) +GENERIC: node-right ( node -- seq ) diff --git a/library/ui/listener.factor b/library/ui/listener.factor index 61ea55ed80..065e94bf9d 100644 --- a/library/ui/listener.factor +++ b/library/ui/listener.factor @@ -30,14 +30,11 @@ C: display ( -- display ) 2dup swap set-display-pane over add-center ; -: make-presentations ( seq -- seq ) - [ [ unparse-short