+
+(defun make-function-binding (fname)
+ (make-binding fname 'function (gvarname fname)))
+
+(defun compile-function-definition (list)
+ (compile-lambda (car list) (cdr list)))
+
+(defun translate-function (name)
+ (let ((b (lookup-in-lexenv name *environment* 'function)))
+ (binding-value b)))
+
+(define-compilation flet (definitions &rest body)
+ (let* ((fnames (mapcar #'car definitions))
+ (fbody (mapcar #'cdr definitions))
+ (cfuncs (mapcar #'compile-function-definition fbody))
+ (*environment*
+ (extend-lexenv (mapcar #'make-function-binding fnames)
+ *environment*
+ 'function)))
+ (concat "(function("
+ (join (mapcar #'translate-function fnames) ",")
+ "){" *newline*
+ (let ((body (ls-compile-block body t)))
+ (indent body))
+ "})(" (join cfuncs ",") ")")))
+
+(define-compilation labels (definitions &rest body)
+ (let* ((fnames (mapcar #'car definitions))
+ (fbody (mapcar #'cdr definitions))
+ (*environment*
+ (extend-lexenv (mapcar #'make-function-binding fnames)
+ *environment*
+ 'function))
+ (cfuncs (mapcar #'compile-function-definition fbody)))
+ (concat "(function(){" *newline*
+ (join (mapcar (lambda (func)
+ ())
+ definitions))
+ (let ((body (ls-compile-block body t)))
+ (indent body))
+ "})")))
+
+
+
+(defvar *compiling-file* nil)