Solution to the 4th question in https://www.student.cs.uwaterloo.ca/~cs135/assns/a02/a02.pdf

racket-pizza-price.rkt

#lang racket

(define report-no-size-error
  (lambda (size)
    (error "We do not have size you ordered:" size)))

(define warning-coupon-not-suitable
  (lambda (coupon-code)
    (begin
      (display
       (string-append "Your order cannot use coupon '"
                      (symbol->string coupon-code)
                      "'."))
      (newline))))

(define pizza-size-price-table
  '([small  . 5]
    [medium . 7]
    [large  . 8.5]
    [xl     . 10]))

(define pizza-size-price
  (lambda (size)
    (cond
      [(assoc size pizza-size-price-table) => cdr]
      [else (report-no-size-error size)])))

(define pizza-standard-topping-price
  (lambda (amount)
    (* 0.75 amount)))

(define pizza-premium-topping-price
  (lambda (amount)
    (* 1.25 amount)))

(define regular-pizza-price
  (lambda (size ST-count PT-count)
    (+ (pizza-size-price size)
       (pizza-standard-topping-price ST-count)
       (pizza-premium-topping-price PT-count))))

(define pizza-size-down-casting-table
  '([medium . small]
    [large  . medium]
    [xl     . large]))

(define pizza-size-down-casting
  (lambda (size)
    (cond
      [(assoc size pizza-size-down-casting-table) => cdr]
      [else (report-no-size-error size)])))

(define pizza-price
  (lambda (size ST-count PT-count coupon-code)
    (cond
      [(eqv? coupon-code 'two-off)
       (- (regular-pizza-price size ST-count PT-count)
          2)]
      [(and (eqv? coupon-code 'upsize)
            (assoc size pizza-size-down-casting-table))
       (regular-pizza-price (pizza-size-down-casting size)
                            ST-count
                            PT-count)]
      [(eqv? coupon-code 'three-top)
       (regular-pizza-price size
                            (if (< ST-count 3)
                                0
                                (- ST-count 3))
                            PT-count)]
      [(eqv? coupon-code 'premium)
       (regular-pizza-price size (+ ST-count PT-count) 0)]
      [(and (eqv? coupon-code 'solo)
            (eqv? size 'small)
            (= ST-count 0)
            (= PT-count 2))
       6]
      [(and (eqv? coupon-code 'party)
            (eqv? size 'xl)
            (= ST-count 3)
            (= PT-count 0))
       11]
      [(and (eqv? coupon-code 'loaded)
            (eqv? size 'xl))
       15]
      [else
       (regular-pizza-price size ST-count PT-count)])))

racket-pizza-price.sls

#!r6rs

(library
 (racket-pizza)
 (export pizza-price pizza-sizes pizza-coupon-codes)
 (import (rnrs))
 
 (define report-no-size-error
   (lambda (size)
     (error "We do not have size you ordered:" size)))
 
 (define warning-coupon-not-suitable
   (lambda (coupon-code)
     (begin
       (display
        (string-append "Your order cannot use coupon '"
                       (symbol->string coupon-code)
                       "'."))
       (newline))))
 
 (define pizza-size-price-table
   '([small  . 5]
     [medium . 7]
     [large  . 8.5]
     [xl     . 10]))
 
 (define pizza-size-price
   (lambda (size)
     (cond
       [(assoc size pizza-size-price-table) => cdr]
       [else (report-no-size-error size)])))
 
 (define pizza-standard-topping-price
   (lambda (amount)
     (* 0.75 amount)))
 
 (define pizza-premium-topping-price
   (lambda (amount)
     (* 1.25 amount)))
 
 (define regular-pizza-price
   (lambda (size ST-count PT-count)
     (+ (pizza-size-price size)
        (pizza-standard-topping-price ST-count)
        (pizza-premium-topping-price PT-count))))
 
 (define pizza-size-down-casting-table
   '([medium . small]
     [large  . medium]
     [xl     . large]))
 
 (define pizza-size-down-casting
   (lambda (size)
     (cond
       [(assoc size pizza-size-down-casting-table) => cdr]
       [else (report-no-size-error size)])))
 
 (define-syntax coupon-rules
   (lambda (stx)
     (syntax-case stx ()
       [(k (coupon-name check-apply apply-coupon) ...)
        (with-syntax ([size (datum->syntax #'k 'size)]
                      [ST-count (datum->syntax #'k 'ST-count)]
                      [PT-count (datum->syntax #'k 'PT-count)])
          #'(list
             (list coupon-name
                   (lambda (size ST-count PT-count) check-apply)
                   (lambda (size ST-count PT-count) apply-coupon))
             ...))])))
 
 (define pizza-coupon-rules
   (coupon-rules
    ['none #t (regular-pizza-price size ST-count PT-count)]
    ['two-off
     #t
     (- (regular-pizza-price size ST-count PT-count) 2)]
    ['upsize
     (member size '(xl large medium))
     (regular-pizza-price (pizza-size-down-casting size) ST-count PT-count)]
    ['three-top
     #t
     (regular-pizza-price size
                          (cond
                            [(<= ST-count 3) 0]
                            [else (- ST-count 3)])
                          PT-count)]
    ['premium #t (regular-pizza-price size (+ ST-count PT-count) 0)]
    ['solo
     (and (eqv? size 'small)
          (= 0 ST-count)
          (= 2 PT-count))
     6]
    ['party
     (and (eqv? size 'xl)
          (= 3 ST-count)
          (= 0 PT-count))
     11]
    ['loaded
     (eqv? size 'xl)
     15]))
 
 (define pizza-price
   (lambda (size ST-count PT-count coupon-code)
     (let ([pizza-spec (list size ST-count PT-count)])
       (cond
         [(assoc coupon-code pizza-coupon-rules)
          => (lambda (x)
               (let ([check-f (cadr x)]
                     [price-f (caddr x)])
                 (if (apply check-f pizza-spec)
                     (apply price-f pizza-spec)
                     (begin
                       (warning-coupon-not-suitable coupon-code)
                       (apply regular-pizza-price pizza-spec)))))]
         [else (apply regular-pizza-price pizza-spec)]))))
 
 (define pizza-sizes
   (map car pizza-size-price-table))
 
 (define pizza-coupon-codes
   (map car pizza-coupon-rules))
 )