SilkScript Stepper Hack

[Kelly Murray]

I hacked up a little something to give some idea of what is possible
using silkscript and a web-browser interface.
It doesn't do much really, but I've only spent an hour or two on it.
I hope it sparks some interest in how easy it can be do this stuff.

You can run this example by accessing
http://www.franz.com:8000/stepper-demo
Note the port is 8000, not the default one of 80.

-Kelly Murray


----

(procedure demo-stepper (&key state cmd pc)

  (http-response "200 OK" "Content-type: " "text/html")

  (let nstate = (if state then (parse-integer state) else 0)
       npc = (if pc then (parse-integer pc) else 0)
    do
    (clickon " Step "  :calls (demo-stepper :cmd "step" :pc (1+ npc)))
    (text " | ")
    (clickon " Trace " :calls (demo-stepper :cmd "trace"))
    (text " | ")
    (clickon " Evaluate " :calls (demo-stepper :cmd "value"))

    (verbatim ()
      (text "(procedure " (:green "demo-stepper") " ([:cmd] [:pc])" :crlf)
      (output-source
        '(let nstate = (if state then (parse-integer state) else 0)
	      npc = (if pc then (parse-integer pc) else 0)
	    do
	    (clickon " Step "  :calls (demo-stepper :cmd "step" :pc (1+ npc)))
	    (text " | ")
	    (clickon " Trace " :calls (demo-stepper :cmd "trace"))
	    (text " | ")
	    (clickon " Evaluate " :calls (demo-stepper :cmd "value")))'
	 0 (or cmd "step") 0 npc)
      )
   )
  )


(function output-atomic-source (code indent cmd pc this-pc)
 (if (eq pc this-pc)
   then
     (color :red)
     (if (stringp code)
	 then (text "&quot" code "&quot")
	 else (text code))
     (color :black)
  elseif (stringp code)
   then
     (clickon (text-string "&quot" code "&quot") :calls (demo-stepper :cmd cmd :pc pc))
   else
     (clickon code :calls (demo-stepper :cmd cmd :pc pc))
     )
 pc)

(function output-progn-source (code indent cmd pc this-pc)
 (loop for arg in code
     do
       (text :crlf)
       (loop for x from 0 to indent do (text " "))
       (set pc = (output-source arg indent cmd (1+ pc) this-pc))
       )
   pc)

(function output-call-source (code indent cmd pc this-pc)
   (text "(")
   (if (eq pc this-pc)
     then
       (color :red) (text (first code)) (color :black)
     else
       (clickon (first code) :calls (demo-stepper :cmd cmd :pc pc)))
   (loop for arg in (rest code)
       do
       (text " ")
       (set pc = (output-source arg indent cmd (1+ pc) this-pc))
       )
   (text ")")
   pc)

(function output-if-source (code indent cmd pc this-pc)
  (loop for x from 0 to indent do (text " "))
  (text "(")
  (if (eq pc this-pc)
    then
      (color :red) (text (pop code)) (color :black)
    else
      (clickon (pop code) :calls (demo-stepper :cmd cmd :pc pc)))
   (text " ")
   (set pc = (output-source (pop code) indent cmd (1+ pc) this-pc))
   (text " " (pop code) " ")
   (loop while code
	 for item = (pop code)
       do
       (if (member item '(then else elseif)')
	 then
	   (text " " item " ")
	 else
	   (set pc = (output-source item indent cmd (1+ pc) this-pc))
	 ))
   (text ")")
   pc)


(function output-let-source (code indent cmd pc this-pc)
   (loop for x from 0 to indent do (text " "))
   (text "(")
   (if (eq pc this-pc)
     then
       (color :red) (text (first code)) (color :black)
     else
       (clickon (first code) :calls (demo-stepper :cmd cmd :pc pc)))
   (text " ")
   (let items = (rest code)
	item = (pop items)
      do
      (if (not (eq item 'do'))
	then
	  ;; do first variable binding
	  (set pc = (output-source item indent cmd (1+ pc) this-pc))
	  (text " = ") (pop items)
	  (set pc = (output-source (pop items) indent cmd (1+ pc) this-pc)))
      ;;
      (loop while items
	    for item = (pop items)
	    with body = nil
	  do
	  (if (eq item 'do')
	    then
	      (set indent = (+ indent 2))
	      (text :crlf)
	      (loop for x from 0 to indent do (text " "))
	      (text "do")
	      (set body = t)
	    elseif (null body) ;; still doing variable bindings
	    then
	      (text :crlf)
	      (loop for x from 0 to (+ indent 5) do (text " "))
	      (set pc = (output-source item indent cmd (1+ pc) this-pc))
	      (text " = ") (pop items) ;; ignore it
	      (set pc = (output-source (pop items) indent cmd (1+ pc) this-pc))
	    else
	      (text :crlf)
	      (loop for x from 0 to indent do (text " "))
	      (set pc = (output-source item (- indent 5) cmd (1+ pc) this-pc))
	      )))
   (text ")")
   pc)


(function output-source (code indent cmd pc this-pc)
  (if (null code)
    then
      (text " nil ")
   elseif (listp code)
    then
      (select (first code)
	case 'let'
	  (output-let-source code indent cmd pc this-pc)
	case 'if'
	  (output-if-source code indent cmd pc this-pc)
	case 'progn'
	  (output-progn-source code indent cmd pc this-pc)
	other
	  (output-call-source code indent cmd pc this-pc)
	  )
    else
       (output-atomic-source code indent cmd pc this-pc)
       )
  )