1 ;;;; File: "node.scm", Time-stamp: <2006-05-08 16:04:37 feeley>
3 ;;;; Copyright (C) 2004-2009 by Marc Feeley and Vincent St-Amour
4 ;;;; All Rights Reserved.
6 ;; Syntax-tree node representation.
9 extender: define-type-of-node
14 (define-type-of-node cst
18 (define-type-of-node ref
22 (define-type-of-node def
26 (define-type-of-node set
30 (define-type-of-node if
33 (define-type-of-node prc
39 (define-type-of-node call
42 (define-type-of-node seq
45 (define-type-of-node fix
52 (let ((val (cst-val node)))
57 (var-id (ref-var node)))
60 (var-id (def-var node))
61 (node->expr (child1 node))))
64 (var-id (set-var node))
65 (node->expr (child1 node))))
68 (node->expr (child1 node))
69 (node->expr (child2 node))
70 (node->expr (child3 node))))
72 (if (seq? (child1 node))
74 (cons (build-pattern (prc-params node) (prc-rest? node))
75 (nodes->exprs (node-children (child1 node)))))
77 (build-pattern (prc-params node) (prc-rest? node))
78 (node->expr (child1 node)))))
80 (map node->expr (node-children node)))
82 (let ((children (node-children node)))
83 (cond ((null? children)
85 ((null? (cdr children))
86 (node->expr (car children)))
89 (nodes->exprs children))))))
91 (let ((children (node-children node)))
93 (map (lambda (var val)
97 (take (- (length children) 1) children))
98 (node->expr (list-ref children (- (length children) 1))))))
100 (compiler-error "unknown expression type" node)))))
106 (if (seq? (car nodes))
107 (append (nodes->exprs (node-children (car nodes)))
108 (nodes->exprs (cdr nodes)))
109 (cons (node->expr (car nodes))
110 (nodes->exprs (cdr nodes)))))))
112 (define build-pattern
113 (lambda (params rest?)
114 (cond ((null? params)
116 ((null? (cdr params))
118 (var-id (car params))
119 (list (var-id (car params)))))
121 (cons (var-id (car params))
122 (build-pattern (cdr params) rest?))))))