diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index d850a0be01..d40981f01e 100644 --- a/library/platform/native/boot-stage2.factor +++ b/library/platform/native/boot-stage2.factor @@ -78,6 +78,7 @@ USE: stdio "/library/presentation.factor" "/library/vocabulary-style.factor" "/library/syntax/prettyprint.factor" + "/library/syntax/see.factor" "/library/platform/native/debugger.factor" "/library/tools/debugger.factor" "/library/platform/native/init.factor" diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index a9fe1578e4..289efd0d43 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -193,11 +193,17 @@ IN: syntax parsing ! Comments -: ( ")" until parsed-stack-effect ; parsing +: ( + #! Stack comment. + ")" until parsed-stack-effect ; parsing -: ! until-eol drop ; parsing +: ! + #! EOL comment. + until-eol drop ; parsing -: #! until-eol parsed-documentation ; parsing +: #! + #! Documentation comment. + until-eol parsed-documentation ; parsing ! Reading numbers in other bases diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 0298dffd25..03fd40d2ef 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -81,6 +81,40 @@ DEFER: prettyprint* dup prettyprint-newline ] unless ; +: word-link ( word -- link ) + [ + "vocabularies'" , + dup word-vocabulary , + "'" , + word-name , + ] make-string ; + +: word-actions ( -- list ) + [ + [ "Describe" | "describe-path" ] + [ "Push" | "lookup" ] + [ "Execute" | "lookup execute" ] + [ "jEdit" | "lookup jedit" ] + [ "Usages" | "lookup usages." ] + ] ; + +: word-attrs ( word -- attrs ) + #! Words without a vocabulary do not get a link or an action + #! popup. + dup word-vocabulary [ + word-link [ "object-link" swons ] keep + word-actions "actions" swons + t "underline" swons + 3list + ] [ + drop [ ] + ] ifte ; + +: prettyprint-word ( word -- ) + dup word-name + swap dup word-attrs swap word-style append + write-attr ; + : prettyprint-[ ( indent -- indent ) \ [ prettyprint-word "actions" swons - t "underline" swons - 3list - ] [ - drop [ ] - ] ifte ; - -: prettyprint-word ( word -- ) - dup word-name - swap dup word-attrs swap word-style append - write-attr ; - : prettyprint-object ( indent obj -- indent ) unparse write ; : prettyprint* ( indent obj -- indent ) over prettyprint-limit >= [ - unparse write + prettyprint-object ] [ [ [ f = ] [ prettyprint-object ] @@ -196,28 +191,6 @@ DEFER: prettyprint* : vocab-link ( vocab -- link ) "vocabularies'" swap cat2 ; -: vocab-attrs ( word -- attrs ) - vocab-link "object-link" default-style acons ; - -: prettyprint-vocab ( vocab -- ) - dup vocab-attrs write-attr ; - -: prettyprint-IN: ( indent word -- ) - \ IN: prettyprint-word prettyprint-space - word-vocabulary prettyprint-vocab prettyprint-newline ; - -: prettyprint-: ( indent -- indent ) - \ : prettyprint-word prettyprint-space - tab-size + ; - -: prettyprint-; ( indent -- indent ) - \ ; prettyprint-word - tab-size - ; - -: prettyprint-plist ( word -- ) - dup "parsing" word-property [ " parsing" write ] when - "inline" word-property [ " inline" write ] when ; - : . ( obj -- ) [ "prettyprint-single-line" on @@ -242,49 +215,3 @@ DEFER: prettyprint* : .b >bin print ; : .o >oct print ; : .h >hex print ; - -: stack-effect. ( word -- ) - stack-effect [ - " " write - [ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment - ] when* ; - -: documentation. ( indent word -- indent ) - documentation [ - "\n" split [ - "#!" swap cat2 prettyprint-comment - dup prettyprint-newline - ] each - ] when* ; - -: prettyprint-docs ( indent word -- indent ) - [ - stack-effect. dup prettyprint-newline - ] keep documentation. ; - -: see-compound ( word -- ) - 0 swap - [ dupd prettyprint-IN: prettyprint-: ] keep - [ prettyprint-word ] keep - [ prettyprint-docs ] keep - [ word-parameter prettyprint-list prettyprint-; ] keep - prettyprint-plist prettyprint-newline ; - -: see-primitive ( word -- ) - "PRIMITIVE: " write dup unparse write stack-effect. terpri ; - -: see-symbol ( word -- ) - "SYMBOL: " write . ; - -: see-undefined ( word -- ) - drop "Not defined" print ; - -: see ( name -- ) - #! Show a word definition. - [ - [ compound? ] [ see-compound ] - [ symbol? ] [ see-symbol ] - [ primitive? ] [ see-primitive ] - [ word? ] [ see-undefined ] - [ drop t ] [ "Not a word: " write . ] - ] cond ; diff --git a/library/syntax/see.factor b/library/syntax/see.factor new file mode 100644 index 0000000000..7a47602397 --- /dev/null +++ b/library/syntax/see.factor @@ -0,0 +1,117 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2003, 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: prettyprint +USE: combinators +USE: lists +USE: math +USE: stack +USE: stdio +USE: strings +USE: presentation +USE: unparser +USE: words + +! Prettyprinting words +: vocab-attrs ( word -- attrs ) + vocab-link "object-link" default-style acons ; + +: prettyprint-vocab ( vocab -- ) + dup vocab-attrs write-attr ; + +: prettyprint-IN: ( indent word -- ) + \ IN: prettyprint-word prettyprint-space + word-vocabulary prettyprint-vocab prettyprint-newline ; + +: prettyprint-: ( indent -- indent ) + \ : prettyprint-word prettyprint-space + tab-size + ; + +: prettyprint-; ( indent -- indent ) + \ ; prettyprint-word + tab-size - ; + +: prettyprint-prop ( word prop -- ) + tuck word-name word-property [ + prettyprint-space prettyprint-word + ] [ + drop + ] ifte ; + +: prettyprint-plist ( word -- ) + dup + \ parsing prettyprint-prop + \ inline prettyprint-prop ; + +: prettyprint-comment ( comment -- ) + "comments" style write-attr ; + +: stack-effect. ( word -- ) + stack-effect [ + " " write + [ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment + ] when* ; + +: documentation. ( indent word -- indent ) + documentation [ + "\n" split [ + "#!" swap cat2 prettyprint-comment + dup prettyprint-newline + ] each + ] when* ; + +: prettyprint-docs ( indent word -- indent ) + [ + stack-effect. dup prettyprint-newline + ] keep documentation. ; + +: see-compound ( word -- ) + 0 swap + [ dupd prettyprint-IN: prettyprint-: ] keep + [ prettyprint-word ] keep + [ prettyprint-docs ] keep + [ word-parameter prettyprint-list prettyprint-; ] keep + prettyprint-plist prettyprint-newline ; + +: see-primitive ( word -- ) + "PRIMITIVE: " write dup unparse write stack-effect. terpri ; + +: see-symbol ( word -- ) + \ SYMBOL: prettyprint-word . ; + +: see-undefined ( word -- ) + drop "Not defined" print ; + +: see ( name -- ) + #! Show a word definition. + [ + [ compound? ] [ see-compound ] + [ symbol? ] [ see-symbol ] + [ primitive? ] [ see-primitive ] + [ word? ] [ see-undefined ] + [ drop t ] [ "Not a word: " write . ] + ] cond ; diff --git a/library/vocabulary-style.factor b/library/vocabulary-style.factor index 5be704dc26..37bcb5bd7e 100644 --- a/library/vocabulary-style.factor +++ b/library/vocabulary-style.factor @@ -115,3 +115,6 @@ USE: words [ "ansi-fg" | "3" ] [ "fg" | [ 2 185 2 ] ] ] "vectors" set-vocab-style +[ + [ "fg" | [ 128 128 128 ] ] +] "syntax" set-vocab-style