diff options
Diffstat (limited to 'module/language/tree-il.scm')
-rw-r--r-- | module/language/tree-il.scm | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index c2f090575..a8169aa4c 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -35,6 +35,7 @@ <toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp <conditional> conditional? make-conditional conditional-src conditional-test conditional-consequent conditional-alternate <call> call? make-call call-src call-proc call-args + <primcall> primcall? make-primcall primcall-src primcall-name primcall-args <sequence> sequence? make-sequence sequence-src sequence-exps <lambda> lambda? make-lambda lambda-src lambda-meta lambda-body <lambda-case> lambda-case? make-lambda-case lambda-case-src @@ -119,6 +120,7 @@ ;; (<toplevel-define> name exp) ;; (<conditional> test consequent alternate) ;; (<call> proc args) + ;; (<primcall> name args) ;; (<sequence> exps) ;; (<lambda> meta body) ;; (<lambda-case> req opt rest kw inits gensyms body alternate) @@ -152,6 +154,9 @@ ((call ,proc . ,args) (make-call loc (retrans proc) (map retrans args))) + ((primcall ,name . ,args) + (make-primcall loc name (map retrans args))) + ((if ,test ,consequent ,alternate) (make-conditional loc (retrans test) (retrans consequent) (retrans alternate))) @@ -256,6 +261,9 @@ ((<call> proc args) `(call ,(unparse-tree-il proc) ,@(map unparse-tree-il args))) + ((<primcall> name args) + `(primcall ,name ,@(map unparse-tree-il args))) + ((<conditional> test consequent alternate) `(if ,(unparse-tree-il test) ,(unparse-tree-il consequent) ,(unparse-tree-il alternate))) @@ -339,6 +347,9 @@ ((<call> proc args) `(,(tree-il->scheme proc) ,@(map tree-il->scheme args))) + ((<primcall> name args) + `(,name ,@(map tree-il->scheme args))) + ((<conditional> test consequent alternate) (if (void? alternate) `(if ,(tree-il->scheme test) ,(tree-il->scheme consequent)) @@ -510,6 +521,8 @@ This is an implementation of `foldts' as described by Andy Wingo in (loop test (down tree result)))))) ((<call> proc args) (up tree (loop (cons proc args) (down tree result)))) + ((<primcall> name args) + (up tree (loop args (down tree result)))) ((<sequence> exps) (up tree (loop exps (down tree result)))) ((<lambda> body) @@ -584,6 +597,8 @@ This is an implementation of `foldts' as described by Andy Wingo in ((<call> proc args) (let-values (((seed ...) (foldts proc seed ...))) (fold-values foldts args seed ...))) + ((<primcall> name args) + (fold-values foldts args seed ...)) ((<sequence> exps) (fold-values foldts exps seed ...)) ((<lambda> body) @@ -638,6 +653,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (call-proc x) (lp proc)) (set! (call-args x) (map lp args))) + ((<primcall> name args) + (set! (primcall-args x) (map lp args))) + ((<conditional> test consequent alternate) (set! (conditional-test x) (lp test)) (set! (conditional-consequent x) (lp consequent)) @@ -722,6 +740,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (call-proc x) (lp proc)) (set! (call-args x) (map lp args))) + ((<primcall> name args) + (set! (primcall-args x) (map lp args))) + ((<conditional> test consequent alternate) (set! (conditional-test x) (lp test)) (set! (conditional-consequent x) (lp consequent)) |