From b40a90f33c19449e68ced37946f3393820b8ef15 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 30 Mar 2017 20:07:09 -0700 Subject: [PATCH] structification --- pitfall/pitfall/minimal-pdf-source.rkt | 20 -------------- pitfall/pitfall/parse.rkt | 36 +++++++++----------------- pitfall/pitfall/render.rkt | 16 +++++++++--- pitfall/pitfall/struct.rkt | 10 +++++-- 4 files changed, 32 insertions(+), 50 deletions(-) diff --git a/pitfall/pitfall/minimal-pdf-source.rkt b/pitfall/pitfall/minimal-pdf-source.rkt index 4efdffe8..cb4f301b 100644 --- a/pitfall/pitfall/minimal-pdf-source.rkt +++ b/pitfall/pitfall/minimal-pdf-source.rkt @@ -1,22 +1,2 @@ #lang racket/base (require pitfall/struct pitfall/render) - -(define (io1) - (hasheq 'Pages "2 0 R" 'Type 'Catalog)) - -(define (io2) - (hasheq 'Count 1 'Kids '("3 0 R") 'Type 'Pages 'MediaBox '(0 0 300 144))) - -(define (io3) - (hasheq 'Resources - (hasheq 'Font - (hasheq 'F1 (hasheq 'Subtype 'Type1 'BaseFont 'Times-Roman - 'Type 'Font))) - 'Parent "2 0 R" - 'Contents "4 0 R" - 'Type 'Page)) - -(define (io4) - ($stream (hasheq 'Length 55) #" BT\n /F1 18 Tf\n 0 0 Td\n (Hello World) Tj\n ET")) - -(display (cosexpr->string (list io1 io2 io3 io4))) \ No newline at end of file diff --git a/pitfall/pitfall/parse.rkt b/pitfall/pitfall/parse.rkt index 38675d11..88751bd5 100644 --- a/pitfall/pitfall/parse.rkt +++ b/pitfall/pitfall/parse.rkt @@ -64,36 +64,24 @@ #;(check-true (andmap byte? @pf-string{<1C2D3F>})) #;(check-true (andmap byte? @pf-string{<1C 2D 3F>}))) -(define (pf-array . xs) xs) +(define (pf-array . xs) (co-array xs)) (define (pf-dict . args) - (apply hasheq args)) + (co-dict (apply hasheq args))) (define (pf-stream dict str) (define data (string->bytes/utf-8 str)) - (when (not (equal? (hash-ref dict 'Length) (bytes-length data))) + (when (not (equal? (hash-ref (co-dict-dict dict) 'Length) (bytes-length data))) (raise-argument-error 'pf-stream (format "~a bytes of data" (hash-ref dict 'Length)) (format "~a = ~v" (bytes-length data) data))) - ($stream dict data)) - -(define-macro (pf-indirect-object OBJ-NUM GEN-NUM THING) - (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)]) - #'(begin - (define (IO-ID #:name [name #f]) - (if name - (string-join (map ~a '(OBJ-NUM GEN-NUM R)) " ") - THING)) - (provide IO-ID) - IO-ID))) - -(define-macro (pf-indirect-object-ref (OBJ-NUM GEN-NUM "R")) - (with-syntax ([IO-ID (prefix-id "io" #'OBJ-NUM)]) - #'(string-join '(OBJ-NUM GEN-NUM "R") " "))) - -(define-macro (pf-version NUM) - (with-pattern ([VERSION-ID (prefix-id "" #'version #:context #'NUM)]) - #'(begin - (define VERSION-ID NUM) - (provide version)))) + (co-stream dict data)) + +(define (pf-indirect-object obj gen thing) + (co-io obj gen thing)) + +(define-macro (pf-indirect-object-ref (OBJ GEN _)) + #'(co-io-ref OBJ GEN)) + +(define (pf-version num) (co-version num)) diff --git a/pitfall/pitfall/render.rkt b/pitfall/pitfall/render.rkt index 5babff18..dc53002b 100644 --- a/pitfall/pitfall/render.rkt +++ b/pitfall/pitfall/render.rkt @@ -1,6 +1,14 @@ #lang racket/base -(require racket/string pitfall/struct) -(provide (all-defined-out)) +(require (for-syntax racket/base) + racket/string pitfall/struct br/define) +(provide (all-defined-out) + (all-from-out pitfall/struct) + (except-out (all-from-out racket/base) #%module-begin)) + +(define-macro (mb . ARGS) + #'(#%module-begin + (cosexpr->string (list . ARGS)))) +(provide (rename-out [mb #%module-begin])) (define (cosexpr->string x) (define str @@ -13,10 +21,10 @@ "\n<< " (string-join (for/list ([(k v) (in-hash x)]) - (string-join (list (loop k) (loop v)) " ")) " ") + (string-join (list (loop k) (loop v)) " ")) " ") " >> ")] [(symbol? x) (format "/~a" x)] [(number? x) (number->string x)] - [($stream? x) (string-append (loop ($stream-dict x)) (string-join (list "\nstream" (format "~a" ($stream-data x)) "endstream") "\n"))] + [(co-stream? x) (string-append (loop (co-stream-dict x)) (string-join (list "\nstream" (format "~a" (co-stream-data x)) "endstream") "\n"))] [else x]))) (string-join (list "%%PDF1.1" str "%%EOF") "\n")) \ No newline at end of file diff --git a/pitfall/pitfall/struct.rkt b/pitfall/pitfall/struct.rkt index 68052a17..ac14f7c4 100644 --- a/pitfall/pitfall/struct.rkt +++ b/pitfall/pitfall/struct.rkt @@ -1,3 +1,9 @@ #lang racket/base -(provide (struct-out $stream)) -(struct $stream (dict data) #:transparent) \ No newline at end of file +(provide (all-defined-out)) + +(struct co-dict (dict) #:transparent) +(struct co-array (items) #:transparent) +(struct co-stream (dict data) #:transparent) +(struct co-version (num) #:transparent) +(struct co-io (obj gen thing) #:transparent) +(struct co-io-ref (obj gen) #:transparent) \ No newline at end of file