;; poke - a forth vm

;; this is to serve as the new core for PF, an maybe a kind of unix
;; shell. emphasis is on small size and simplicity:

;; * uses linear lists as basic data structure, no vectors. (see also linear.ss)
;; * primitives are C functions taking a single argument, the vm state.

(module poke mzscheme

(require "cgen.ss")

;; extend standard c generator


(extend-expressions
 (transformer

  (define (S) `(-> s S))   ;; data stack
  (define (F) `(-> s F))   ;; free list
  (define (R) `(-> s R))   ;; return stack

  (define (car x) `(index ,x 0))
  (define (cdr x) `(index ,x 1))
  
  (define (top)   `(car (S)))
  (define (2nd)   `(car (cdr (S))))

  ))


(extend-statements
 (transformer

  ;; primitive linear operations (permutations)
  (define (cycle2 a b)
    `(bind
      (((typeof ,a) t ,a))
      (= ,a ,b)
      (= ,b t)))

  (define (cycle3 a b c)
    `(bind
      (((typeof ,a) t ,a))
      (= ,a ,b)
      (= ,b ,c)
      (= ,c t)))

  ;; move cell from one list to another
  (define (move from to)
    `(cycle3 (cdr ,from) ,to ,from))

  ;; primitive C functions
  (define (word name . body)
    `(def ((void ,name) (state_t s)) ,@body))

  ;; during bootstrapping, nothing is managed, and drop will not care
  ;; about data types.

  (define (lit x) `(statements (save) (= (top) ,x)))

  ;; minimal compiler
  (define (forth . lst)
    `(statements
      ,@(map (lambda (atom)
               (if (symbol? atom)
                   `(,atom)
                   `(lit ,atom)))
             lst)))
    
  

))


;; macro for loading poke files
(define-syntax poke
  (syntax-rules ()
    ((_ statement ...)
     (display
      (statement->string
       '(statements statement ...))))))

(poke

 (word save (move (F) (S)))
 (word drop (move (S) (F)))
 

 (word hello (forth 1 2 3))
 
 (top)
 (2nd)
 
 )

;; i'm thinking about using linked lists instead of cons cells, since
;; i can't seem to make sense of bootstrapping the type system. (it
;; looks like i need to solve both list + type system at the same
;; point for efficiency..)

;; some remarks:

;; * if there is no lowlevel access (raw pointers) then it doesn't
;;   matter how big the integers are.

;; tagged types:
;; - integers    2:
;; - floats      0: 
;; - cons cells  1: (-1 +3)

;; objects:
;; - symbols
;; - arrays
;; - anything else

;; implementation is at least 32 bit, objects are word aligned, this
;; gives 2 tag bits, 3 special types.



;; maybe it's best to start with the machine in baker's paper:
;; this only uses cons cells and atoms (symbols)

;; http://home.pipeline.com/~hbaker1/LinearLisp.html


)