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

db4
John Benediktsson 2009-01-11 18:05:12 -08:00
commit f04517e52c
30 changed files with 547 additions and 324 deletions

View File

@ -267,8 +267,8 @@ $nl
{ $heading "Example: ls" }
"Here is an example implementing a simplified version of the Unix " { $snippet "ls" } " command in Factor:"
{ $code
<" USING: command-line namespaces io io.files tools.files
sequences kernel ;
<" USING: command-line namespaces io io.files
io.pathnames tools.files sequences kernel ;
command-line get [
current-directory get directory.

View File

@ -26,7 +26,7 @@ HELP: scaffold-undocumented
HELP: scaffold-vocab
{ $values
{ "vocab-root" "a vocabulary root string" } { "string" string } }
{ $description "Creates a direcory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ;
{ $description "Creates a directory in the given root for a new vocabulary and adds a main .factor file, a tests file, and an authors.txt file." } ;
HELP: using
{ $description "Stores the vocabularies that are pulled into the documentation file from looking up the stack effect types." } ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math namespaces
make opengl sequences strings splitting ui.gadgets
@ -12,11 +12,7 @@ TUPLE: label < gadget text font color ;
text>> dup string? [ "\n" join ] unless ; inline
: set-label-string ( string label -- )
CHAR: \n pick memq? [
[ string-lines ] dip (>>text)
] [
(>>text)
] if ; inline
[ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
: label-theme ( gadget -- gadget )
sans-serif-font >>font

View File

@ -4,8 +4,7 @@ USING: combinators.short-circuit unicode.categories kernel math
combinators splitting sequences math.parser io.files io assocs
arrays namespaces make math.ranges unicode.normalize.private values
io.encodings.ascii unicode.syntax unicode.data compiler.units fry
alien.syntax sets accessors interval-maps memoize locals words
strings hints ;
alien.syntax sets accessors interval-maps memoize locals words ;
IN: unicode.breaks
<PRIVATE
@ -212,25 +211,21 @@ to: word-table
[ dupd walk-up wNumeric property-not= ] }
{ check-number-before
[ dupd walk-down wNumeric property-not= ] }
} case ; inline
} case ;
:: word-break-next ( old-class new-char i str -- next-class ? )
new-char dup format/extended?
[ drop old-class dup { 1 2 3 } member? ] [
word-break-prop old-class over word-table-nth
i str word-break?
] if ; inline
] if ;
PRIVATE>
: first-word ( str -- i )
[ unclip-slice word-break-prop over <enum> ] keep
'[ swap _ word-break-next ] assoc-find 2drop
nip swap length or 1+ ; inline
HINTS: first-word string ;
nip swap length or 1+ ;
: >words ( str -- words )
[ first-word ] >pieces ;
HINTS: >words string ;

View File

@ -5,7 +5,7 @@ io.encodings.ascii kernel values splitting accessors math.parser
ascii io assocs strings math namespaces make sorting combinators
math.order arrays unicode.normalize unicode.data locals
unicode.syntax macros sequences.deep words unicode.breaks
quotations ;
quotations combinators.short-circuit ;
IN: unicode.collation
<PRIVATE
@ -71,12 +71,12 @@ ducet insert-helpers
building get empty? [ 0 ] [ building get peek peek ] if ;
: blocked? ( char -- ? )
combining-class [
last combining-class =
] [ last combining-class ] if* ;
combining-class dup { 0 f } member?
[ drop last non-starter? ]
[ last combining-class = ] if ;
: possible-bases ( -- slice-of-building )
building get dup [ first combining-class not ] find-last
building get dup [ first non-starter? not ] find-last
drop [ 0 ] unless* tail-slice ;
:: ?combine ( char slice i -- ? )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors specialized-arrays.double fry kernel locals make math
math.constants math.functions math.vectors prettyprint
USING: accessors specialized-arrays.double fry kernel locals math
math.constants math.functions math.vectors prettyprint combinators.smart
sequences hints arrays ;
IN: benchmark.nbody
@ -53,7 +53,7 @@ TUPLE: nbody-system { bodies array read-only } ;
offset-momentum drop ; inline
: <nbody-system> ( -- system )
[ <sun> , <jupiter> , <saturn> , <uranus> , <neptune> , ] { } make nbody-system boa
[ <sun> <jupiter> <saturn> <uranus> <neptune> ] output>array nbody-system boa
dup bodies>> init-bodies ; inline
:: each-pair ( bodies pair-quot: ( other-body body -- ) each-quot: ( body -- ) -- )

View File

@ -0,0 +1 @@
Jose Antonio Ortega Ruiz

View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test fuel.eval ;
IN: fuel.eval.tests

View File

