CFactor documentation comments

TODO.FACTOR.txt

@@ -5,7 +5,6 @@
   - directory listings
   - index.html
   - if a directory is requested and URL does not end with /, redirect
-- doc strings with native factor
 
 + bignums:
 
@@ -47,6 +46,7 @@
 
 + listener/plugin:
 
+- inferior hangs
 - plugin should not exit jEdit on fatal errors
 - auto insert USE:
 - balance needs USE:

library/platform/jvm/prettyprint.factor

@@ -35,6 +35,13 @@ USE: stdio
 USE: unparser
 USE: words
 
+: prettyprint-:; ( indent word list -- indent )
+    over >r >r dup
+    >r dupd prettyprint-IN: prettyprint-: r>
+    prettyprint-word prettyprint-space
+    r>
+    prettyprint-list prettyprint-; r> prettyprint-plist ;
+
 : prettyprint-~<< ( indent -- indent )
     "~<<" write prettyprint-space
     tab-size + ;

library/platform/native/parse-syntax.factor

@@ -25,8 +25,6 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-! Parsing words. 'builtins' is a stupid vocabulary name now
-! that it does not contain Java words anymore!
 IN: syntax
 
 USE: combinators
@@ -44,6 +42,10 @@ USE: words
 USE: vectors
 USE: unparser
 
+! The variable "in-definition" is set inside a : ... ;.
+! ( and #! then add "stack-effect" and "documentation"
+! properties to the current word if it is set.
+
 ! Constants
 : t t parsed ; parsing
 : f f parsed ; parsing
@@ -65,7 +67,9 @@ USE: unparser
 : POSTPONE: ( -- ) scan parse-word parsed ; parsing
 
 ! Colon defs
-: CREATE scan "in" get create ;
+: CREATE
+    scan "in" get create dup set-word
+    f "documentation" pick set-word-property ;
 
 : remember-where ( word -- )
     "line-number" get "line" pick set-word-property
@@ -75,13 +79,15 @@ USE: unparser
 
 : :
     #! Begin a word definition. Word name follows.
-    CREATE dup remember-where [ ] ; parsing
+    CREATE dup remember-where [ ]
+    "in-definition" on ; parsing
 
 : ;-hook ( -- quot )
     ";-hook" get [ [ define-compound ] ] unless* ;
 
 : ;
     #! End a word definition.
+    "in-definition" off
     nreverse
     ;-hook call ; parsing
 
@@ -146,9 +152,30 @@ USE: unparser
     scan str>number scan str>number rect> parsed "}" expect ;
 
 ! Comments
-: ( ")" until drop ; parsing
+: doc-comment-here? ( parsed -- ? )
+    not "in-definition" get and ;
+
+: parsed-stack-effect ( parsed str -- parsed )
+    over doc-comment-here? [
+        "stack-effect" word set-word-property
+    ] [
+        drop
+    ] ifte ;
+
+: ( ")" until parsed-stack-effect ; parsing
+
 : ! until-eol drop ; parsing
-: #! until-eol drop ; parsing
+
+: parsed-documentation ( parsed str -- parsed )
+    over doc-comment-here? [
+        "documentation" word word-property [
+            swap "\n" swap cat3
+        ] when* "documentation" word set-word-property
+    ] [
+        drop
+    ] ifte ;
+
+: #! until-eol parsed-documentation ; parsing
 
 ! Reading numbers in other bases
 

library/platform/native/prettyprint.factor

@@ -27,16 +27,37 @@
 
 IN: prettyprint
 USE: combinators
+USE: lists
 USE: parser
 USE: prettyprint
 USE: stack
 USE: stdio
+USE: strings
 USE: unparser
 USE: words
 
+: prettyprint-docs ( indent word -- indent )
+    [
+        stack-effect [
+            <% CHAR: ( % % CHAR: ) % %> prettyprint-comment
+            dup prettyprint-newline
+        ] when*
+    ] keep
+
+    documentation [
+        "\n" split [
+            "#!" swap cat2 prettyprint-comment
+            dup prettyprint-newline
+        ] each
+    ] when* ;
+
 : see-compound ( word -- )
-    0 swap dup word-parameter prettyprint-:;
+    0 swap
-    prettyprint-newline ;
+    [ dupd prettyprint-IN: prettyprint-: ] keep
+    [ prettyprint-word prettyprint-space ] keep
+    [ prettyprint-docs ] keep
+    [ word-parameter prettyprint-list prettyprint-; ] keep
+    prettyprint-plist prettyprint-newline ;
 
 : see-primitive ( word -- )
     "PRIMITIVE: " write unparse print ;
@@ -45,6 +66,7 @@ USE: words
     drop "Not defined" print ;
 
 : see ( name -- )
+    #! Show a word definition.
     intern
     [
         [ compound? ] [ see-compound ]

library/platform/native/words.factor

@@ -59,6 +59,11 @@ USE: stack
 
 : define-compound ( word def -- )
     #! Define a compound word at runtime.
-    over set-word
     over set-word-parameter
     1 swap set-word-primitive ;
+
+: stack-effect ( word -- str )
+    "stack-effect" swap word-property ;
+
+: documentation ( word -- str )
+    "documentation" swap word-property ;

library/prettyprint.factor

@@ -186,10 +186,9 @@ DEFER: prettyprint*
 : prettyprint-vocab ( vocab -- )
     dup vocab-attrs write-attr ;
 
-: prettyprint-IN: ( indent word -- indent )
+: prettyprint-IN: ( indent word -- )
     "IN:" write prettyprint-space
-    word-vocabulary prettyprint-vocab
+    word-vocabulary prettyprint-vocab prettyprint-newline ;
-    dup prettyprint-newline ;
 
 : prettyprint-: ( indent -- indent )
     ":" write prettyprint-space
@@ -204,14 +203,6 @@ DEFER: prettyprint*
     "inline" over word-property [ " inline" write ] when
     drop ;
 
-: prettyprint-:; ( indent word list -- indent )
-    over >r >r dup
-    >r prettyprint-IN: prettyprint-: r>
-    prettyprint-word
-    native? [ dup prettyprint-newline ] [ prettyprint-space ] ifte
-    r>
-    prettyprint-list prettyprint-; r> prettyprint-plist ;
-
 : . ( obj -- )
     [
         "prettyprint-single-line" on