Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
115 lines (92 sloc) 3.33 KB
(define (vec-getter i)
(lambda (vec)
(vector-ref vec i)))
(define unique-obj (list #f))
(define (make-node type data lineno colno)
[unique-obj type data #f lineno colno])
(define (make-node-w/extra type data extra lineno colno)
[unique-obj type data extra lineno colno])
(define (copy-node node data)
(make-node-w/extra (node-type node)
data
(node-extra node)
(node-lineno node)
(node-colno node)))
(define node-type (vec-getter 1))
(define node-data (vec-getter 2))
(define node-extra (vec-getter 3))
(define node-lineno (vec-getter 4))
(define node-colno (vec-getter 5))
(define (assert-node node)
(if (not (and (vector? node)
(== (vector-ref node 0) unique-obj)))
(begin
(pp node)
(throw (Error (str "not a node"))))))
(define (assert-type node type)
(if (not (== (node-type node) type))
(throw (Error (str "expected node type " type ": " node)))))
(define (is-type? node type)
(assert-node node)
(== (node-type node) type))
(define (is-atom? node) (or (is-type? node 'ATOM)
(and (is-type? node 'LIST)
(null? (node-data node)))))
(define (is-list? node) (and (is-type? node 'LIST)
(not (null? (node-data node)))))
(define (is-vector? node) (is-type? node 'VECTOR))
(define (is-dict? node) (is-type? node 'DICT))
(define (is-empty-list? node)
(and (is-type? node 'LIST)
(null? (node-data node))))
(define (make-atom type parent)
(make-node 'ATOM type
(node-lineno parent)
(node-colno parent)))
(define (make-list . children)
(make-list* children))
(define (make-list* children)
(let ((first (car children)))
(make-node 'LIST children
(node-lineno first)
(node-colno first))))
(define (make-empty-list parent)
(make-node 'LIST '()
(node-lineno parent)
(node-colno parent)))
(define (prepend node lst)
(make-node 'LIST
(cons node (node-data lst))
(node-lineno node)
(node-colno node)))
(define (map-children func lst)
(make-node 'LIST
(map func (node-data lst))
(node-lineno lst)
(node-colno lst)))
(define (first node)
(car (node-data node)))
(define (first* node)
(node-data (car (node-data node))))
(set! module.exports {:make-node make-node
:make-node-w/extra make-node-w/extra
:copy-node copy-node
:node-type node-type
:node-data node-data
:node-extra node-extra
:node-lineno node-lineno
:node-colno node-colno
:type? is-type?
:atom? is-atom?
:list? is-list?
:vector? is-vector?
:dict? is-dict?
:empty-list? is-empty-list?
:make-list make-list
:make-list* make-list*
:make-empty-list make-empty-list
:make-atom make-atom
:prepend prepend
:map-children map-children
:first first
:first* first*})