diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index 2bb2a1bb..4f13785e 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -71,7 +71,6 @@ (define-type Quad quad) (define-predicate Quad? Quad) - (define quad-attr-ref (case-lambda [([q : Quad] [key : QuadAttrKey]) @@ -136,8 +135,10 @@ ;; todo: reconsider type interface between output of this function and input to quadattrs [else (loop (cdr qs) (filter (λ([cap : QuadAttrPair]) (check-cap (car qs) cap)) candidate-attr-pairs))])))) -(define/typed (quadattrs xs) - ((Listof (U QuadAttrKey QuadAttrValue)) . -> . QuadAttrs) +(define/typed (make-quadattrs xs) + ;; no point typing the input as (U QuadAttrKey QuadAttrValue) + ;; because QuadAttrValue is Any, so that's the same as plain Any + ((Listof Any) . -> . QuadAttrs) (let-values ([(ks vs even?) (for/fold ([ks : (Listof QuadAttrKey) null][vs : (Listof QuadAttrValue) null][even? : Boolean #t]) ([x (in-list xs)]) @@ -155,6 +156,7 @@ (syntax-case stx () [(_ id) (with-syntax ([id? (format-id #'id "~a?" #'id)] + [IdQuad (format-id #'id "~aQuad" (string-titlecase (symbol->string (syntax->datum #'id))))] [quads->id (format-id #'id "quads->~a" #'id)]) #'(begin ;; quad converter @@ -162,21 +164,22 @@ ((Listof Quad) . -> . Quad) (apply id (gather-common-attrs qs) qs)) + ;; v1 of quad maker #;(define/typed (id [attrs #f] . xs) - (case-> - (-> Quad) - (((U False QuadAttrs HashableList)) #:rest QuadListItem . ->* . Quad)) - (quad 'id (cond - ;; need this cast because no predicate can be made for QuadAttrs - [(quad-attrs? attrs) (cast attrs QuadAttrs)] - [(list? attrs) - (if (HashableList? attrs) - (quadattrs attrs) - (error 'id "got non-hashable list ~a" attrs))] - [else (quadattrs '())]) (assert xs QuadList?))) + (case-> + (-> Quad) + (((U False QuadAttrs HashableList)) #:rest QuadListItem . ->* . Quad)) + (quad 'id (cond + ;; need this cast because no predicate can be made for QuadAttrs + [(quad-attrs? attrs) (cast attrs QuadAttrs)] + [(list? attrs) + (if (HashableList? attrs) + (quadattrs attrs) + (error 'id "got non-hashable list ~a" attrs))] + [else (quadattrs '())]) (assert xs QuadList?))) - ;; much slower than version above ... why? - (define/typed id + ;; v2: much slower than v1 ... why? + #;(define/typed id (case-> (((U False QuadAttrs HashableList)) #:rest QuadListItem . ->* . Quad) (-> Quad)) @@ -187,13 +190,24 @@ (quadattrs attrs) attrs) (quadattrs null)) xs)] - [else (displayln "making quado") (quad 'id (quadattrs null) null)])) + [() (quad 'id (quadattrs null) null)])) + + (struct IdQuad quad () #:transparent) + + ;; version 3 + ;; dummy kw arg is needed to typecheck correctly + (define/typed (id [attrs #f] #:zzz [zzz 0] . xs) + (() ((U False QuadAttrs HashableList) #:zzz Zero) #:rest QuadListItem . ->* . Quad) + (IdQuad 'id (if attrs + (if (list? attrs) + (make-quadattrs attrs) + attrs) + (make-quadattrs null)) xs)) + (: id? (Any . -> . Boolean)) (define (id? x) - (and (quad? x) (equal? (quad-name x) 'id))) - - ))])) + (and (quad? x) (equal? (quad-name x) 'id)))))])) (define/typed (whitespace? x [nbsp? #f]) ((Any) (Boolean) . ->* . Boolean) @@ -250,7 +264,6 @@ (define-quad-type box) -(begin (define-quad-type spacer) (define-quad-type kern) (define-quad-type optical-kern) @@ -271,5 +284,5 @@ (define-break-type page) (define-break-type column) (define-break-type block) -(define-break-type line)) +(define-break-type line)