steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

help system and tutorial improvements

cvs
Slava Pestov 2005-12-29 01:25:17 +00:00
parent 29be58d449
commit 0771037b15
31 changed files with 274 additions and 238 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -1,8 +1,6 @@
- if cell is rebound, and we allocate c objects, bang
- make-image leaks memory if there is an error while parsing files
- runtime primitives like fopen: check for null input
- make = for sequences more efficient
- does parsing cons excessive amounts of bignums with c-streams
- -with combinators are awkward
- cleanups:
alien/compiler

6
library/bootstrap/boot-stage1.factor
View File

@ -190,11 +190,13 @@ vectors words ;
"/library/help/database.factor"
"/library/help/stylesheet.factor"
"/library/help/markup.factor"
"/library/help/help.factor"
"/library/help/tutorial.factor"
"/library/help/markup.factor"
"/library/help/commands.factor"
"/library/help/syntax.factor"
"/library/help/tutorial.factor"
"/library/syntax/parse-syntax.factor"
"/library/bootstrap/image.factor"

3
library/cli.factor
View File

@ -18,7 +18,8 @@ parser sequences strings ;
: set-path ( value seq -- )
unswons over [ nest [ set-path ] bind ] [ nip set ] if ;
: cli-var-param ( name value -- ) swap ":" split set-path ;
: cli-var-param ( name value -- )
swap ":" split >list set-path ;
: cli-bool-param ( name -- ) "no-" ?head not cli-var-param ;

30
library/collections/sequence-combinators.factor
View File

