From 43ea424e74992b69e2480afd05ec44a5eb7d549c Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 22 Sep 2023 17:07:20 +0900 Subject: [PATCH] Declare the type at macro expansion time --- curry.scm | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/curry.scm b/curry.scm index 33fb629..25b51aa 100644 --- a/curry.scm +++ b/curry.scm @@ -12,7 +12,8 @@ ;(vdc:primitive-eval . primitive-eval) ) #:export - (equal-types? + (curried-untyped-define + equal-types? expand parse symtab @@ -221,9 +222,11 @@ (and (every symbol? lst) (equal? lst (delete-duplicates lst)))) -(define (sym-set! bindings name value) - (let ((symtab bindings)) - (assoc-set! symtab name value))) +(define (sym-set! symtab name value) + (assoc-set! symtab name value)) + +(define (sym-set symtab sym value) + (sym-set! (alist-copy symtab) sym value)) (define (sym-ref bindings name) (assoc-ref bindings name)) @@ -236,9 +239,6 @@ x)) node)) -(define (sym-set symtab sym value) - (sym-set! (alist-copy symtab) sym value)) - (define (expand symtab expr) (match expr (('quote x) @@ -275,11 +275,14 @@ (let ((t e (expand symtab body))) (if (not t) (type-error 5 "in body of" `(definec ,name ,body)) - (begin - (∷% name t) - (values - #f - `(define ,name ,e)))))) + (values + #f + `(begin + ((@@ (vdc curry) ∷%) + ',name + ((@ (vdc curry) parse) + ',(bare-type t))) + (define ,name ,e)))))) ((f) (let ((t e (expand symtab f))) (values -- 2.39.5