;;; ecmalisp.lisp ---
-;; Copyright (C) 2012 David Vazquez
+;; Copyright (C) 2012, 2013 David Vazquez
;; Copyright (C) 2012 Raimon Grau
;; This program is free software: you can redistribute it and/or
(eval-when-compile
(%compile-defun ',name))
(fsetq ,name (named-lambda ,(symbol-name name) ,args
- ,@body))))
+ (block ,name ,@body)))))
(defmacro defun (name args &rest body)
`(%defun ,name ,args ,@body))
(defun null (x)
(eq x nil))
- (defmacro return (value)
+ (defmacro return (&optional value)
`(return-from nil ,value))
+ (defmacro while (condition &body body)
+ `(block nil (%while ,condition ,@body)))
+
(defun internp (name)
(in name *package*))
(defmacro dolist (iter &body body)
(let ((var (first iter))
(g!list (gensym)))
- `(let ((,g!list ,(second iter))
- (,var nil))
- (while ,g!list
- (setq ,var (car ,g!list))
- ,@body
- (setq ,g!list (cdr ,g!list)))
- ,(third iter))))
+ `(block nil
+ (let ((,g!list ,(second iter))
+ (,var nil))
+ (%while ,g!list
+ (setq ,var (car ,g!list))
+ ,@body
+ (setq ,g!list (cdr ,g!list)))
+ ,(third iter)))))
(defmacro dotimes (iter &body body)
(let ((g!to (gensym))
(var (first iter))
(to (second iter))
(result (third iter)))
- `(let ((,var 0)
- (,g!to ,to))
- (while (< ,var ,g!to)
- ,@body
- (incf ,var))
- ,result)))
+ `(block nil
+ (let ((,var 0)
+ (,g!to ,to))
+ (%while (< ,var ,g!to)
+ ,@body
+ (incf ,var))
+ ,result))))
(defmacro cond (&rest clausules)
(if (null clausules)
(defun every (function seq)
;; string
- (let ((ret t)
- (index 0)
+ (let ((index 0)
(size (length seq)))
- (while (and ret (< index size))
+ (while (< index size)
(unless (funcall function (char seq index))
- (setq ret nil))
+ (return-from every nil))
(incf index))
- ret))
+ t))
(defun assoc (x alist)
- (let ((found nil))
- (while (and alist (not found))
- (if (eql x (caar alist))
- (setq found t)
- (setq alist (cdr alist))))
- (car alist)))
+ (while alist
+ (if (eql x (caar alist))
+ (return)
+ (setq alist (cdr alist))))
+ (car alist))
(defun string= (s1 s2)
(equal s1 s2)))
(define-compilation quote (sexp)
(literal sexp))
-(define-compilation while (pred &rest body)
+(define-compilation %while (pred &rest body)
(concat "(function(){" *newline*
- (indent "while("
- (ls-compile pred env)
- " !== "
- (ls-compile nil) "){" *newline*
- (indent (ls-compile-block body env)))
- "}})()"))
+ (indent "while(" (ls-compile pred env) " !== " (ls-compile nil) "){" *newline*
+ (indent (ls-compile-block body env))
+ "}"
+ "return " (ls-compile nil) ";" *newline*)
+ "})()"))
(define-compilation function (x)
(cond
(concat "(function(){" *newline*
(indent "try {" *newline*
(indent "return " (ls-compile `(progn ,@body)
- (extend-lexenv b env 'block))) ";" *newline*
+ (extend-lexenv b env 'block))
+ ";" *newline*)
"}" *newline*
"catch (cf){" *newline*
" if (cf.type == 'block' && cf.id == " tr ")" *newline*
" else" *newline*
" throw cf;" *newline*
"}" *newline*)
- "})()" *newline*))))
+ "})()"))))
(define-compilation return-from (name &optional value)
(let ((b (lookup-in-lexenv name env 'block)))
"})})()")
(error (concat "Unknown block `" (symbol-name name) "'.")))))
+
+(define-compilation catch (id &rest body)
+ (concat "(function(){" *newline*
+ (indent "var id = " (ls-compile id env) ";" *newline*
+ "try {" *newline*
+ (indent "return " (ls-compile `(progn ,@body))
+ ";" *newline*)
+ "}" *newline*
+ "catch (cf){" *newline*
+ " if (cf.type == 'catch' && cf.id == id)" *newline*
+ " return cf.value;" *newline*
+ " else" *newline*
+ " throw cf;" *newline*
+ "}" *newline*)
+ "})()"))
+
+(define-compilation throw (id &optional value)
+ (concat "(function(){ throw ({"
+ "type: 'catch', "
+ "id: " (ls-compile id env) ", "
+ "value: " (ls-compile value env) ", "
+ "message: 'Throw uncatched.'"
+ "})})()"))
+
+(define-compilation unwind-protect (form &rest clean-up)
+ (concat "(function(){" *newline*
+ (indent "var ret = " (ls-compile nil) ";" *newline*
+ "try {" *newline*
+ (indent "ret = " (ls-compile form env) ";" *newline*)
+ "} finally {" *newline*
+ (indent (ls-compile-block clean-up env))
+ "}" *newline*
+ "return ret;" *newline*)
+ "})()"))
+
+
;;; A little backquote implementation without optimizations of any
;;; kind for ecmalisp.
(defun backquote-expand-1 (form)