diff options
author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
---|---|---|
committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /top/has-macros.scm |
Import to github.
Diffstat (limited to 'top/has-macros.scm')
-rw-r--r-- | top/has-macros.scm | 57 |
1 files changed, 57 insertions, 0 deletions
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 |