# documentation and inspection

: nondoc "no help available" . cr ;

: main-help
	cr "Welcome to Packet Forth." . cr 
	"Type 'help <word>' to print a word's help string." . cr
	"You can use tab completion to select from a list of all commands." . cr cr ;
	
: help
	try read find docstring . cr
	recover 
		e_eof = if pass main-help then
		nondoc
	endtry ;

"usage: help <word>" doc


: .help
	dup . .t 
	try find docstring . cr
	recover 2drop nondoc endtry ;

: .realhelp
	try dup find docstring swap . .t . cr
	endtry ;


: .alldocs words ['] .help for-each ;

: .docs words ['] .realhelp for-each ;





: doc>where
	  head follow >r
  	  r @ r> follow @ ;


: xt>where   	
      try
         xt>doc doc>where 1 + # count starts from 0
	 swap ":%d: " concat % 
      recover
         drop "/dev/null:-1: "
      endtry 
       ;


: where  read find xt>where print cr ;


# this also works for instruction pointers: an XT is just an atom
# pointer inside a link, which an IP is also. the only difference
# being XT points to a CF, while an IP points to XT (treaded code)

# : ip>doc xt>doc ;;

# : broem r xt>where print cr ;
# : bram broem ;


: .next-internal
	.t 
	try linkhead 
		@ write
	recover drop report cr
	endtry ;
	
: .body-internal
	begin dup >r @ 
	.next-internal r> follow again  ;


: .link-internal 
	"name:\t" print dup @ report .n
	follow   "comp:\t" print dup @ report .n
	follow   "doc:\t" print dup @ report .n
	follow   "cf:\t" print dup @ report .n
	try follow .body-internal
	recover 2drop  .n
	endtry ;
"( linkhead -- ) Print link pointed to by head." doc

: .xt linkhead  .link-internal
; "( xt -- )\tPrint link pointed to by xt." doc

: .link >r rsp head .link-internal r> ;
; "( link -- link )\tPrint link on top of ds. note: does not drop! ('dup' on links is a bad idea)." doc

: see read find .xt ; "Print compiled definition. Parses word." doc




# print a data stack
: .ds
        reverse 
	"<" print list:size report "> " print
	{ report .s } for-each ; "( list -- )\tPrint list as stack. " doc

# print a return stack
: .rs   { type ` variable scalar:= if
	       dup word-name report cr
	  then tab report .s cr } for-each ;

# since displaying the atom pointer that points to the continuation is
# not really so useful, i use this one:

: .rsframes { type ` variable scalar:= if
  	      	    >r r xt>where print
		    r> word-name report cr

	      else
	            report cr 		   
	      then
	      
	      } for-each ;

	

# here we need to be careful: some elements won't be copied by 'dup',
# and will only leave a ghost. Semantics is always like ( a -- a a/ghost )

: ds 
     stack dup >r unpack r> ; "( -- list )\tGet a copy of data stack." doc
: rs 
     () swapreturn 
     dup		# rs rs.ghost 
     swap		# rs.ghost rs  (!!!!)
     swapreturn drop ; "( -- list )\tGet a copy of return stack." doc



:: ds .ds cr ; is .S
:: rs split drop # compensate for current stack frame
   .rs cr ; is .R



: .words words { report .s } for-each cr ;
"( -- )\tPrint words in dictionary." doc




: r++  postpone r 
       postpone r> 
       postpone follow 
       postpone >r ; immediate

: .task  
     try
	 head >r

         r++ @ "\nRETURN STACK FRAMES" . cr .rsframes cr
  	 r++ @ "\nDATA STACK"   . cr .ds cr

	 "\nTASK VARIABLES" . cr
	 r> { unpack xt>name @ . . cr } for-each-rest
     recover
	 drop drop ".task failed" . cr
     endtry

;