@ -3,6 +3,14 @@
IN: sequences-internals
USING: arrays generic kernel kernel-internals math vectors ;
: collect ( n generator -- vector | quot: n -- value )
#! Primitive mapping out of an integer sequence into an
#! array. Used by map and 2map. Don't call, use map
#! instead.
>r [ f <array> ] keep r> swap [
[ rot >r [ swap call ] keep r> set-array-nth ] 3keep
] repeat drop ; inline
: (map) ( quot seq i -- quot seq value )
pick pick >r >r swap nth-unsafe swap call r> r> rot ; inline
@ -17,6 +25,13 @@ USING: arrays generic kernel kernel-internals math vectors ;
2dup 1+ swap nth-unsafe >r swap nth-unsafe r> rot call ;
inline
: (interleave) ( n -- array )
dup 0 = [
drop { }
] [
t <array> f 0 pick set-nth-unsafe
] if ;
IN: sequences
G: each ( seq quot -- | quot: elt -- )
@ -39,14 +54,6 @@ G: find ( seq quot -- i elt | quot: elt -- ? )
: find-with ( obj seq quot -- i elt | quot: elt -- ? )
swap [ with rot ] find 2swap 2drop ; inline
: collect ( n generator -- vector | quot: n -- value )
#! Primitive mapping out of an integer sequence into an
#! array. Used by map and 2map. Don't call, use map
#! instead.
>r [ f <array> ] keep r> swap [
[ rot >r [ swap call ] keep r> set-array-nth ] 3keep
] repeat drop ; inline
G: map [ over ] standard-combination ; inline
M: object map ( seq quot -- seq )
@ -159,6 +166,13 @@ M: object find ( seq quot -- i elt )
pick pick >r >r (monotonic) r> r> rot
] all? 2nip ; inline
: interleave ( seq quot between -- )
rot dup length (interleave) [
[ -rot [ -rot 2slip call ] 2keep ]
[ -rot [ drop call ] 2keep ]
if
] 2each 2drop ; inline
: cache-nth ( i seq quot -- elt | quot: i -- elt )
pick pick ?nth dup [
>r 3drop r>

4
library/collections/sequences-epilogue.factor
View File

@ -192,3 +192,7 @@ IN: kernel
: with-datastack ( stack word -- stack )
datastack >r >r set-datastack r> execute
datastack r> [ push ] keep set-datastack 2nip ;
: win32? ( -- ? ) os "win32" = ;
: unix? ( -- ? ) os { "freebsd" "linux" "macosx" } member? ;

2
library/collections/slicing.factor
View File

@ -94,7 +94,7 @@ M: object tail ( index seq -- seq ) [ tail-slice ] keep like ;
: (split) ( seq subseq -- )
tuck (split1) >r , r> dup [ swap (split) ] [ 2drop ] if ;
: split ( seq subseq -- seq ) [ (split) ] [ ] make ; flushable
: split ( seq subseq -- seq ) [ (split) ] { } make ; flushable
: (cut) ( n seq -- before after )
[ head ] 2keep tail-slice ; flushable

6
library/help/commands.factor Normal file
View File

@ -0,0 +1,6 @@
IN: help
USING: gadgets-listener gadgets-presentations words ;
"Show word" [ word? ] [ help ] \ in-browser define-default-command
"Show term definition" [ term? ] [ help ] \ in-browser define-default-command
"Show article" [ link? ] [ help ] \ in-browser define-default-command

25
library/help/database.factor
View File

@ -22,12 +22,24 @@ M: string article-title article article-title ;
M: string article-content article article-content ;
! Word help
M: word article-title "The " swap word-name " word" append3 ;
M: word article-title word-name ;
DEFER: $synopsis
M: word article-content
dup "help" word-prop [ ] [
"No documentation found for " swap word-name append
] ?if ;
[
dup "help" word-prop [
\ $synopsis pick 2array , %
] [
"Undocumented." ,
] if*
\ $definition swap 2array ,
] { } make ;
! Special case: f help
M: f article-title drop \ f word-name ;
M: f article-content drop \ f article-content ;
! Glossary of terms
SYMBOL: terms
@ -41,8 +53,3 @@ M: term article-content
[ "No such glossary entry" ] unless* ;
: add-term ( term element -- ) swap terms get set-hash ;
! Missing topics
M: f article-title drop "No such topic" ;
M: f article-content drop "No such topic" ;

15
library/help/help.factor
View File

@ -2,15 +2,14 @@ IN: help
USING: arrays gadgets-listener gadgets-presentations hashtables
io kernel namespaces parser sequences words ;
: help ( topic -- )
: (help) ( topic -- )
default-style [
dup article-title $heading
article-content print-element
terpri*
article-content print-element terpri*
] with-style ;
: glossary ( name -- ) <term> help ;
DEFER: $heading
"Show word documentation" [ word? ] [ help ] \ in-browser define-command
"Show term definition" [ term? ] [ help ] \ in-browser define-default-command
"Show article" [ link? ] [ help ] \ in-browser define-default-command
: help ( topic -- )
dup article-title $heading (help) ;
: glossary ( name -- ) <term> help ;

71
library/help/markup.factor
View File

@ -5,6 +5,10 @@ USING: arrays gadgets gadgets-panes gadgets-presentations
hashtables inspector io kernel lists namespaces prettyprint
sequences strings styles words ;
: uncons* dup first swap 1 swap tail ;
: unswons* uncons* swap ;
! Simple markup language.
! <element> ::== <string> | <simple-element> | <fancy-element>
@ -16,11 +20,18 @@ sequences strings styles words ;
PREDICATE: array simple-element
dup empty? [ drop t ] [ first word? not ] if ;
: write-term ( string -- )
dup terms get hash [
dup <term> presented associate [ format* ] with-style
] [
format*
] if ;
M: string print-element
" " split [ format* bl ] each ;
" " split [ write-term ] [ bl ] interleave ;
M: array print-element
dup first >r 1 swap tail r> execute ;
unswons* execute ;
: ($span) ( content style -- )
[ print-element ] with-style ;
@ -30,16 +41,13 @@ M: array print-element
[ [ print-element ] with-nesting* ] with-style
terpri* ;
: $see ( content -- )
code-style [ [ first see ] with-nesting* ] with-style ;
! Some spans
: $heading heading-style ($block) ;
: $subheading subheading-style ($block) ;
: $parameter parameter-style ($span) ;
: $snippet snippet-style ($span) ;
: $emphasis emphasis-style ($span) ;
@ -51,11 +59,56 @@ M: array print-element
M: simple-element print-element
current-style [ [ print-element ] each ] with-nesting ;
: $code
: ($code) ( text presentation -- )
terpri*
first code-style [ [ format* ] with-nesting* ] with-style
code-style [
current-style swap presented pick set-hash
[ format* ] with-nesting
] with-style
terpri* ;
: $code ( content -- )
first dup <input> ($code) ;
: $example ( content -- )
terpri*
code-style [
current-style over <input> presented pick set-hash
[ . ] with-nesting
] with-style
terpri* ;
: $synopsis ( content -- )
"Synopsis" $subheading first [ synopsis ] keep ($code) ;
: $values ( content -- )
"Arguments and values" $subheading [
unswons* $emphasis " -- " format* print-element terpri*
] each ;
: $description ( content -- )
"Description" $subheading print-element ;
: $examples ( content -- )
"Examples" $subheading [ $example ] each ;
: $see-also ( content -- )
"See also" $subheading [ pprint bl ] each ;
: $see ( content -- )
code-style [ [ first see ] with-nesting* ] with-style ;
: $definition ( content -- )
"Definition" $heading $see ;
: $predicate ( content -- )
{ { "object" "an object" } } $values
"Tests if the top of the stack is a " swap first "." append3
1array $description ;
: $list ( content -- )
terpri* [ "- " format* print-element terpri* ] each ;
! Some links
TUPLE: link name ;
@ -73,7 +126,7 @@ DEFER: help
: $subsection ( object -- )
terpri*
subheading-style [
first <link> ($link) dup [ link-name help ] curry
first <link> ($link) dup [ link-name (help) ] curry
simple-outliner
] with-style ;

11
library/help/stylesheet.factor
View File

@ -11,21 +11,20 @@ USING: styles ;
: emphasis-style
H{ { font-style italic } } ;
: heading-style H{ { font "Serif" } { font-size 24 } } ;
: heading-style H{ { font "Serif" } { font-size 18 } } ;
: subheading-style H{ { font "Serif" } { font-size 18 } } ;
: subheading-style H{ { font "Serif" } { font-style bold } } ;
: parameter-style
: snippet-style
H{
{ font "Monospaced" }
{ font-style italic }
{ foreground { 0.1 0.1 0.1 1 } }
} ;
: code-style
H{
{ font "Monospaced" }
{ page-color { 0.9 0.9 0.9 1 } }
{ border-color { 0.95 0.95 0.95 1 } }
{ page-color { 0.9 0.9 0.9 0.5 } }
{ border-width 5 }
{ wrap-margin f }
} ;

5
library/help/syntax.factor
View File

@ -2,7 +2,10 @@ IN: !syntax
USING: arrays help kernel parser sequences syntax words ;
: HELP:
scan-word [ >array "help" set-word-prop ] [ ] ; parsing
scan-word dup [
>array uncons* >r "stack-effect" set-word-prop r>
"help" set-word-prop
] [ ] ; parsing
: ARTICLE:
[ >array [ first2 2 ] keep tail add-article ] [ ] ; parsing

143
library/help/tutorial.factor
View File

@ -2,64 +2,71 @@ IN: help
USING: io ;
ARTICLE: "tutorial-overview" "The view from 10,000 feet"
"- Everything is an object"
"- A word is a basic unit of code"
"- Words are identified by names, and organized in vocabularies"
"- Words pass parameters on the stack"
"- Code blocks can be passed as parameters to words"
"- Word definitions are very short with very high code reuse" ;
{ $list
"Everything is an object"
"A word is a basic unit of code"
"Words are identified by names, and organized in vocabularies"
"Words pass parameters on the stack"
"Code blocks can be passed as parameters to words"
"Word definitions are very short with very high code reuse"
} ;
ARTICLE: "tutorial-syntax" "Basic syntax"
"Factor code is made up of whitespace-speparated tokens. Recall the example from the first slide:"
"Factor code is made up of whitespace-separated tokens. Recall the example from the first page:"
{ $code "\"hello world\" print" }
"The first token (\"hello world\") is a string."
"The second token (print) is a word."
"The string is pushed on the stack, and the print word prints it." ;
{ $list
{ "The first token (" { $snippet "\"hello world\"" } ") is a string." }
{ "The second token (" { $snippet "print" } ") is a word." }
"The string is pushed on the stack, and the print word prints it."
} ;
ARTICLE: "tutorial-stack" "The stack"
"- The stack is like a pile of papers."
"- You can ``push'' papers on the top of the pile,"
" and ``pop'' papers from the top of the pile."
"Here is another code example:"
"The stack is like a pile of papers. You can ``push'' papers on the top of the pile and ``pop'' papers from the top of the pile. Here is another code example:"
{ $code "2 3 + ." }
"Try running it in the listener now." ;
ARTICLE: "tutorial-postfix" "Postfix arithmetic"
"What happened when you ran it? The two numbers (2 3) are pushed on the stack. Then, the + word pops them and pushes the result (5). Then, the . word prints this result."
"This is called postfix arithmetic."
"Traditional arithmetic is called infix: 3 + (6 * 2)"
"Lets translate this into postfix: 3 6 2 * + ." ;
{ $list
"This is called postfix arithmetic."
{ "Traditional arithmetic is called infix: " { $snippet "3 + (6 * 2)" } }
{ "Lets translate this into postfix: " { $snippet "3 6 2 * + ." } }
} ;
ARTICLE: "tutorial-colon-def" "Colon definitions"
"We can define new words in terms of existing words."
{ $code ": twice 2 * ;" }
"This defines a new word named ``twice'' that calls ``2 *''. Try the following in the listener:"
"This defines a new word named " { $snippet "twice" } " that calls " { $snippet "2 *" } ". Try the following in the listener:"
{ $code "3 twice twice ." }
"The result is the same as if you wrote:"
{ $code "3 2 * 2 * ." } ;
ARTICLE: "tutorial-stack-effects" "Stack effects"
"When we look at the definition of the ``twice'' word, it is intuitively obvious that it takes one value from the stack, and leaves one value behind. However, with more complex definitions, it is better to document this so-called ``stack effect''."
"A stack effect comment is written between ( and ). Factor ignores stack effect comments. Don't you!"
"The stack effect of twice is ( x -- 2*x )."
"The stack effect of + is ( x y -- x+y )."
"The stack effect of . is ( object -- )." ;
"When we look at the definition of the " { $snippet "twice" } " word, it is intuitively obvious that it takes one value from the stack, and leaves one value behind. However, with more complex definitions, it is better to document this so-called " { $emphasis "stack effect" } ". A stack effect comment is written between ( and ). Factor ignores stack effect comments. Don't you!"
{ $terpri }
"The stack effect of " { $snippet "twice" } " is " { $snippet "( x -- 2*x )" } "."
{ $terpri }
"The stack effect of " { $snippet "+" } " is " { $snippet "( x y -- x+y )" } "."
{ $terpri }
"The stack effect of " { $snippet "." } " is " { $snippet "( object -- )" } "." ;
ARTICLE: "tutorial-input" "Reading user input"
"User input is read using the readln ( -- string ) word. Note its stack effect; it puts a string on the stack."
"User input is read using the " { $snippet "readln ( -- string )" } " word. Note its stack effect; it puts a string on the stack."
"This program will ask your name, then greet you:"
{ $code "\"What is your name?\" print\nreadln \"Hello, \" write print" } ;
ARTICLE: "tutorial-shuffle" "Shuffle words"
"The word ``twice'' we defined is useless. Let's try something more useful: squaring a number."
"We want a word with stack effect ( n -- n*n ). We cannot use * by itself, since its stack effect is ( x y -- x*y ); it expects two inputs."
"However, we can use the word ``dup''. It has stack effect ( object -- object object ), and it does exactly what we need. The ``dup'' word is known as a shuffle word." ;
"The word " { $snippet "twice" } " we defined is useless. Let's try something more useful: squaring a number."
{ $terpri }
"We want a word with stack effect " { $snippet "( n -- n*n )" } ". We cannot use " { $snippet "*" } " by itself, since its stack effect is " { $snippet "( x y -- x*y )" } "; it expects two inputs."
{ $terpri }
"However, we can use the word " { $snippet "dup ( object -- object object )" } ". The " { $snippet "dup" } " word is known as a shuffle word." ;
ARTICLE: "tutorial-squared" "The squared word"
"Try entering the following word definition:"
{ $code ": square ( n -- n*n ) dup * ;" }
"Shuffle words solve the problem where we need to compose two words, but their stack effects do not ``fit''."
{ $terpri }
"Some of the most commonly-used shuffle words:"
{ $code "drop ( object -- )\nswap ( obj1 obj2 -- obj2 obj1 )\nover ( obj1 obj2 -- obj1 obj2 obj1 )" } ;
@ -69,90 +76,102 @@ ARTICLE: "tutorial-shuffle-again" "Another shuffle example"
{ $code "0 10 - ." }
"It will print -10, as expected. Now notice that this the same as:"
{ $code "10 0 swap - ." }
"So indeed, we can factor out the definition ``0 swap -'':"
"So indeed, we can factor out the definition " { $snippet "0 swap -" } ":"
{ $code ": negate ( n -- -n ) 0 swap - ;" } ;
ARTICLE: "tutorial-see" "Seeing words"
"If you have entered every definition in this tutorial, you will now have several new colon definitions:"
{ $code "twice\nsquare\nnegate" }
"You can look at previously-entered word definitions using 'see'. Try the following:"
"You can look at previously-entered word definitions using " { $snippet "see" } ". Try the following:"
{ $code "\\ negate see" }
"Prefixing a word with \\ pushes it on the stack, instead of executing it. So the see word has stack effect ( word -- )." ;
"Prefixing a word with " { $snippet "\\" } " pushes it on the stack, instead of executing it. So the see word has stack effect " { $snippet "( word -- )" } "." ;
ARTICLE: "tutorial-branches" "Branches"
"Now suppose we want to write a word that computes the absolute value of a number; that is, if it is less than 0, the number will be negated to yield a positive result."
{ $code ": absolute ( x -- |x| ) dup 0 < [ negate ] when ;" }
"If the top of the stack is negative, the word negates it again, making it positive. The < ( x y -- x<y ) word outputs a boolean. In Factor, any object can be used as a truth value."
"- The f object is false."
"- Anything else is true."
{ $list
"The f object is false."
"Anything else is true."
}
"Another commonly-used form is 'unless':"
{ $code " ... condition ... [ ... false case ... ] unless" }
{ $code "... condition ... [ ... false case ... ] unless" }
"The 'if' conditional takes action on both branches:"
{ $code " ... condition ... [ ... ] [ ... ] if" } ;
{ $code "... condition ... [ ... ] [ ... ] if" } ;
ARTICLE: "tutorial-combinators" "Combinators"
"if, when, unless are words that take lists of code as input."
"Lists of code are called ``quotations''. Words that take quotations are called ``combinators''."
"Another combinator is times ( n quot -- ). It calls a quotation n times."
"Try this:"
{ $snippet "if" } ", " { $snippet "when" } ", " { $snippet "unless" } " are words that take lists of code as input. Lists of code are called " { $emphasis "quotations" } ". Words that take quotations are called " { $emphasis "combinators" } ". Another combinator is " { $snippet "times ( n quot -- )" } ". It calls a quotation n times. Try this:"
{ $code "10 [ \"Hello combinators\" print ] times" } ;
ARTICLE: "tutorial-sequences" "Sequences"
"You have already seen strings, very briefly:"
" \"Hello world\""
"Strings are part of a class of objects called sequences. Two other types of sequences you will use a lot are:"
"Lists: [ 1 3 \"hi\" 10 2 ]"
"Arrays: { \"the\" { \"quick\" \"brown\" } \"fox\" }"
{ $code "\"Hello world\"" }
"Strings are part of a class of objects called sequences. Two other types of sequences you will use a lot are lists:"
{ $code "[ 1 3 \"hi\" 10 2 ]" }
"and arrays:"
{ $code "{ \"the\" { \"quick\" \"brown\" } \"fox\" }" }
"As you can see in the second example, lists and arrays can contain any type of object, including other lists and arrays." ;
ARTICLE: "tutorial-seq-combinators" "Sequences and combinators"
"A very useful combinator is each ( seq quot -- ). It calls a quotation with each element of the sequence in turn."
"A very useful combinator is " { $snippet "each ( seq quot -- )" } ". It calls a quotation with each element of the sequence in turn."
"Try this:"
{ $code "{ 10 20 30 } [ . ] each" }
"A closely-related combinator is map ( seq quot -- seq ). It also calls a quotation with each element."
"However, it then collects the outputs of the quotation into a new sequence."
"Try this:"
"A closely-related combinator is " { $snippet "map ( seq quot -- seq )" } ". It also calls a quotation with each element."
"However, it then collects the outputs of the quotation into a new sequence. Try this:"
{ $code "{ 10 20 30 } [ 3 + ] map ." } ;
ARTICLE: "tutorial-rationals" "Numbers - integers and ratios"
"Factor supports arbitrary-precision integers and ratios."
"Try the following:"
"Factor supports arbitrary-precision integers and ratios. Try the following:"
{ $code ": factorial ( n -- n! ) 1 swap <range> product ;\n100 factorial .\n1 3 / 1 2 / + ." }
"Rational numbers are added, multiplied and reduced to lowest terms in the same way you learned in grade school." ;
ARTICLE: "tutorial-oop" "Object oriented programming"
"Each object belongs to a class. Generic words act differently based on an object's class."
{ $code "GENERIC: describe ( object -- )\nM: integer describe \"The integer \" write . ;\nM: string describe \"The string \" write . ;\nM: object describe drop \"Unknown object\" print ;" }
"Each M: line defines a ``method.'' Method definitions may appear in independent source files. Examples of built-in classes are integer, string, and object." ;
{ $code "GENERIC: explain ( object -- )\nM: integer explain \"The integer \" write . ;\nM: string explain \"The string \" write . ;\nM: object explain drop \"Unknown object\" print ;" }
"Each " { $snippet "M:" } " line defines a " { $emphasis "method" } ". Method definitions may appear in independent source files. Examples of built-in classes are " { $snippet "integer" } ", " { $snippet "string" } ", and " { $snippet "object" } "." ;
ARTICLE: "tutorial-classes" "Defining new classes"
"New classes can be defined:"
{ $code "TUPLE: point x y ;\nM: point describe\n \"x =\" write dup point-x .\n \"y =\" write point-y . ;\n100 200 <point> describe" }
{ $code "TUPLE: point x y ;\nM: point explain\n \"x = \" write dup point-x .\n \"y = \" write point-y . ;\n100 200 <point> explain" }
"A tuple is a collection of named slots. Tuples support custom constructors, delegation... see the developer's handbook for details." ;
ARTICLE: "tutorial-library" "The library"
"Offers a good selection of highly-reusable words:"
"- Operations on sequences"
"- Variety of mathematical functions"
"- Web server and web application framework"
"- Graphical user interface framework"
{ $list
"Operations on sequences"
"Variety of mathematical functions"
"Web server and web application framework"
"Graphical user interface framework"
}
"Browsing the library:"
"- To list all vocabularies:"
{ $code "vocabs." }
"- To list all words in a vocabulary:"
{ $code "\"sequences\" words." }
"- To show a word definition:"
{ $code "\\ reverse see" } ;
{ $list
{
"To list all vocabularies:"
{ $code "vocabs." }
}
{
"To list all words in a vocabulary:"
{ $code "\"sequences\" words." }
}
{
"To show a word definition:"
{ $code "\\ reverse see" }
}
} ;
ARTICLE: "tutorial-more" "Learning more"
"Hopefully this tutorial has sparked your interest in Factor."
"You can learn more by reading the Factor developer's handbook:"
{ $terpri }
{ $url "http://factorcode.org/handbook.pdf" }
{ $terpri }
"Also, point your IRC client to irc.freenode.net and hop in the #concatenative channel to chat with other Factor geeks." ;
ARTICLE: "tutorial" "Factor tutorial"
"Welcome to the Factor tutorial!"
{ $terpri }
"Factor is interactive, which means you can test out the code in this tutorial immediately."
{ $terpri }
"Code examples will insert themselves in the listener's input area when clicked:"
{ $code "\"hello world\" print" }
"You can then press ENTER to execute the code, or edit it first."

3
library/io/duplex-stream.factor
View File

@ -22,9 +22,6 @@ M: duplex-stream stream-write1
M: duplex-stream stream-write
duplex-stream-out stream-write ;
M: duplex-stream stream-bl
duplex-stream-out stream-bl ;
M: duplex-stream stream-terpri
duplex-stream-out stream-terpri ;

1
library/io/null-stream.factor
View File

@ -16,5 +16,4 @@ M: f stream-terpri* drop ;
M: f stream-flush drop ;
M: f stream-format 3drop ;
M: f stream-bl drop ;
M: f with-nested-stream rot drop with-stream* ;

1
library/io/plain-stream.factor
View File

@ -7,7 +7,6 @@ TUPLE: plain-writer ;
C: plain-writer ( stream -- stream ) [ set-delegate ] keep ;
M: plain-writer stream-bl CHAR: \s swap stream-write1 ;
M: plain-writer stream-terpri CHAR: \n swap stream-write1 ;
M: plain-writer stream-terpri* stream-terpri ;
M: plain-writer stream-format nip stream-write ;

7
library/io/stdio.factor
View File

@ -17,7 +17,6 @@ SYMBOL: stdio
: write ( string -- ) stdio get stream-write ;
: flush ( -- ) stdio get stream-flush ;
: bl ( -- ) stdio get stream-bl ;
: terpri ( -- ) stdio get stream-terpri ;
: terpri* ( -- ) stdio get stream-terpri* ;
: format ( string style -- ) stdio get stream-format ;
@ -49,10 +48,14 @@ SYMBOL: style-stack
: with-style ( style quot -- )
[ >r >style r> call style> drop ] with-scope ; inline
: current-style ( -- style ) style-stack get hash-concat ;
: current-style ( -- style )
#! Always returns a fresh hashtable.
style-stack get hash-concat ;
: format* ( string -- ) current-style format ;
: bl ( -- ) " " current-style t word-break pick set-hash format ;
: with-nesting* ( quot -- )
current-style swap with-nesting ; inline

1
library/io/stream.factor
View File

@ -19,7 +19,6 @@ GENERIC: stream-write ( string stream -- )
GENERIC: stream-flush ( stream -- )
! Extended output protocol.
GENERIC: stream-bl ( stream -- )
GENERIC: stream-terpri ( stream -- )
GENERIC: stream-terpri* ( stream -- )
GENERIC: stream-format ( string style stream -- )

5
library/kernel.factor
View File

@ -38,11 +38,6 @@ M: object clone ;
: cpu ( -- arch ) 7 getenv ;
: os ( -- os ) 11 getenv ;
: win32? ( -- ? ) os "win32" = ;
: unix? ( -- ? )
os "freebsd" =
os "linux" = or
os "macosx" = or ;
: slip ( quot x -- x | quot: -- )
>r call r> ; inline

3
library/styles.factor
View File

@ -34,6 +34,9 @@ SYMBOL: file
! A quotation that writes an outline expansion to stdio
SYMBOL: outline
! A word break inside a pragraph with wrap-margin set
SYMBOL: word-break
! Paragraph styles
SYMBOL: page-color
SYMBOL: border-color

17
library/syntax/parse-syntax.factor
View File

@ -30,10 +30,6 @@ words ;
dup t "foldable" set-word-prop
t "flushable" set-word-prop ; parsing
! The variable "in-definition" is set inside a : ... ;.
! ( and #! then add "stack-effect" and "documentation"
! properties to the current word if it is set.
! Booleans
! the canonical truth value is just a symbol.
@ -66,12 +62,11 @@ SYMBOL: t
! Word definitions
: :
#! Begin a word definition. Word name follows.
CREATE dup reset-generic [ define-compound ]
[ ] "in-definition" on ; parsing
CREATE dup reset-generic [ define-compound ] [ ] ; parsing
: ;
#! End a word definition.
"in-definition" off reverse swap call ; parsing
reverse swap call ; parsing
! Symbols
: SYMBOL:
@ -123,15 +118,15 @@ SYMBOL: t
! Comments
: (
#! Stack comment.
CHAR: ) until parsed-stack-effect ; parsing
CHAR: ) ch-search until ; parsing
: !
#! EOL comment.
until-eol drop ; parsing
until-eol ; parsing
: #!
#! Documentation comment.
until-eol parsed-documentation ; parsing
#! EOL comment.
until-eol ; parsing
! Reading integers in other bases
: (BASE) ( base -- )

47
library/syntax/parse-words.factor
View File

@ -82,24 +82,16 @@ global [ string-mode off ] bind
] when ;
! Used by parsing words
: ch-search ( ch -- index )
column get line-text get index* ;
: ch-search ( ch -- index ) column get line-text get index* ;
: (until) ( index -- str )
column [ swap dup 1+ ] change line-text get subseq ;
: until ( index -- str ) 1+ column set ;
: until ( ch -- str )
ch-search (until) ;
: (until-eol) ( -- index )
CHAR: \n ch-search dup -1 =
[ drop line-text get length ] when ;
: until-eol ( -- str )
: until-eol ( -- )
#! This is just a hack to get "eval" to work with multiline
#! strings from jEdit with EOL comments. Normally, input to
#! the parser is already line-tokenized.
(until-eol) (until) ;
CHAR: \n ch-search dup -1 =
[ drop line-text get length ] when until ;
: escape ( ch -- esc )
H{
@ -128,33 +120,6 @@ global [ string-mode off ] bind
over 1+ >r nth r>
] if ;
: doc-comment-here? ( parsed -- ? )
not "in-definition" get and ;
: parsed-stack-effect ( parsed str -- parsed )
over doc-comment-here? [
word "stack-effect" word-prop [
drop
] [
word swap "stack-effect" set-word-prop
] if
] [
drop
] if ;
: documentation+ ( word str -- )
over "documentation" word-prop [
swap "\n" swap append3
] when*
"documentation" set-word-prop ;
: parsed-documentation ( parsed str -- parsed )
over doc-comment-here? [
word swap documentation+
] [
drop
] if ;
: (parse-string) ( n str -- n )
2dup nth CHAR: " = [
drop 1+
@ -172,7 +137,7 @@ global [ string-mode off ] bind
global [
{
"scratchpad" "syntax" "arrays" "compiler" "errors"
"generic" "hashtables" "inference" "inspector"
"generic" "hashtables" "help" "inference" "inspector"
"io" "jedit" "kernel" "listener" "lists" "math" "memory"
"namespaces" "parser" "prettyprint" "queues" "sequences"
"shells" "strings" "styles" "test" "threads" "vectors"

2
library/syntax/prettyprint.factor
View File

@ -131,7 +131,7 @@ M: newline pprint-section* ( newline -- )
dup newline? [
drop
] [
section-start last-newline get = [ " " write ] unless
section-start last-newline get = [ bl ] unless
] if ;
M: block pprint-section* ( block -- )

42
library/syntax/see.factor
View File

@ -15,8 +15,14 @@ sequences strings styles words ;
POSTPONE: flushable
} [ declaration. ] each-with ;
: in. ( word -- )
<block \ IN: pprint-word word-vocabulary plain-text block; ;
: (synopsis) ( word -- )
dup in. dup definer pprint-word pprint-word ;
: comment. ( comment -- )
H{ { font-style italic } } text ;
[ H{ { font-style italic } } text ] when* ;
: stack-picture% ( seq -- string )
dup integer? [ object <array> ] when
@ -24,10 +30,11 @@ sequences strings styles words ;
: effect>string ( effect -- string )
[
" " %
"( " %
dup first stack-picture%
"-- " %
second stack-picture%
")" %
] "" make ;
: stack-effect ( word -- string )
@ -36,36 +43,22 @@ sequences strings styles words ;
dup [ effect>string ] when
] ?if ;
: stack-effect. ( string -- )
[ "(" swap ")" append3 comment. ] when* ;
: in. ( word -- )
<block \ IN: pprint-word word-vocabulary plain-text block; ;
: (synopsis) ( word -- )
dup in.
dup definer pprint-word
dup pprint-word
stack-effect stack-effect. ;
: synopsis ( word -- string )
#! Output a brief description of the word in question.
[ 0 margin set [ (synopsis) ] with-pprint ] string-out ;
[
0 margin set [
dup (synopsis) stack-effect comment.
] with-pprint
] string-out ;
GENERIC: (see) ( word -- )
M: word (see) drop ;
: documentation. ( word -- )
"documentation" word-prop [
"\n" split [ "#!" swap append comment. newline ] each
] when* ;
: pprint-; \ ; pprint-word ;
: see-body ( quot word -- )
<block dup documentation. swap pprint-elements
pprint-; declarations. block; ;
<block swap pprint-elements pprint-; declarations. block; ;
M: compound (see)
dup word-def swap see-body ;
@ -130,6 +123,5 @@ M: word class. drop ;
: apropos ( substring -- )
#! List all words that contain a string.
(apropos) [
"IN: " write dup word-vocabulary write " " write .
] each ;
(apropos) word-sort
[ [ synopsis ] keep simple-object terpri ] each ;

