;;; Tree-il canonicalizer
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
#:use-module (language tree-il)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
- #:export (canonicalize!))
+ #:export (canonicalize))
(define (tree-il-any proc exp)
(tree-il-fold (lambda (exp res)
(or res (proc exp)))
- (lambda (exp res)
- (or res (proc exp)))
(lambda (exp res) res)
#f exp))
-(define (canonicalize! x)
- (post-order!
+(define (canonicalize x)
+ (post-order
(lambda (x)
(match x
(($ <let> src () () () body)
body)
(($ <fix> src () () () body)
body)
- (($ <dynlet> src () () body)
- body)
+ (($ <lambda> src meta #f)
+ ;; Give a body to case-lambda with no clauses.
+ (make-lambda
+ src meta
+ (make-lambda-case
+ #f '() #f #f #f '() '()
+ (make-primcall
+ #f
+ 'throw
+ (list (make-const #f 'wrong-number-of-args)
+ (make-const #f #f)
+ (make-const #f "Wrong number of arguments")
+ (make-const #f '())
+ (make-const #f #f)))
+ #f)))
(($ <prompt> src tag body handler)
(define (escape-only? handler)
(match handler
;; thunk. Sad but true.
(if (or (escape-only? handler)
(thunk-application? body))
- #f
+ x
(make-prompt src tag (make-thunk-application body) handler)))
- (_ #f)))
+ (_ x)))
x))