rosetta modular numbers

#lang racket
(require (for-syntax racket/generic syntax/parse))

; Normal Racket numbers are represented as (num x #f).
; Integers modulo p are represented as (num x p).

(module ring racket
  (provide $ (rename-out [new+ +] [new- -] [new* *] [newexpt expt]))
  (require math racket/generic (for-syntax racket/generic syntax/parse))
  
  (define-generics ring-elm
    (add  ring-elm . xs)
    (sub  ring-elm . xs)
    (mult ring-elm . xs)
    (pow  ring-elm m))
  
  (define-syntax (define-binop stx)
    (syntax-parse stx
      [(_ op r-op mod-op)
       #'(define (op n . ns)
           (define p  (num-p n))
           (define xs (map num-x (map $ (cons n ns))))
           (if p 
               (num (with-modulus p (apply mod-op xs)) p)
               (num (apply r-op xs) p)))]))
  
  (struct num (x p)
    #:transparent
    #:methods gen:custom-write
    [(define (write-proc v port mode)
       (if (and (num? v) (num-p v))
           (display (~a (num-x v) " mod " (num-p v)) port)
           (display (~a (num-x v)) port)))]
    #:methods gen:ring-elm
    [(define-binop add + mod+)
     (define-binop sub - mod-)
     (define-binop mult * mod*)
     (define (pow n m)
       (match-define (num x p) n)
       (num (if p (modular-expt x m p) (expt x m)) p))])
  
  (define ($ x [p (current-modulus)])
    (cond [(num? x) x]
          [(= p 1) (num x #f)]
          [else    (num x p)]))
  
  (define (new+ x . xs) (apply add  ($ x) xs))
  (define (new- x . xs) (apply sub  ($ x) xs))
  (define (new* x . xs) (apply mult ($ x) xs))
  (define (newexpt x m) (pow ($ x) m)))

(require 'ring)

(define (f x)
  (+ (expt x 2) (- x 1)))

(f 4)
(f ($ 5 7))
(f 5.5)