From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- top/has-macros.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 top/has-macros.scm (limited to 'top/has-macros.scm') diff --git a/top/has-macros.scm b/top/has-macros.scm new file mode 100644 index 0000000..2c75730 --- /dev/null +++ b/top/has-macros.scm @@ -0,0 +1,57 @@ +;;; General macros for the Haskell compiler + +(define-syntax (remember-context exp . body) + (let ((temp (gensym))) + `(let ((,temp ,exp)) + (dynamic-let ((*context* (if (ast-node-line-number ,temp) + ,temp + (dynamic *context*)))) + ,@body)))) + +(define-syntax (maybe-remember-context exp . body) + (let ((temp (gensym))) + `(let ((,temp ,exp)) + (if (ast-node-line-number ,temp) + (dynamic-let ((*context* ,temp)) ,@body) + (begin ,@body))))) + +(define-syntax (recover-errors error-value . body) + (let ((local-handler (gensym))) + `(let/cc ,local-handler + (dynamic-let ((*recoverable-error-handler* + (lambda () (funcall ,local-handler ,error-value)))) + ,@body)))) + +;;; This is for iterating a list of contexts over a list of types. + +(define-syntax (do-contexts cbinder tbinder . body) + (let ((cvar (car cbinder)) + (cinit (cadr cbinder)) + (tvar (car tbinder)) + (tinit (cadr tbinder)) + (cv (gensym)) + (tv (gensym))) + `(do ((,cv ,cinit (cdr ,cv)) + (,tv ,tinit (cdr ,tv))) + ((null? ,cv)) + (let ((,tvar (car ,tv))) + (dolist (,cvar (car ,cv)) + ,@body))))) + +;; dolist for 2 lists at once. + +(define-syntax (dolist2 a1 a2 . body) + (let ((a1var (car a1)) + (a1init (cadr a1)) + (a2var (car a2)) + (a2init (cadr a2)) + (a1l (gensym)) + (a2l (gensym))) + `(do ((,a1l ,a1init (cdr ,a1l)) + (,a2l ,a2init (cdr ,a2l))) + ((null? ,a1l)) + (let ((,a1var (car ,a1l)) + (,a2var (car ,a2l))) + ,@body)))) + + \ No newline at end of file -- cgit v1.2.3