Permalink
Browse files

Added a shell, very rudimentary first pass.

  • Loading branch information...
pavpanchekha committed Feb 27, 2014
1 parent 4e04ac9 commit 829c891e91593a9302902d2227f6f578a41b92c1
Showing with 40 additions and 0 deletions.
  1. +40 −0 casio/shell.rkt
View
@@ -0,0 +1,40 @@
#lang racket
(require casio/common)
(require casio/points)
(require casio/programs)
(require casio/alternative)
(require casio/analyze-subexpressions)
(require casio/main)
(define (shell prog)
(debug-reset)
(define-values (points exacts) (prepare-points prog))
(parameterize ([*points* points] [*exacts* exacts])
(let ([orig (make-alt prog)])
(let toploop ([alts (list orig)])
(println "Alternatives: ")
(let printloop ([alts alts] [idx 0])
(unless (null? alts)
(println "$" idx ": " (car alts))
(printloop (cdr alts) (+ idx 1))))
(display "focus> ")
(let* ([altn (list-ref alts (read))]
[locs (remove-duplicates (list '(cdr cdr car) (analyze-local-error altn)))])
(println "Locations: ")
(let printloop ([locs locs] [idx 0])
(unless (null? locs)
(println "@" idx ": " (location-get (car locs) (alt-program altn)))
(printloop (cdr locs) (+ idx 1))))
(display "rewrite> ")
(let* ([cmd (read)]
[rr (if (eq? (car cmd) 'tree) alt-rewrite-tree alt-rewrite-expression)]
[loc (list-ref locs (cadr cmd))])
(toploop (rr altn #:root loc))))))))

0 comments on commit 829c891

Please sign in to comment.