diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/doc-syms.tl | 5 | ||||
| -rw-r--r-- | stdlib/struct.tl | 18 |
2 files changed, 21 insertions, 2 deletions
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 08dcc8e2..947e327a 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -9,6 +9,7 @@ ("*args-eff*" "N-03DEE18A") ("*args-full*" "N-03DEE18A") ("*child-env*" "N-01BB2097") + ("*define-struct-prelude*" "N-0083D695") ("*doc-url*" "N-0003D10B") ("*filters*" "N-00E6A902") ("*gensym-counter*" "N-0387B1B1") @@ -728,7 +729,7 @@ ("file-get-string" "N-02238370") ("file-put" "N-0041C2E5") ("file-put-buf" "N-02AE3A31") - ("file-put-json" "D-002A") + ("file-put-json" "D-0029") ("file-put-jsons" "D-007E") ("file-put-lines" "N-0041C2E5") ("file-put-string" "N-0041C2E5") @@ -783,7 +784,7 @@ ("float" "N-03237030") ("floatp" "N-03E9D6E1") ("flock" "N-004E5B3E") - ("floor" "D-0029") + ("floor" "D-002A") ("floor-rem" "N-02DE978F") ("floor1" "N-01ED20D1") ("flow" "N-02B2153E") diff --git a/stdlib/struct.tl b/stdlib/struct.tl index d05b75fc..3f9330a2 100644 --- a/stdlib/struct.tl +++ b/stdlib/struct.tl @@ -27,6 +27,9 @@ (defvar *struct-clause-expander* (hash)) +(defvar *struct-prelude* (hash)) +(defvar *struct-prelude-alists* (hash)) + (defun sys:bad-slot-syntax (form arg) (compile-error form "bad slot syntax ~s" arg)) @@ -50,6 +53,7 @@ (compile-warning form "~s is a built-in type" name)) (unless (proper-listp slot-specs) (compile-error form "bad syntax: dotted form")) + (set slot-specs (append [*struct-prelude* name] slot-specs)) (let ((instance-init-forms nil) (instance-postinit-forms nil) (instance-fini-forms nil) @@ -429,6 +433,20 @@ [xfun clause form] (cons clause nil))) +(defmacro define-struct-prelude (:form form prelude-name struct-names . clauses) + (unless (bindable prelude-name) + (compile-error form "~s isn't a valid prelude name" prelude-name)) + (when (bindable struct-names) + (set struct-names (list struct-names))) + (each ((sname struct-names)) + (unless (bindable sname) + (compile-error form "~s isn't a valid struct name" sname)) + (let* ((cell (inhash *struct-prelude-alists* sname nil)) + (alist (aconsql-new prelude-name clauses (cdr cell)))) + (rplacd cell alist) + (set [*struct-prelude* sname] [mappend cdr (reverse alist)])) + nil)) + (compile-only (load-for (struct sys:param-parser-base "param"))) |