;; cat object representation

(module rep mzscheme




  
  ;; CAT used to be interpreted, with everything code stored in an
  ;; AST, and a cached functional representation. I decided to make
  ;; the step to a fully macro-interpreted version, but on the
  ;; condition I did not have to give up debuggin. After an email to
  ;; the PLT list, i found out about annotated functions.
  

  ;; If an mzscheme structure types has a property prop:procedure
  ;; present, a structure can assume the behaviour of a procedure:
  
  ;; * integer -> procedure is present in a field at index
  ;; * procedure -> call the procedure with (instance . other-arguments)

  ;;  (define (word-run w . args)
  ;;    (apply (word-proc w) args))
  
  (define (word-run w . args)
    (with-continuation-mark 'word w
                            (apply (word-proc w) args)))

  (define-values
    (struct:word make-word-internal word? word-ref word-set!)
    (make-struct-type
     'word    ;; name-symbol
     #f       ;; super-struct-type
     4        ;; init-field-k
     0        ;; auto-field-k
     #f       ;; auto-v
     null     ;; prop-value-list
     #f       ;; inspector or false
     word-run ;; word-run or 0
     
     ))

;;   ;; from Jos Koot on PLT-list:
;;   (define-syntax kappa
;;     (syntax-rules ()
;;       ((_ . rest) (make-proc (lambda . rest) '(lambda . rest)))))

;;   (define-values (proc-descr make-proc proc? ignore0 ignore2)
;;     (make-struct-type 'proc #f 2 0 'na () (make-inspector) 0))

;;   (kappa (x) x) --> #(struct:proc #<procedure> (lambda (x) x))


  ;; (printf "LOADING REP.SS\n")


  (define (word-proc w)      (word-ref w 0))  ;; procedural rep
  (define (word-source w)    (word-ref w 1))  ;; source rep
  (define (word-semantics w) (word-ref w 2))  ;; compiler (can be #f -> anonymous)
  (define (word-dynamic? w)  (word-ref w 3))  ;; run-time compilation

  (define (word-proc! w x)     (word-set! w 0 x)) 
  (define (word-dynamic! w x)  (word-set! w 3 x)) 

  
  (define (make-word semantics src proc)
    (unless (symbol? semantics)
      
      (error 'improper-semantics
             "make-word got improper semantics: ~a, in: ~a"
             semantics src))

    (make-word-internal proc src semantics
                        #f
                        ))

  ;; For redefine
  (define (word-become! word proto)
    (define (copy i)
      (word-set! word i (word-ref proto i)))
    (copy 0)
    (copy 1)
    (copy 2)
    word)
    

  ;; (define (word-compiled! w c) (word-set! w 3 c))

  ;; Interface
  (provide   make-word
             word-become!
             word?
             word-source
             word-semantics
             word-dynamic?
             word-dynamic!
             word-proc!
             ;; word-semantics!
             ;; word-compiled
             ;; word-compiled!
             )

)