6
library/test/parsing-word.factor
View File

@ -10,9 +10,3 @@ DEFER: foo
"IN: temporary : foo 2 2 + . ;" eval
[ [ POSTPONE: foo ] ] [ "USE: temporary foo" parse ] unit-test
! Test > 1 ( ) comment; only the first one should be used.
[ t ] [
CHAR: a "IN: temporary : foo ( a ) ( b ) ;" parse drop word
"stack-effect" word-prop member?
] unit-test

4
library/test/prettyprint.factor
View File

@ -39,12 +39,12 @@ unit-test
: bar ( x -- y ) 2 + ;
[ "IN: temporary : bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
[ "IN: temporary : bar 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
: baz dup ;
[ ] [ [ baz ] infer drop ] unit-test
[ "IN: temporary : baz ( object -- object object ) dup ;\n" ]
[ "IN: temporary : baz dup ;\n" ]
[ [ \ baz see ] string-out ] unit-test
[ ] [ \ fixnum see ] unit-test

5
library/ui/commands.factor
View File

@ -71,15 +71,10 @@ M: command-button gadget-help ( button -- string )
"Prettyprint" [ drop t ] [ . ] \ in-listener define-command
"Push on data stack" [ drop t ] [ ] \ in-listener define-command
"See word" [ word? ] [ see ] \ in-browser define-default-command
"Word call hierarchy" [ word? ] [ uses. ] \ in-browser define-command
"Word caller hierarchy" [ word? ] [ usage. ] \ in-browser define-command
"Open in jEdit" [ word? ] [ jedit ] \ call define-command
"Reload original source" [ word? ] [ reload ] \ in-listener define-command
"Annotate with watchpoint" [ compound? ] [ watch ] \ in-listener define-command
"Annotate with breakpoint" [ compound? ] [ break ] \ in-listener define-command
"Annotate with profiling" [ compound? ] [ profile ] \ in-listener define-command
"Compile" [ word? ] [ recompile ] \ in-listener define-command
"Infer stack effect" [ word? ] [ unit infer . ] \ in-listener define-command
"Display gadget" [ [ gadget? ] is? ] [ gadget. ] \ in-listener define-command

32
library/ui/panes.factor
View File

@ -3,7 +3,7 @@
IN: gadgets-panes
USING: arrays gadgets gadgets-buttons gadgets-editors
gadgets-labels gadgets-layouts gadgets-scrolling gadgets-theme
generic hashtables io kernel line-editor lists math namespaces
generic hashtables io kernel line-editor math namespaces
sequences strings styles threads ;
! Input history
@ -69,24 +69,22 @@ SYMBOL: structured-input
: pane-actions ( line -- )
H{
{ [ button-down ] [ pane-input [ click-editor ] when* ] }
{ [ "UP" ] [ pane-input [ [ history-prev ] with-editor ] when* ] }
{ [ "DOWN" ] [ pane-input [ [ history-next ] with-editor ] when* ] }
{ [ "CTRL" "l" ] [ pane get pane-clear ] }
{ [ button-down ] [ pane-input click-editor ] }
{ [ "RETURN" ] [ pane-commit ] }
{ [ "UP" ] [ pane-input [ history-prev ] with-editor ] }
{ [ "DOWN" ] [ pane-input [ history-next ] with-editor ] }
{ [ "CTRL" "l" ] [ pane-clear ] }
} add-actions ;
: input-pane-actions ( line -- )
[ pane-commit ] [ "RETURN" ] set-action ;
C: pane ( -- pane )
<pile> over set-delegate
<shelf> over set-pane-prototype
<pile> <incremental> over add-output
dup prepare-line dup pane-actions ;
dup prepare-line ;
: <input-pane> ( -- pane )
<pane> t over set-pane-scrolls?
"" <editor> over set-pane-input dup input-pane-actions ;
"" <editor> over set-pane-input dup pane-actions ;
M: pane focusable-child* ( pane -- editor )
pane-input [ t ] unless* ;
@ -108,13 +106,13 @@ M: pane stream-terpri* ( pane -- )
dup pane-current gadget-children empty?
[ dup stream-terpri ] unless drop ;
: pane-write ( pane list -- )
2dup car swap pane-current stream-write cdr dup
[ over stream-terpri pane-write ] [ 2drop ] if ;
: pane-write ( pane seq -- )
[ over pane-current stream-write ]
[ dup stream-terpri ] interleave drop ;
: pane-format ( style pane list -- )
3dup car -rot pane-current stream-format cdr dup
[ over stream-terpri pane-format ] [ 3drop ] if ;
: pane-format ( style pane seq -- )
[ pick pick pane-current stream-format ]
[ dup stream-terpri ] interleave 2drop ;
: write-gadget ( gadget pane -- )
#! Print a gadget to the given pane.
@ -142,8 +140,6 @@ M: pane stream-write ( string pane -- )
M: pane stream-format ( string style pane -- )
[ rot "\n" split pane-format ] keep scroll-pane ;
M: pane stream-bl ( pane -- ) pane-current stream-bl ;
M: pane stream-close ( pane -- ) drop ;
: with-pane ( pane quot -- )

6
library/ui/paragraphs.factor
View File

@ -3,9 +3,9 @@ USING: arrays gadgets gadgets-labels generic kernel math
namespaces sequences ;
! A word break gadget
TUPLE: word-break ;
TUPLE: word-break-gadget ;
C: word-break ( -- gadget ) " " <label> over set-delegate ;
C: word-break-gadget ( gadget -- gadget ) [ set-delegate ] keep ;
! A gadget that arranges its children in a word-wrap style.
TUPLE: paragraph margin ;
@ -31,7 +31,7 @@ SYMBOL: margin
: wrap-step ( quot child -- | quot: pos child -- )
dup pref-dim [
over word-break? [
over word-break-gadget? [
dup first overrun? [ dup second wrap-line ] when
] unless drop wrap-pos rot call
] keep first2 advance-y advance-x ; inline

6
library/ui/presentations.factor
View File

@ -17,9 +17,6 @@ M: gadget-stream stream-write ( string stream -- )
M: gadget-stream stream-write1 ( char stream -- )
>r ch>string r> stream-write ;
M: gadget-stream stream-bl ( stream -- )
<word-break> swap add-gadget ;
! Character styles
: apply-style ( style gadget key quot -- style gadget )
@ -42,6 +39,9 @@ M: gadget-stream stream-bl ( stream -- )
: apply-command-style ( style gadget -- style gadget )
presented [ <command-button> ] apply-style ;
: apply-break-style ( style gadget -- style gadget )
word-break [ <word-break-gadget> ] apply-style ;
: <presentation> ( style text -- gadget )
<label>
apply-foreground-style

1
library/words.factor
View File

@ -114,7 +114,6 @@ M: compound definer drop \ : ;
: reset-word ( word -- )
{
"parsing" "inline" "foldable" "flushable" "predicating"
"documentation" "stack-effect"
} reset-props ;
: reset-generic ( word -- )