Merge branch 'master' of git://factorcode.org/git/factor

db4
erg 2008-03-26 22:39:37 -05:00
commit 5f38dca1e5
3 changed files with 34 additions and 7 deletions

View File

@ -3,7 +3,8 @@
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser match
unicode.categories sequences.lib compiler.units parser unicode.categories sequences.lib compiler.units parser
words quotations effects memoize accessors combinators.cleave ; words quotations effects memoize accessors
combinators.cleave locals ;
IN: peg IN: peg
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
@ -14,9 +15,23 @@ SYMBOL: ignore
parse-result construct-boa ; parse-result construct-boa ;
SYMBOL: compiled-parsers SYMBOL: compiled-parsers
SYMBOL: packrat
SYMBOL: failed
GENERIC: (compile) ( parser -- quot ) GENERIC: (compile) ( parser -- quot )
:: run-packrat-parser ( input quot c -- result )
input slice? [ input slice-from ] [ 0 ] if
quot c [ drop H{ } clone ] cache
[
drop input quot call
] cache ; inline
: run-parser ( input quot -- result )
#! If a packrat cache is available, use memoization for
#! packrat parsing, otherwise do a standard peg call.
packrat get [ run-packrat-parser ] [ call ] if* ; inline
: compiled-parser ( parser -- word ) : compiled-parser ( parser -- word )
#! Look to see if the given parser has been compiled. #! Look to see if the given parser has been compiled.
#! If not, compile it to a temporary word, cache it, #! If not, compile it to a temporary word, cache it,
@ -24,11 +39,11 @@ GENERIC: (compile) ( parser -- quot )
dup compiled-parsers get at [ dup compiled-parsers get at [
nip nip
] [ ] [
dup (compile) define-temp dup (compile) [ run-parser ] curry define-temp
[ swap compiled-parsers get set-at ] keep [ swap compiled-parsers get set-at ] keep
] if* ; ] if* ;
MEMO: compile ( parser -- word ) : compile ( parser -- word )
H{ } clone compiled-parsers [ H{ } clone compiled-parsers [
[ compiled-parser ] with-compilation-unit [ compiled-parser ] with-compilation-unit
] with-variable ; ] with-variable ;

View File

@ -3,13 +3,14 @@
USING: arrays ui.gadgets USING: arrays ui.gadgets
ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
namespaces sequences models combinators math.vectors ; namespaces sequences models combinators math.vectors
tuples ;
IN: ui.gadgets.scrollers IN: ui.gadgets.scrollers
TUPLE: scroller viewport x y follows ; TUPLE: scroller viewport x y follows ;
: find-scroller ( gadget -- scroller/f ) : find-scroller ( gadget -- scroller/f )
[ scroller? ] find-parent ; [ [ scroller? ] is? ] find-parent ;
: scroll-up-page scroller-y -1 swap slide-by-page ; : scroll-up-page scroller-y -1 swap slide-by-page ;

View File

@ -6,7 +6,8 @@ kernel models namespaces parser quotations sequences ui.commands
ui.gadgets ui.gadgets.editors ui.gadgets.labelled ui.gadgets ui.gadgets.editors ui.gadgets.labelled
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.operations vocabs words ui.gadgets.tracks ui.gestures ui.operations vocabs words
prettyprint listener debugger threads boxes concurrency.flags ; prettyprint listener debugger threads boxes concurrency.flags
math arrays ;
IN: ui.tools.listener IN: ui.tools.listener
TUPLE: listener-gadget input output stack ; TUPLE: listener-gadget input output stack ;
@ -23,9 +24,19 @@ TUPLE: listener-gadget input output stack ;
: <listener-input> ( listener -- gadget ) : <listener-input> ( listener -- gadget )
listener-gadget-output <pane-stream> <interactor> ; listener-gadget-output <pane-stream> <interactor> ;
TUPLE: input-scroller ;
: <input-scroller> ( interactor -- scroller )
<scroller>
input-scroller construct-empty
[ set-gadget-delegate ] keep ;
M: input-scroller pref-dim*
drop { 0 100 } ;
: listener-input, ( -- ) : listener-input, ( -- )
g <listener-input> g-> set-listener-gadget-input g <listener-input> g-> set-listener-gadget-input
<scroller> "Input" <labelled-gadget> f track, ; <input-scroller> "Input" <labelled-gadget> f track, ;
: welcome. ( -- ) : welcome. ( -- )
"If this is your first time with Factor, please read the " print "If this is your first time with Factor, please read the " print