@ -0,0 +1,75 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays compiler.units continuations debugger
fuel.pprint io io.streams.string kernel namespaces parser sequences
vectors vocabs.parser ;
IN: fuel.eval
TUPLE: fuel-status in use restarts ;
SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
SYMBOL: fuel-eval-result
f fuel-eval-result set-global
SYMBOL: fuel-eval-output
f fuel-eval-result set-global
SYMBOL: fuel-eval-res-flag
t fuel-eval-res-flag set-global
: fuel-eval-restartable? ( -- ? )
fuel-eval-res-flag get-global ; inline
: fuel-push-status ( -- )
in get use get clone restarts get-global clone
fuel-status boa
fuel-status-stack get push ;
: fuel-pop-restarts ( restarts -- )
fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
: fuel-pop-status ( -- )
fuel-status-stack get empty? [
fuel-status-stack get pop
[ in>> in set ]
[ use>> clone use set ]
[ restarts>> fuel-pop-restarts ] tri
] unless ;
: fuel-forget-error ( -- ) f error set-global ; inline
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
: fuel-forget-status ( -- )
fuel-forget-error fuel-forget-result fuel-forget-output ; inline
: fuel-send-retort ( -- )
error get fuel-eval-result get-global fuel-eval-output get-global
3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
: (fuel-begin-eval) ( -- )
fuel-push-status fuel-forget-status ; inline
: (fuel-end-eval) ( output -- )
fuel-eval-output set-global fuel-send-retort fuel-pop-status ; inline
: (fuel-eval) ( lines -- )
[ [ parse-lines ] with-compilation-unit call ] curry
[ print-error ] recover ; inline
: (fuel-eval-each) ( lines -- )
[ 1vector (fuel-eval) ] each ; inline
: (fuel-eval-usings) ( usings -- )
[ "USING: " prepend " ;" append ] map
(fuel-eval-each) fuel-forget-error fuel-forget-output ;
: (fuel-eval-in) ( in -- )
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
: (fuel-eval-in-context) ( lines in usings -- )
(fuel-begin-eval)
[ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
(fuel-end-eval) ;

View File

@ -1,33 +1,14 @@
! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.tuple combinators
compiler.units continuations debugger definitions help help.crossref
help.markup help.topics io io.pathnames io.streams.string kernel lexer
make math math.order memoize namespaces parser quotations prettyprint
sequences sets sorting source-files strings summary tools.crossref
tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
USING: accessors arrays assocs compiler.units definitions fuel.eval
fuel.help help.markup help.topics io.pathnames kernel math math.order
memoize namespaces parser sequences sets sorting tools.crossref
tools.scaffold tools.vocabs vocabs vocabs.loader vocabs.parser words ;
IN: fuel
! Evaluation status:
TUPLE: fuel-status in use restarts ;
SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
SYMBOL: fuel-eval-result
f fuel-eval-result set-global
SYMBOL: fuel-eval-output
f fuel-eval-result set-global
SYMBOL: fuel-eval-res-flag
t fuel-eval-res-flag set-global
: fuel-eval-restartable? ( -- ? )
fuel-eval-res-flag get-global ; inline
! Evaluation
: fuel-eval-restartable ( -- )
t fuel-eval-res-flag set-global ; inline
@ -35,154 +16,64 @@ t fuel-eval-res-flag set-global
: fuel-eval-non-restartable ( -- )
f fuel-eval-res-flag set-global ; inline
: fuel-push-status ( -- )
in get use get clone restarts get-global clone
fuel-status boa
fuel-status-stack get push ;
: fuel-pop-restarts ( restarts -- )
fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
: fuel-pop-status ( -- )
fuel-status-stack get empty? [
fuel-status-stack get pop
[ in>> in set ]
[ use>> clone use set ]
[ restarts>> fuel-pop-restarts ] tri
] unless ;
! Lispy pretty printing
GENERIC: fuel-pprint ( obj -- )
M: object fuel-pprint pprint ; inline
: fuel-maybe-scape ( ch -- seq )
dup "\\\"?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ;
M: word fuel-pprint
name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
M: f fuel-pprint drop "nil" write ; inline
M: integer fuel-pprint pprint ; inline
M: string fuel-pprint pprint ; inline
M: sequence fuel-pprint
"(" write [ " " write ] [ fuel-pprint ] interleave ")" write ; inline
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
M: quotation fuel-pprint pprint ; inline
M: continuation fuel-pprint drop ":continuation" write ; inline
M: restart fuel-pprint name>> fuel-pprint ; inline
SYMBOL: :restarts
: fuel-restarts ( obj -- seq )
compute-restarts :restarts prefix ; inline
M: condition fuel-pprint
[ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
M: lexer-error fuel-pprint
{
[ line>> ]
[ column>> ]
[ line-text>> ]
[ fuel-restarts ]
} cleave 4array lexer-error prefix fuel-pprint ;
M: source-file-error fuel-pprint
[ file>> ] [ error>> ] bi 2array source-file-error prefix
fuel-pprint ;
M: source-file fuel-pprint path>> fuel-pprint ;
! Evaluation vocabulary
: fuel-eval-in-context ( lines in usings -- )
(fuel-eval-in-context) ;
: fuel-eval-set-result ( obj -- )
clone fuel-eval-result set-global ; inline
: fuel-retort ( -- )
error get fuel-eval-result get-global fuel-eval-output get-global
3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
: fuel-forget-error ( -- ) f error set-global ; inline
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
: fuel-forget-status ( -- )
fuel-forget-error fuel-forget-result fuel-forget-output ; inline
: (fuel-begin-eval) ( -- )
fuel-push-status fuel-forget-status ; inline
: (fuel-end-eval) ( output -- )
fuel-eval-output set-global fuel-retort fuel-pop-status ; inline
: (fuel-eval) ( lines -- )
[ [ parse-lines ] with-compilation-unit call ] curry
[ print-error ] recover ; inline
: (fuel-eval-each) ( lines -- )
[ 1vector (fuel-eval) ] each ; inline
: (fuel-eval-usings) ( usings -- )
[ "USING: " prepend " ;" append ] map
(fuel-eval-each) fuel-forget-error fuel-forget-output ;
: (fuel-eval-in) ( in -- )
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
: fuel-eval-in-context ( lines in usings -- )
(fuel-begin-eval)
[ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
(fuel-end-eval) ;
: fuel-retort ( -- ) fuel-send-retort ; inline
! Loading files
<PRIVATE
SYMBOL: :uses
: fuel-set-use-hook ( -- )
[ amended-use get clone :uses prefix fuel-eval-set-result ]
print-use-hook set ;
: (fuel-get-uses) ( lines -- )
[ parse-fresh drop ] curry with-compilation-unit ; inline
PRIVATE>
: fuel-run-file ( path -- )
[ fuel-set-use-hook run-file ] curry with-scope ; inline
: fuel-with-autouse ( ... quot: ( ... -- ... ) -- ... )
[ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline
: (fuel-get-uses) ( lines -- )
[ parse-fresh drop ] curry with-compilation-unit ; inline
: fuel-get-uses ( lines -- )
[ (fuel-get-uses) ] curry fuel-with-autouse ;
! Edit locations
<PRIVATE
: fuel-normalize-loc ( seq -- path line )
[ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
[ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
: fuel-get-edit-location ( word -- )
where fuel-normalize-loc 2array fuel-eval-set-result ; inline
: fuel-get-loc ( object -- )
fuel-normalize-loc 2array fuel-eval-set-result ;
PRIVATE>
: fuel-get-edit-location ( word -- ) where fuel-get-loc ; inline
: fuel-get-vocab-location ( vocab -- )
>vocab-link fuel-get-edit-location ; inline
: fuel-get-doc-location ( word -- )
props>> "help-loc" swap at
fuel-normalize-loc 2array fuel-eval-set-result ;
: fuel-get-doc-location ( word -- ) props>> "help-loc" swap at fuel-get-loc ;
: fuel-get-article-location ( name -- )
article loc>> fuel-normalize-loc 2array fuel-eval-set-result ;
: fuel-get-article-location ( name -- ) article loc>> fuel-get-loc ;
! Cross-references
<PRIVATE
: fuel-word>xref ( word -- xref )
[ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ;
@ -192,6 +83,11 @@ SYMBOL: :uses
: fuel-format-xrefs ( seq -- seq' )
[ word? ] filter [ fuel-word>xref ] map ; inline
: (fuel-index) ( seq -- seq )
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
PRIVATE>
: fuel-callers-xref ( word -- )
usage fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
@ -204,23 +100,19 @@ SYMBOL: :uses
: fuel-vocab-xref ( vocab -- )
words fuel-format-xrefs fuel-eval-set-result ; inline
: fuel-index ( quot: ( -- seq ) -- )
call (fuel-index) fuel-eval-set-result ; inline
! Completion support
<PRIVATE
: fuel-filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter prune ; inline
: (fuel-get-vocabs) ( -- seq )
all-vocabs-seq [ vocab-name ] map ; inline
: fuel-get-vocabs ( -- )
(fuel-get-vocabs) fuel-eval-set-result ; inline
: fuel-get-vocabs/prefix ( prefix -- )
(fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
: fuel-vocab-summary ( name -- )
>vocab-link summary fuel-eval-set-result ; inline
MEMO: (fuel-vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ;
@ -234,140 +126,48 @@ MEMO: (fuel-vocab-words) ( name -- seq )
[ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
swap fuel-filter-prefix ;
PRIVATE>
: fuel-get-vocabs ( -- )
(fuel-get-vocabs) fuel-eval-set-result ;
: fuel-get-vocabs/prefix ( prefix -- )
(fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ;
: fuel-get-words ( prefix names -- )
(fuel-get-words) fuel-eval-set-result ; inline
(fuel-get-words) fuel-eval-set-result ;
! Help support
MEMO: fuel-articles-seq ( -- seq )
articles get values ;
: fuel-get-article ( name -- ) article fuel-eval-set-result ;
: fuel-find-articles ( title -- seq )
[ [ article-title ] dip = ] curry fuel-articles-seq swap filter ;
MEMO: fuel-get-article-title ( name -- )
articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;
MEMO: fuel-find-article ( title -- article/f )
fuel-find-articles dup empty? [ drop f ] [ first ] if ;
: fuel-word-help ( name -- ) (fuel-word-help) fuel-eval-set-result ;
MEMO: fuel-article-title ( name -- title/f )
articles get at [ article-title ] [ f ] if* ;
: fuel-word-see ( name -- ) (fuel-word-see) fuel-eval-set-result ;
: fuel-get-article ( name -- )
article fuel-eval-set-result ;
: fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ;
: fuel-value-str ( word -- str )
[ pprint-short ] with-string-writer ; inline
: fuel-vocab-summary ( name -- )
(fuel-vocab-summary) fuel-eval-set-result ;
: fuel-definition-str ( word -- str )
[ see ] with-string-writer ; inline
: fuel-methods-str ( word -- str )
methods dup empty? not [
[ [ see nl ] each ] with-string-writer
] [ drop f ] if ; inline
: fuel-related-words ( word -- seq )
dup "related" word-prop remove ; inline
: fuel-parent-topics ( word -- seq )
help-path [ dup article-title swap 2array ] map ; inline
: (fuel-word-help) ( word -- element )
\ article swap dup article-title swap
[
{
[ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ]
[ \ $vocabulary swap vocabulary>> 2array , ]
[ word-help % ]
[ fuel-related-words [ \ $related swap 2array , ] unless-empty ]
[ get-global [ \ $value swap fuel-value-str 2array , ] when* ]
[ \ $definition swap fuel-definition-str 2array , ]
[ fuel-methods-str [ \ $methods swap 2array , ] when* ]
} cleave
] { } make 3array ;
MEMO: fuel-find-word ( name -- word/f )
[ [ name>> ] dip = ] curry all-words swap filter
dup empty? not [ first ] [ drop f ] if ;
: fuel-word-help ( name -- )
fuel-find-word [ [ auto-use? on (fuel-word-help) ] with-scope ] [ f ] if*
fuel-eval-set-result ; inline
: (fuel-word-see) ( word -- elem )
[ name>> \ article swap ]
[ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
: fuel-word-see ( name -- )
fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
fuel-eval-set-result ; inline
: fuel-vocab-help-row ( vocab -- element )
[ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
: fuel-vocab-help-root-heading ( root -- element )
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
SYMBOL: vocab-list
: fuel-vocab-help-table ( vocabs -- element )
[ fuel-vocab-help-row ] map vocab-list prefix ;
: fuel-vocab-list ( assoc -- seq )
[
[ drop f ] [
[ fuel-vocab-help-root-heading ]
[ fuel-vocab-help-table ] bi*
[ 2array ] [ drop f ] if*
] if-empty
] { } assoc>map [ ] filter ;
: fuel-vocab-children-help ( name -- element )
all-child-vocabs fuel-vocab-list ; inline
: fuel-vocab-describe-words ( name -- element )
[ describe-words ] with-string-writer \ describe-words swap 2array ; inline
: (fuel-vocab-help) ( name -- element )
\ article swap dup >vocab-link
[
{
[ vocab-authors [ \ $authors prefix , ] when* ]
[ vocab-tags [ \ $tags prefix , ] when* ]
[ summary [ { $heading "Summary" } swap 2array , ] when* ]
[ drop \ $nl , ]
[ vocab-help [ article content>> % ] when* ]
[ name>> fuel-vocab-describe-words , ]
[ name>> fuel-vocab-children-help % ]
} cleave
] { } make 3array ;
: fuel-vocab-help ( name -- )
dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
fuel-eval-set-result ; inline
: (fuel-index) ( seq -- seq )
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
: fuel-index ( quot: ( -- seq ) -- )
call (fuel-index) fuel-eval-set-result ; inline
MEMO: (fuel-get-vocabs/author) ( author -- element )
[ "Vocabularies by " prepend \ $heading swap 2array ]
[ authored fuel-vocab-list ] bi 2array ;
: fuel-get-vocabs/tag ( tag -- )
(fuel-get-vocabs/tag) fuel-eval-set-result ;
: fuel-get-vocabs/author ( author -- )
(fuel-get-vocabs/author) fuel-eval-set-result ;
MEMO: (fuel-get-vocabs/tag ( tag -- element )
[ "Vocabularies tagged " prepend \ $heading swap 2array ]
[ tagged fuel-vocab-list ] bi 2array ;
! Scaffold support
: fuel-get-vocabs/tag ( tag -- )
(fuel-get-vocabs/tag fuel-eval-set-result ;
: fuel-scaffold-vocab ( root name devname -- )
developer-name set dup [ scaffold-vocab ] dip
dup require vocab-source-path (normalize-path) fuel-eval-set-result ;
: fuel-scaffold-help ( name devname -- )
developer-name set
dup require dup scaffold-help vocab-docs-path
(normalize-path) fuel-eval-set-result ;
! -run=fuel support
: fuel-startup ( -- ) "listener" run-file ; inline
MAIN: fuel-startup
: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;

View File

@ -0,0 +1 @@
Jose Antonio Ortega Ruiz

View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test fuel.help ;
IN: fuel.help.tests

108
extra/fuel/help/help.factor Normal file
View File

@ -0,0 +1,108 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators help help.crossref
help.markup help.topics io io.streams.string kernel make memoize
namespaces parser prettyprint sequences summary tools.vocabs
tools.vocabs.browser vocabs vocabs.loader words ;
IN: fuel.help
<PRIVATE
MEMO: fuel-find-word ( name -- word/f )
[ [ name>> ] dip = ] curry all-words swap filter
dup empty? not [ first ] [ drop f ] if ;
: fuel-value-str ( word -- str )
[ pprint-short ] with-string-writer ; inline
: fuel-definition-str ( word -- str )
[ see ] with-string-writer ; inline
: fuel-methods-str ( word -- str )
methods dup empty? not [
[ [ see nl ] each ] with-string-writer
] [ drop f ] if ; inline
: fuel-related-words ( word -- seq )
dup "related" word-prop remove ; inline
: fuel-parent-topics ( word -- seq )
help-path [ dup article-title swap 2array ] map ; inline
: (fuel-word-element) ( word -- element )
\ article swap dup article-title swap
[
{
[ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ]
[ \ $vocabulary swap vocabulary>> 2array , ]
[ word-help % ]
[ fuel-related-words [ \ $related swap 2array , ] unless-empty ]
[ get-global [ \ $value swap fuel-value-str 2array , ] when* ]
[ \ $definition swap fuel-definition-str 2array , ]
[ fuel-methods-str [ \ $methods swap 2array , ] when* ]
} cleave
] { } make 3array ;
: fuel-vocab-help-row ( vocab -- element )
[ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
: fuel-vocab-help-root-heading ( root -- element )
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
SYMBOL: vocab-list
: fuel-vocab-help-table ( vocabs -- element )
[ fuel-vocab-help-row ] map vocab-list prefix ;
: fuel-vocab-list ( assoc -- seq )
[
[ drop f ] [
[ fuel-vocab-help-root-heading ]
[ fuel-vocab-help-table ] bi*
[ 2array ] [ drop f ] if*
] if-empty
] { } assoc>map [ ] filter ;
: fuel-vocab-children-help ( name -- element )
all-child-vocabs fuel-vocab-list ; inline
: fuel-vocab-describe-words ( name -- element )
[ describe-words ] with-string-writer \ describe-words swap 2array ; inline
: (fuel-vocab-element) ( name -- element )
dup require \ article swap dup >vocab-link
[
{
[ vocab-authors [ \ $authors prefix , ] when* ]
[ vocab-tags [ \ $tags prefix , ] when* ]
[ summary [ { $heading "Summary" } swap 2array , ] when* ]
[ drop \ $nl , ]
[ vocab-help [ article content>> % ] when* ]
[ name>> fuel-vocab-describe-words , ]
[ name>> fuel-vocab-children-help % ]
} cleave
] { } make 3array ;
PRIVATE>
: (fuel-word-help) ( object -- object )
fuel-find-word [ [ auto-use? on (fuel-word-element) ] with-scope ] [ f ] if* ;
: (fuel-word-see) ( word -- elem )
[ name>> \ article swap ]
[ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
: (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline
: (fuel-vocab-help) ( name -- str )
dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-element) ] if ;
MEMO: (fuel-get-vocabs/author) ( author -- element )
[ "Vocabularies by " prepend \ $heading swap 2array ]
[ authored fuel-vocab-list ] bi 2array ;
MEMO: (fuel-get-vocabs/tag) ( tag -- element )
[ "Vocabularies tagged " prepend \ $heading swap 2array ]
[ tagged fuel-vocab-list ] bi 2array ;

View File

@ -0,0 +1 @@
Jose Antonio Ortega Ruiz

View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test fuel.pprint ;
IN: fuel.pprint.tests

View File

@ -0,0 +1,63 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays classes.tuple combinators continuations io
kernel lexer math prettyprint quotations sequences source-files
strings words ;
IN: fuel.pprint
GENERIC: fuel-pprint ( obj -- )
<PRIVATE
: fuel-maybe-scape ( ch -- seq )
dup "\\\"?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ;
SYMBOL: :restarts
: fuel-restarts ( obj -- seq )
compute-restarts :restarts prefix ; inline
: fuel-pprint-sequence ( seq open close -- )
[ write ] dip swap [ " " write ] [ fuel-pprint ] interleave write ; inline
PRIVATE>
M: object fuel-pprint pprint ; inline
M: word fuel-pprint
name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
M: f fuel-pprint drop "nil" write ; inline
M: integer fuel-pprint pprint ; inline
M: string fuel-pprint pprint ; inline
M: sequence fuel-pprint "(" ")" fuel-pprint-sequence ; inline
M: quotation fuel-pprint "[" "]" fuel-pprint-sequence ; inline
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
M: continuation fuel-pprint drop ":continuation" write ; inline
M: restart fuel-pprint name>> fuel-pprint ; inline
M: condition fuel-pprint
[ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
M: lexer-error fuel-pprint
{
[ line>> ]
[ column>> ]
[ line-text>> ]
[ fuel-restarts ]
} cleave 4array lexer-error prefix fuel-pprint ;
M: source-file-error fuel-pprint
[ file>> ] [ error>> ] bi 2array source-file-error prefix
fuel-pprint ;
M: source-file fuel-pprint path>> fuel-pprint ;

View File

@ -32,6 +32,7 @@ beast.
(require 'factor-mode)
* Basic usage
*** Running the listener
If you're using the default factor binary and images locations inside
the Factor's source tree, that should be enough to start using FUEL.
@ -43,6 +44,26 @@ beast.
Many aspects of the environment can be customized:
M-x customize-group fuel will show you how many.
*** Faster listener startup
On startup, run-factor loads the fuel vocabulary, which can take a
while. If you want to speedup the load process, type 'save' in the
listener prompt just after invoking run-factor. This will save a
factor image (overwriting the current one) with all the needed
vocabs.
*** Vocabulary creation
FUEL offers a basic interface with Factor's scaffolding utilities.
To create a new vocabulary directory and associated files:
M-x fuel-scaffold-vocab
and when in a vocab file, to create a docs file with boilerplate
for each word:
M-x fuel-scaffold-help
* Quick key reference
(Triple chords ending in a single letter <x> accept also C-<x> (e.g.
@ -77,6 +98,7 @@ beast.
- C-cC-xs : extract innermost sexp (up to point) as a separate word
- C-cC-xr : extract region as a separate word
- C-cC-xv : extract region as a separate vocabulary
*** In the listener:

View File

@ -111,7 +111,7 @@ code in the buffer."
(= (- be (point)) (current-indentation))
(= ln (line-number-at-pos be)))
(fuel-syntax--indentation-at bs))
((or (fuel-syntax--is-eol bs)
((or (fuel-syntax--is-last-char bs)
(not (eq ?\ (char-after (1+ bs)))))
(fuel-syntax--increased-indentation
(fuel-syntax--indentation-at bs)))
@ -238,15 +238,17 @@ code in the buffer."
;;; Keymap:
(defun factor-mode-insert-and-indent (n)
(interactive "p")
(self-insert-command n)
(defun factor-mode--insert-and-indent (n)
(interactive "*p")
(let ((start (point)))
(self-insert-command n)
(save-excursion (font-lock-fontify-region start (point))))
(indent-according-to-mode))
(defvar factor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\]] 'factor-mode-insert-and-indent)
(define-key map [?}] 'factor-mode-insert-and-indent)
(define-key map [?\]] 'factor-mode--insert-and-indent)
(define-key map [?}] 'factor-mode--insert-and-indent)
(define-key map "\C-m" 'newline-and-indent)
(define-key map "\C-co" 'factor-mode-visit-other-file)
(define-key map "\C-c\C-o" 'factor-mode-visit-other-file)

View File

@ -1,6 +1,6 @@
;;; fu.el --- Startup file for FUEL
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -24,6 +24,11 @@
"Minor mode showing in the minibuffer a synopsis of Factor word at point."
t)
(autoload 'fuel-scaffold-vocab "fuel-scaffold.el"
"Create a new Factor vocabulary." t)
(autoload 'fuel-scaffold-help "fuel-scaffold.el"
"Create a Factor vocabulary help file." t)
;;; fu.el ends here

View File

@ -1,6 +1,6 @@
;;; fuel-base.el --- Basic FUEL support code
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>

View File

@ -160,7 +160,7 @@
(fuel-con--send-string/wait buffer
fuel-con--init-stanza
'fuel-con--establish-connection-cont
20000)
60000)
conn))
(defun fuel-con--establish-connection-cont (ignore)

View File

@ -1,6 +1,6 @@
;;; fuel-debug-uses.el -- retrieving USING: stanzas
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@ -32,6 +32,9 @@
;;; Utility functions:
(defsubst fuel-debug--chomp (s)
(replace-regexp-in-string "[\n\r\f]" "" s))
(defun fuel-debug--file-lines (file)
(when (file-readable-p file)
(with-current-buffer (find-file-noselect file)
@ -40,7 +43,8 @@
(let ((lines) (in-usings))
(while (not (eobp))
(when (looking-at "^USING: ") (setq in-usings t))
(let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
(let ((line (fuel-debug--chomp
(substring-no-properties (thing-at-point 'line)))))
(when in-usings (setq line (concat "! " line)))
(push line lines))
(when (and in-usings (looking-at ".*\\_<;\\_>")) (setq in-usings nil))

View File

@ -42,7 +42,7 @@
(factor (case sexp
(:rs 'fuel-eval-restartable)
(:nrs 'fuel-eval-non-restartable)
(:in (fuel-syntax--current-vocab))
(:in (or (fuel-syntax--current-vocab) "fuel"))
(:usings `(:array ,@(fuel-syntax--usings)))
(:get 'fuel-eval-set-result)
(:end '\;)
@ -70,7 +70,7 @@
(defsubst factor--fuel-in (in)
(cond ((or (eq in :in) (null in)) :in)
((eq in 'f) 'f)
((eq in 't) "fuel-scratchpad")
((eq in 't) "fuel")
((stringp in) in)
(t (error "Invalid 'in' (%s)" in))))

View File

@ -55,6 +55,8 @@
((comment comment "comments")
(constructor type "constructors (<foo>)")
(constant constant "constants and literal values")
(number constant "integers and floats")
(ratio constant "ratios")
(declaration keyword "declaration words")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
@ -80,7 +82,9 @@
(,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word)
(2 'factor-font-lock-word))
(,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant)
(,fuel-syntax--number-regex . 'factor-font-lock-constant)
(,fuel-syntax--integer-regex . 'factor-font-lock-number)
(,fuel-syntax--float-regex . 'factor-font-lock-number)
(,fuel-syntax--ratio-regex . 'factor-font-lock-ratio)
(,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
(,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
@ -103,7 +107,6 @@
(list (cons 'font-lock-syntactic-keywords
fuel-syntax--syntactic-keywords))))))
;;; Fontify strings as Factor code:

View File

@ -73,7 +73,7 @@ buffer."
(error "Could not run factor: %s is not executable" factor))
(unless (file-readable-p image)
(error "Could not run factor: image file %s not readable" image))
(message "Starting FUEL listener ...")
(message "Starting FUEL listener (this may take a while) ...")
(pop-to-buffer (fuel-listener--buffer))
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
"-run=listener" (format "-i=%s" image))
@ -102,6 +102,8 @@ buffer."
(defun fuel-listener-nuke ()
(interactive)
(goto-char (point-max))
(comint-kill-region comint-last-input-start (point))
(comint-redirect-cleanup)
(fuel-con--setup-connection fuel-listener--buffer))

View File

@ -71,7 +71,7 @@
(defun fuel-markup--article-title (name)
(fuel-eval--retort-result
(fuel-eval--send/wait `(:fuel* ((,name fuel-article-title :get)) "fuel"))))
(fuel-eval--send/wait `(:fuel* ((,name fuel-get-article-title)) "fuel"))))
(defun fuel-markup--link-at-point ()
(let ((button (condition-case nil (forward-button 0) (error nil))))
@ -373,10 +373,10 @@
(let ((heading `($heading ,(match-string-no-properties 0)))
(rows))
(forward-line)
(when (looking-at "Word *Stack effect$")
(push '("Word" "Stack effect") rows)
(when (looking-at "Word *\\(Stack effect\\|Syntax\\)$")
(push (list "Word" (match-string-no-properties 1)) rows)
(forward-line))
(while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$")
(while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$")
(let ((word `($link ,(match-string-no-properties 1)
,(match-string-no-properties 1)
word))

View File

@ -196,6 +196,7 @@ interacting with a factor listener is at your disposal.
(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp)
(fuel-mode--key ?x ?r 'fuel-refactor-extract-region)
(fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab)
(fuel-mode--key ?d ?> 'fuel-show-callees)
(fuel-mode--key ?d ?< 'fuel-show-callers)

View File

@ -13,6 +13,7 @@
;;; Code:
(require 'fuel-scaffold)
(require 'fuel-stack)
(require 'fuel-syntax)
(require 'fuel-base)
@ -70,7 +71,46 @@ word."
(if (looking-at-p ";") (point)
(fuel-syntax--end-of-symbol-pos))))
;;; Extract vocab:
(defun fuel-refactor--insert-using (vocab)
(save-excursion
(goto-char (point-min))
(let ((usings (sort (cons vocab (fuel-syntax--usings)) 'string<)))
(fuel-debug--replace-usings (buffer-file-name) usings))))
(defun fuel-refactor--vocab-root (vocab)
(let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(defun fuel-refactor--extract-vocab (begin end)
(when (< begin end)
(let* ((str (buffer-substring begin end))
(buffer (current-buffer))
(vocab (fuel-syntax--current-vocab))
(vocab-hint (and vocab (format "%s." vocab)))
(root-hint (fuel-refactor--vocab-root vocab))
(vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
(with-current-buffer buffer
(delete-region begin end)
(fuel-refactor--insert-using vocab))
(newline)
(insert str)
(newline)
(save-buffer)
(fuel-update-usings))))
(defun fuel-refactor-extract-vocab (begin end)
"Creates a new vocab with the words in current region.
The region is extended to the closest definition boundaries."
(interactive "r")
(fuel-refactor--extract-vocab (save-excursion (goto-char begin)
(mark-defun)
(point))
(save-excursion (goto-char end)
(mark-defun)
(mark))))
(provide 'fuel-refactor)
;;; fuel-refactor.el ends here

View File

@ -0,0 +1,85 @@
;;; fuel-scaffold.el -- interaction with tools.scaffold
;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages, fuel, factor
;; Start date: Sun Jan 11, 2009 18:40
;;; Comentary:
;; Utilities for creating new vocabulary files and other boilerplate.
;; Mainly, an interface to Factor's tools.scaffold.
;;; Code:
(require 'fuel-eval)
(require 'fuel-edit)
(require 'fuel-syntax)
(require 'fuel-base)
;;; Customisation:
(defgroup fuel-scaffold nil
"Options for FUEL's scaffolding."
:group 'fuel)
(defcustom fuel-scaffold-developer-name user-full-name
"The name to be inserted as yours in scaffold templates."
:type 'string
:group 'fuel-scaffold)
;;; Auxiliary functions:
(defun fuel-scaffold--vocab-roots ()
(let ((cmd '(:fuel* (vocab-roots get :get) "fuel")))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
;;; User interface:
(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
"Creates a directory in the given root for a new vocabulary and
adds source, tests and authors.txt files.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated files."
(interactive)
(let* ((name (read-string "Vocab name: " name-hint))
(root (completing-read "Vocab root: "
(fuel-scaffold--vocab-roots)
nil t (or root-hint "resource:")))
(cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
(fuel-scaffold-vocab)) "fuel"))
(ret (fuel-eval--send/wait cmd))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
(if other-window (find-file-other-window file) (find-file file))
(goto-char (point-max))
name))
(defun fuel-scaffold-help (&optional arg)
"Creates, if it does not already exist, a help file with
scaffolded help for each word in the current vocabulary.
With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
(interactive "P")
(let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
(fuel-edit--read-vocabulary-name nil)))
(cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help)
"fuel"))
(ret (fuel-eval--send/wait cmd))
(file (fuel-eval--retort-result ret)))
(unless file
(error "Error creating help file" (car (fuel-eval--retort-error ret))))
(find-file file)))
(provide 'fuel-scaffold)
;;; fuel-scaffold.el ends here

View File

@ -44,14 +44,14 @@
(defconst fuel-syntax--parsing-words
'(":" "::" ";" "<<" "<PRIVATE" ">>"
"ALIAS:"
"ABOUT:" "ALIAS:" "ARTICLE:"
"B" "BIN:"
"C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
"DEFER:"
"ERROR:" "EXCLUDE:"
"f" "FORGET:" "FROM:"
"GENERIC#" "GENERIC:"
"HEX:" "HOOK:"
"HELP:" "HEX:" "HOOK:"
"IN:" "initial:" "INSTANCE:" "INTERSECTION:"
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
"OCT:"
@ -63,12 +63,12 @@
"UNION:" "USE:" "USING:"
"VARS:"))
(defconst fuel-syntax--bracers
'("B" "BV" "C" "CS" "H" "T" "V" "W"))
(defconst fuel-syntax--parsing-words-regex
(regexp-opt fuel-syntax--parsing-words 'words))
(defconst fuel-syntax--bracers
'("B" "BV" "C" "CS" "H" "T" "V" "W"))
(defconst fuel-syntax--brace-words-regex
(format "%s{" (regexp-opt fuel-syntax--bracers t)))
@ -84,8 +84,14 @@
(defconst fuel-syntax--method-definition-regex
"^M: +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--number-regex
"\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?")
(defconst fuel-syntax--integer-regex
"\\_<-?[0-9]+\\_>")
(defconst fuel-syntax--ratio-regex
"\\_<-?\\([0-9]+\\+\\)?[0-9]+/-?[0-9]+\\_>")
(defconst fuel-syntax--float-regex
"\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>")
(defconst fuel-syntax--word-definition-regex
(fuel-syntax--second-word-regex
@ -142,12 +148,14 @@
fuel-syntax--declaration-words-regex))
(defconst fuel-syntax--single-liner-regex
(format "^%s" (regexp-opt '("ALIAS:"
(format "^%s" (regexp-opt '("ABOUT:"
"ARTICLE:"
"ALIAS:"
"CONSTANT:" "C:"
"DEFER:"
"FORGET:"
"GENERIC:" "GENERIC#"
"HEX:" "HOOK:"
"HELP:" "HEX:" "HOOK:"
"IN:" "INSTANCE:"
"MAIN:" "MATH:" "MIXIN:"
"OCT:"
@ -210,8 +218,7 @@
(" \\(|\\) " (1 "(|"))
(" \\(|\\)$" (1 ")"))
;; Opening brace words:
(,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}"))
("\\_<\\({\\)\\_>" (1 "(}"))
("\\_<\\w*\\({\\)\\_>" (1 "(}"))
("\\_<\\(}\\)\\_>" (1 "){"))
;; Parenthesis:
("\\_<\\((\\)\\_>" (1 "()"))
@ -255,7 +262,7 @@
(defsubst fuel-syntax--looking-at-emptiness ()
(looking-at "^[ ]*$\\|$"))
(defsubst fuel-syntax--is-eol (pos)
(defsubst fuel-syntax--is-last-char (pos)
(save-excursion
(goto-char (1+ pos))
(fuel-syntax--looking-at-emptiness)))