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

(module numeric-macros

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

  (import scheme chicken)

  (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 f r x)
  (let ((op (cadr f))
        (ops (caddr f)) )
    (let ((fx-op (car ops))
          (fl-op (cadr ops))
          (gn-op (caddr ops)) )
      `(define-syntax (,op f r x)
        (let ((n (cadr f)))
          (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 ()
		((_ ?n) (fx+ ?n 1)) ) )

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

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

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

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

(define-syntax fl--
	(syntax-rules ()
		((_ ?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 ()
		((_ ?v) (set!/op ?v fx+ <> 1)) ) )

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

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

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

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

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

) ;module numeric-macros