;;;; numeric-macros.scm  -*- Scheme -*-
;;;; Kon Lovett, Aug '18
;;;; Kon Lovett, Aug '10

(module numeric-macros

(;export
  ++
  --
  fx++
  fx--
  fp++
  fp--
  fl++
  fl--
  ++!
  --!
  fx++!
  fx--!
  fp++!
  fp--!
  fl++!
  fl--!)

(import scheme
  (chicken base)
  (chicken fixnum)
  (chicken flonum)
  (chicken syntax))

(import-for-syntax (only moremacros set!-op type-case))

;;

; The "numbers" extension provides number predicates & operators but
; they cannot be relied upon in the expansion environment.

(define-syntax numeric-op/1
  (er-macro-transformer
    (lambda (exp ren cmp)
      (let (
        (op (cadr exp))
        (ops (caddr exp)) )
        (let (
          (fx-op (car ops))
          (fl-op (cadr ops))
          (gn-op (caddr ops)) )
          `(define-syntax ,op
            (er-macro-transformer
              (lambda (exp ren cmp)
                (let (
                  (n (cadr exp)) )
                  (type-case n
                    ; Constant expression
                    (fixnum   (list ',fx-op n 1))
                    (flonum   (list ',fl-op n 1.0))
                    ; Unknown type or non-constant expression
                    (else     (list ',gn-op n 1)) ) ) ) ) ) ) ) ) ) )

;;; Immutable

(numeric-op/1 ++ (fx+ fp+ +))

(numeric-op/1 -- (fx- fp- -))

(define-syntax fx++
	(syntax-rules ()
		((fx++ ?n) (fx+ ?n 1)) ) )

(define-syntax fx--
	(syntax-rules ()
		((fx-- ?n) (fx- ?n 1)) ) )

(define-syntax fp++
	(syntax-rules ()
		((fp++ ?n) (fp+ ?n 1.0)) ) )

(define-syntax fp--
	(syntax-rules ()
		((_ ?n) (fp- ?n 1.0)) ) )

(define-syntax fl++
	(syntax-rules ()
		((fp-- ?n) (fp+ ?n 1.0)) ) )

(define-syntax fl--
	(syntax-rules ()
		((fl-- ?n) (fp- ?n 1.0)) ) )

;;; Mutable

(define-syntax ++!
	(syntax-rules ()
		((++! ?v) (set!-op ?v + <> 1)) ) )

(define-syntax --!
	(syntax-rules ()
		((--! ?v) (set!-op ?v - <> 1)) ) )

(define-syntax fx++!
	(syntax-rules ()
		((fx++! ?v) (set!-op ?v fx+ <> 1)) ) )

(define-syntax fx--!
	(syntax-rules ()
		((fx--! ?v) (set!-op ?v fx- <> 1)) ) )

(define-syntax fp++!
	(syntax-rules ()
		((fp++! ?v) (set!-op ?v fp+ <> 1.0)) ) )

(define-syntax fp--!
	(syntax-rules ()
		((fp--! ?v) (set!-op ?v fp- <> 1.0)) ) )

(define-syntax fl++!
	(syntax-rules ()
		((fl++! ?v) (set!-op ?v fp+ <> 1.0)) ) )

(define-syntax fl--!
	(syntax-rules ()
		((fl--! ?v) (set!-op ?v fp- <> 1.0)) ) )

) ;module numeric-macros