;; An attempt to create a minimal linear stack machine, inspired by Henry
;; Baker's Linear Lisp machine.

(module linear mzscheme

  ;; Suppose we have a set of primitive functions (think + - * / for
  ;; now), what are the primitives necessary to create a conservative
  ;; stack machine, which can use these function to compute operations
  ;; on ATOMs according to the following rules:

  ;; * The machine stores all data in a binary tree of pairs.

  ;; * Each half of a pair is either:
  ;;     - an ATOM
  ;;     - another PAIR
  ;;     - NULL
  
  ;; * PAIRS are never created nor distroyed. Each operation on the
  ;;   tree conserves the number of pairs.

  ;; * ATOMS are thought of as abstract. They might be nonlinear
  ;;   objects, numbers or any kind of substructure not accessible by
  ;;   the machine.
  

  ;; All conservative operations on a tree can be represented by
  ;; cyclic permutation of pointers. This includes NULL
  ;; pointers. ATOMS behave as NULL pointers.

  ;; In order to simplify the functions to operate on the binary
  ;; trees, we use pairs that contain boxes. In an actual low--level
  ;; implementation this can probably be simplified.

  (define (@ ref)   (unbox ref))
  (define (! ref v) (set-box! ref v))

  (define (tree-car t) (car (unbox t)))
  (define (tree-cdr t) (cdr (unbox t)))

  ;; Convert a non-boxed tree into a boxed one.
  
  (define (tree t)
    (box
     (if (pair? t)
         (cons (tree (car t))
               (tree (cdr t)))
         t)))

  (define (untree tree)
    (let ((t (unbox tree)))
      (if (pair? t)
          (cons (untree (car t))
                (untree (cdr t)))
          t)))
          
  ;; Using boxes, permutation of pointers can be expressed as a
  ;; function instead of a macro, which would use set-car! and
  ;; set-cdr!

  ;; I'm not going to be too bothered with efficiency since this can be
  ;; translated to compile time computations. What i am interested in
  ;; though is a numerical encoding of a binary tree that is visually
  ;; attractive. Therefore i use the following addressing scheme:

  ;;    1abc..

  ;; where a,b,c denote the sequential traversal decisions: 0=car,
  ;; 1=cdr. From a numeric address i create the traversal program,
  ;; which performs the reveral

  (define (addr->traversal addr car cdr)
    (when (< addr 1)
      (error 'invalid-addresss "~a" addr))
        
    (let next ((p '())
               (a addr))
      (if (= 1 a) p
          (next (cons
                 (if (zero? (bitwise-and a 1))
                     car cdr)
                 p)
                (arithmetic-shift a -1)))))
  


  (define (uncons x) (values (car x) (cdr x)))

  ;; Such a program can be executed by the following driver.

  (define (run-traversal tree program)
    (if (null? program)
        tree
        (let-values
            (((cxr p+) (uncons program)))
          (run-traversal (cxr tree) p+))))

  ;; From these two we can index a tree by address.
  (define (addr->box tree addr)
    (run-traversal tree
                   (addr->traversal addr
                                    tree-car
                                    tree-cdr)))
                
  ;; Then we can define cyclic permutation operation on references.
  (define (rotate x)
    (append (cdr x) (list (car x))))

  ;; the permutation (a b c) is translated to the parallell assignment
  ;; (a b c) <- (b c d)
  
  (define (cycle-refs! refs)
    (let ((values (map @ refs)))
      (for-each ! refs (rotate values))))
  
  (define (addrs->boxes tree . addrs)
    (map (lambda (a)
           (addr->box tree a))
         addrs))
         
  (define (cycle! tree . refs)
    (cycle-refs! (apply addrs->boxes tree refs))
    tree)
     

      
  


  

  ;; Now the big question. Is this enough to represent a set of Forth
  ;; stacks and the usual set of operations on them? A typical Forth
  ;; system contains 4 stacks:

  ;; - data stack
  ;; - return stack
  ;; - allot stack
  ;; - free stack

  ;; To gain some insight, it is probably easiest to start with 2
  ;; stacks, i.e. a free stack and a data stack. Suppose the only
  ;; atoms we are dealing with are NULL lists. An operation which
  ;; occurs frequently is the transfer of a cell from one stack to
  ;; another. This occurs for example in DROP.

  ;; Suppose we encode the two stacks as (D . F), where each of D and
  ;; F are a list of NULLs. The operation then becomes

  ;;   ((x . D) . F) -> (D . (x . F))

  ;; To write this as a permutation, we need to identify the (pointer)
  ;; nodes which participate in the permutation, and order them. From
  ;; a graphic representation, the nodes are easily identified as (a)
  ;; (a d) and (d).
  

  
  

)