diff options
| -rw-r--r-- | main.rkt | 15 |
1 files changed, 6 insertions, 9 deletions
@@ -67,7 +67,7 @@ '() (cdr lst))) -(define (%pict-sexp sexp height-list) +(define (%pict-cons sexp height-list) (when (and (pair? height-list) (<= 0 (car height-list))) (amb)) @@ -76,7 +76,7 @@ (let*-values ([(p) (pict-cons-cell sexp)] [(p-1 height-list) (let-values ([(pict-cdr cdr-height-list) - (%pict-sexp (cdr sexp) (cdr* height-list))]) + (%pict-cons (cdr sexp) (cdr* height-list))]) (values (arrow-from-cdr p pict-cdr) (cons 0 cdr-height-list)))] [(p-2 height-list) @@ -86,20 +86,17 @@ (amb (cons len height-list) (retry (add1 len) (map sub1 height-list))))]) (let-values ([(pict-car height-list) - (%pict-sexp (car sexp) height-list)]) + (%pict-cons (car sexp) height-list)]) (values (arrow-from-car len p pict-car) (map (λ (x) (+ x len)) height-list))))]) (values (lt-superimpose p-1 p-2) height-list))] [else (values (pict-atom sexp) (cons 0 (cdr* height-list)))])) -(define (pict-sexp sexp) +(define (pict-cons sexp) (call-with-amb (thunk (define-values (result height-list) - (%pict-sexp sexp '())) + (%pict-cons sexp '())) result))) -(provide/contract [pict-sexp (any/c . -> . pict?)]) - -(define show pict-sexp) -(provide/contract [show (any/c . -> . pict?)]) +(provide/contract [pict-cons (any/c . -> . pict?)]) |