#lang scheme/base

 ;; interfaces

 ;; implementations

 ;; tools

 ;; debug


(define/invoke (ring^ vec^) (staged-number@ vec-list@))

;; Convert symbolic <-> packed representation.
(define (tree-map fn)
  (lambda (x)
    (let sub ((x x))
       ((null? x) x)
       ((pair? x) (cons (sub (car x)) (sub (cdr x))))
       (else (fn x))))))
(define pack
   (lambda (x)
     (if (symbol? x)
         (make-variable (symbol->identifier x))
         (make-number x)))))
(define unpack
   (lambda (x)
      ((variable? x) (syntax->datum (variable-id x)))
      ((number? x) (number-value x))
      (else (error 'unpack-unknown "~a" x))))))

;; Convert from memoized form back to nested expression.  (This uses
;; the `bindings' parameter.)
(define (un-memoize expr)
   (lambda (x)
      ((variable? expr)
       (let ((e (variable->expr expr)))
         (if e (un-memoize e) expr)))
      (else expr)))))


(current-pack pack)
(current-unpack unpack)

(define (matrix sym) (list->mat (pack sym)))

(define a (matrix '((a 0) (0 b))))
(define b (matrix '((b 0) (d a))))

(require scheme/pretty)
(define (print-mat m)
  (pretty-print (unpack (mat->list m))))

(define m
  (matrix '(( 2 -1  0)
            (-1  2 -1)
            ( 0 -1  2))))

;; CT predicates are used for compile-time decisions: they don't have
;; a run-time equivalent.
(define (ctp:> a b)
  (let ((na (->number a))
        (nb (->number b)))
    (or (and a b) (error 'ct:>))
    (> na nb)))

(define (gauss-jordan m)
  (mat-gauss-jordan 2-norm ctp:> m))

(define (mat-inv m)
  (gauss-jordan (mat-cat-columns m (mat-one (mat-nb-rows m)))))
;; (define m1 (mat-inv m))

;; (print-mat m1)
;; (print-mat (mat-mul m1 m))

;(emit (pack '(a 10)))
;(emit (pack '(b 10)))
;(emit (pack '(c 12)))

(define eq1
  (matrix '(( 2 -1  0  a)
            (-1  2 -1  b)
            ( 0 -1  2  c))))

(print-mat (gauss-jordan eq1))

; (parameterize ((bindings '()))
  (emit (pack '(X 123)))
  (unpack (add (pack 'X) (pack 'X)))
; )

(require (for-syntax scheme/base))

(define-syntax (id=? stx)
  (syntax-case stx ()
    ((_ a b)
     #`(quote #,(bound-identifier=? #'a #'b)))))