AST Prototype

another_ast_prototype.scm

(use-modules (srfi srfi-1))

;; "record-types" will end up looking something like this:
;;
;; ((camera (matrix #:mat4))
;;  (model (position #:vec3)
;;         (matrix #:mat4)
;;         (clip-space (* (camera matrix) (model matrix) (model position)))))

(define record-types '())

(define (find-record record-name)
  (find (lambda (record) (eq? (car record) record-name)) record-types))

(define (create-record! record-name)  
  (let ([found (find-record record-name)])
    (if found #f
        (set! record-types (cons `(,record-name) record-types)))))

(define (find-variable record-name variable-name)
  (let ([record (find-record record-name)])
    (if record
        (find (lambda (variable) (eq? (car variable) variable-name)) (cdr record))
        #f)))

(define (update-record! record-name variable-name data)
  (let ([record (find-record record-name)]
        [variable (find-variable record-name variable-name)])
    (if (and record (not variable))
        (let* ([var-line (cons variable-name data)]
               [all-vars (cons var-line (cdr record))]
               [new-record (cons record-name all-vars)])
          (set! record-types
                (map (lambda (record)
                       (cond
                        [(equal? (car record) record-name) new-record]
                        [else record])) record-types)))
        #f)))

(define (value-or-path record-name variable-name)
  (let ([found (find-variable record-name variable-name)])
    (if found
        (let* ([value (cdr found)]
               [first (car value)])
          (if (keyword? first) `(,record-name ,variable-name) first))
        #f))) ;; maybe throw an error if not found


(define identity-matrix
  '(1 0 0 0
    0 1 0 0
    0 0 1 0
    0 0 0 1))

;; ok, actually do something with the above methods:

(create-record! 'camera)
(update-record! 'camera 'identity `(,identity-matrix))
;;(update-record! 'camera 'matrix '(#:mat4))
(update-record! 'camera 'matrix `(,(value-or-path 'camera 'identity)))

(create-record! 'model)
(update-record! 'model 'position '(#:vec3 #:vertex))
(update-record! 'model 'matrix '(#:mat4))
(update-record! 'model 'clip-space `((* ,(value-or-path 'camera 'matrix)
                                        ,(value-or-path 'model 'matrix)
                                        ,(value-or-path 'model 'position))))

(display "\n\nThe following is the token stream for (model clip-space):\n")
(display "\n  ")
(display (value-or-path 'model 'clip-space))
(display "\n\n")

;; so next, I want to try to make the above happen in the following
;; syntax, without bleeding anything like (model matrix) into the
;; global scope:
;;
;; (struct* <camera>
;;   (identity identity-matrix)
;;   (matrix #:mat4))
;;
;; (struct* <model>
;;   (position #:vec3 #:vertex)
;;   (matrix #:mat4))
;;   (clip-space (* (camera identity) (model matrix) (model position)))
;;
  
;; other things to do:
;; - clean up the above code, pin down a specific terminology
;;
;; - (find-attributes) (find-uniforms) methods?  these could scan the
;;   output of (find-variable) instead of the entire tree
;;
;; - set union on the results of different find-attributes
;;
;; - pretty printing the token stream?
;;
;; - can syntax rules be nested?  eg, rules which apply to interior tokens?
;;
;; - if so, it would be neat if you could refactor this so that it
;;   doesn't rely on any global state
;;