From 7640625712324de7066f18d6d6c480be2c3a7dfd Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 25 Jan 2015 17:25:07 -0800 Subject: [PATCH] victory over polymorphism --- quad/quads-typed.rkt | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index bcbb1db6..ea45f142 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -1,9 +1,9 @@ #lang typed/racket/base (require (for-syntax typed/racket/base racket/syntax)) -(require/typed racket/list [flatten ((Listof QuadAttrPair) . -> . (Listof QuadAttrPair))] - [empty? ((Listof Any) . -> . Boolean)]) -(require/typed sugar/list [trimf ((Listof Any) Procedure . -> . (Listof Quad))] - [filter-split ((Listof Any) Procedure . -> . (Listof (Listof Quad)))]) +(require/typed racket/list [flatten (All (A) ((Listof A) -> (Listof A)))] + [empty? (All (A) ((Listof A) -> Boolean))]) +(require/typed sugar/list [trimf (All (A) ((Listof A) (A . -> . Boolean) -> (Listof A)))] + [filter-split (All (A) ((Listof A) (A . -> . Boolean) -> (Listof (Listof A))))]) (require sugar/debug) (provide (all-defined-out)) @@ -101,15 +101,15 @@ (define-syntax (define-break-type stx) (syntax-case stx () - [(_ id) - (with-syntax ([split-on-id-breaks (format-id #'id "split-on-~a-breaks" #'id)] - [id-break (format-id #'id "~a-break" #'id)] - [id-break? (format-id #'id "~a-break?" #'id)] - [multi-id (format-id #'id "multi~a" #'id)] - [multi-id? (format-id #'id "multi~a?" #'id)] - [quads->multi-id (format-id #'id "quads->multi~a" #'id)]) + [(_ Id) + (with-syntax ([split-on-id-breaks (format-id #'Id "split-on-~a-breaks" (string-downcase (symbol->string (syntax->datum #'Id))))] + [id-break (format-id #'Id "~a-break" #'Id)] + [id-break? (format-id #'Id "~a-break?" #'Id)] + [multi-id (format-id #'Id "multi~a" #'Id)] + [multi-id? (format-id #'Id "multi~a?" #'Id)] + [quads->multi-id (format-id #'Id "quads->multi~a" #'Id)]) #'(begin - (define-quad-type id) + (define-quad-type Id) (define-quad-type id-break) (define-quad-type multi-id) ;; breaker @@ -126,4 +126,5 @@ (define-quad-type Word) (define-break-type Block) -(split-on-Block-breaks (list (word) (block-break) (word))) +(define-break-type Page) +(split-on-page-breaks (list (word) (page-break) (word)))