Skip to content

Instantly share code, notes, and snippets.

@manuel
Created March 18, 2012 23:55
Show Gist options
  • Save manuel/2086089 to your computer and use it in GitHub Desktop.
Save manuel/2086089 to your computer and use it in GitHub Desktop.
Fexprs give you teh amazing stack traces
;; Try pasting this into the Virtua REPL at http://manuel.github.com/virtua/
;; (better use V8 - stack trace printing is quite slow atm)
(defun foo (a b c) (bar b))
(defun bar (x) (quux x))
(defun quux (x) (print-stack-trace (stack-frame)))
(foo 1 2 3)
#[Native-Combiner] ()
#[stack-frame #[Native-Combiner]] ()
#[print-stack-trace #[Compound-Combiner (f)]] ((stack-frame))
#[$begin] ((print-stack-trace (stack-frame)))
#[Compound-Combiner (x)] (2)
#[quux #[Compound-Combiner (x)]] (x)
#[$begin] ((quux x))
#[Compound-Combiner (x)] (2)
#[bar #[Compound-Combiner (x)]] (b)
#[$begin] ((bar b))
#[Compound-Combiner (a b c)] (1 2 3)
#[foo #[Compound-Combiner (a b c)]] (1 2 3)
#[Native-Combiner] ((foo 1 2 3) #[environment])
#[eval #[Native-Combiner]] (form *top-level-environment*)
#[Wrapper #[Compound-Combiner (string)]] ((eval form *top-level-environment*))
#[$begin] ((print (eval form *top-level-environment*)))
#[Compound-Combiner (form)] ((foo 1 2 3))
#[Wrapper #[Compound-Combiner (form)]] ((car list))
#[cons #[Native-Combiner]] ((fn (car list)) (map fn (cdr list)))
#[$if] ((null? list) () (cons (fn (car list)) (map fn (cdr list))))
#[$begin] ((if (null? list) () (cons (fn (car list)) (map fn (cdr list)))))
#[Compound-Combiner (fn list)] (#[Wrapper #[Compound-Combiner (form)]] ((foo 1 2 3)))
#[map #[Compound-Combiner (fn list)]] ((lambda (form) (print (eval form *top-level-environment*))) (read-from-string input))
#[$begin] ((def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)
#[Compound-Combiner ()] ()
#[Wrapper #[Compound-Combiner ()]] ()
#[$js-try] ((lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk))
#[$unwind-protect] (($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (#[$begin] (set! *handler-stack* saved-stack)))
#[Native-Combiner] ((#[$unwind-protect] ($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (#[$begin] (set! *handler-stack* saved-stack))) #[environment])
#[eval #[Native-Combiner]] ((list $unwind-protect protected (list* begin cleanup)) env)
#[$begin] ((eval (list $unwind-protect protected (list* begin cleanup)) env))
#[unwind-protect (protected . cleanup)] (($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (set! *handler-stack* saved-stack))
#[$begin] ((set! *handler-stack* (option (make-handler-frame *handler-stack* matcher handler))) (unwind-protect ($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (set! *handler-stack* saved-stack)))
#[Compound-Combiner (saved-stack)] (#[object {}])
#[Wrapper #[Compound-Combiner (saved-stack)]] (*handler-stack*)
#[Native-Combiner] (((#[Compound-Combiner (formals . body)] (saved-stack) (set! *handler-stack* (option (make-handler-frame *handler-stack* matcher handler))) (unwind-protect ($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (set! *handler-stack* saved-stack))) *handler-stack*) #[environment])
#[eval #[Native-Combiner]] ((cons (list* lambda (map car bindings) body) (map cadr bindings)) env)
#[$begin] ((eval (cons (list* lambda (map car bindings) body) (map cadr bindings)) env))
#[let (bindings . body)] (((saved-stack *handler-stack*)) (set! *handler-stack* (option (make-handler-frame *handler-stack* matcher handler))) (unwind-protect ($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (set! *handler-stack* saved-stack)))
#[$begin] ((let ((saved-stack *handler-stack*)) (set! *handler-stack* (option (make-handler-frame *handler-stack* matcher handler))) (unwind-protect ($js-try (lambda (exc) (if (instance? exc Block-Escape) (js-throw exc) (signal exc))) (thunk)) (set! *handler-stack* saved-stack))))
#[Compound-Combiner (matcher handler thunk)] (#[Wrapper #[Compound-Combiner (exc)]] #[Wrapper #[Compound-Combiner (exc)]] #[Wrapper #[Compound-Combiner ()]])
#[Wrapper #[Compound-Combiner (matcher handler thunk)]] ((lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f))
#[$unwind-protect] ((call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (#[$begin] (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" "")))
#[Native-Combiner] ((#[$unwind-protect] (call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (#[$begin] (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" ""))) #[environment])
#[eval #[Native-Combiner]] ((list $unwind-protect protected (list* begin cleanup)) env)
#[$begin] ((eval (list $unwind-protect protected (list* begin cleanup)) env))
#[unwind-protect (protected . cleanup)] ((call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" ""))
#[$begin] ((unwind-protect (call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" "")))
#[Compound-Combiner exit] #[Wrapper #[Compound-Combiner (the-val)]]
#[Native-Combiner] ((#[Compound-Combiner exit] . #[Wrapper #[Compound-Combiner (the-val)]]) #[environment])
#[eval #[Native-Combiner]] ((cons (unwrap appv) arg) (if (null? opt) (make-environment) (car opt)))
#[$begin] ((eval (cons (unwrap appv) arg) (if (null? opt) (make-environment) (car opt))))
#[Compound-Combiner (appv arg . opt)] (#[Wrapper #[Compound-Combiner exit]] #[Wrapper #[Compound-Combiner (the-val)]])
#[apply #[Compound-Combiner (appv arg . opt)]] ((eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag)))
#[$js-try] ((lambda (exc) (if (eq? tag exc) val (js-throw exc))) (apply (eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag))))
#[$begin] (($js-try (lambda (exc) (if (eq? tag exc) val (js-throw exc))) (apply (eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag)))))
#[Compound-Combiner (tag val)] (#[object {}] #void)
#[Wrapper #[Compound-Combiner (tag val)]] ((make-block-escape) #void)
#[Native-Combiner] (((#[Compound-Combiner (formals . body)] (tag val) ($js-try (lambda (exc) (if (eq? tag exc) val (js-throw exc))) (apply (eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag))))) (make-block-escape) #void) #[environment])
#[eval #[Native-Combiner]] ((cons (list* lambda (map car bindings) body) (map cadr bindings)) env)
#[$begin] ((eval (cons (list* lambda (map car bindings) body) (map cadr bindings)) env))
#[let (bindings . body)] (((tag (make-block-escape)) (val #void)) ($js-try (lambda (exc) (if (eq? tag exc) val (js-throw exc))) (apply (eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag)))))
#[$begin] ((let ((tag (make-block-escape)) (val #void)) ($js-try (lambda (exc) (if (eq? tag exc) val (js-throw exc))) (apply (eval (list* lambda name body) env) (lambda (the-val) (set! val the-val) (js-throw tag))))))
#[block (name . body)] (exit (unwind-protect (call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" "")))
#[$begin] ((block exit (unwind-protect (call-with-handler (lambda (exc) #t) (lambda (exc) (print (make-repl-error exc)) (print-stack-trace (stack-frame)) (return-from exit #f)) (lambda () (def input (get-slot (getElementById *document* "lisp_line") "value")) (print (make-repl-input input)) (map (lambda (form) (print (eval form *top-level-environment*))) (read-from-string input)) #f)) (scrollTo *window* 0 (get-slot *body* "scrollHeight")) (set-slot! (getElementById *document* "lisp_line") "value" ""))))
#[Compound-Combiner ()] ()
#[Wrapper #[Compound-Combiner ()]] ()
#void
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment