Implement typed curried definitions

diff --git a/curry.scm b/curry.scm
index 77489c4acfe73fd41e51f9aa62776c7028c968dc..33fb629044ee95e177bdde36fdda193fb89be0ec 100644 (file)
--- a/curry.scm
+++ b/curry.scm
@@ -16,6 +16,7 @@
    expand
    parse
    symtab
+   type-of
    ∷))
 
 (define symtab '())
@@ -257,6 +258,28 @@
          `(lambda (,var) ,bodye)))))
     (('letrecc1 ((? symbol? name) expr) body)
      (type-error 0 'letrecc1 name expr body))
+    (('definec (? (lambda (x)
+                   (and
+                    (pair? x)
+                    (symbol? (car x))
+                    (var-list? (cdr x))))
+                 (name vars ..1))
+       body)
+     (expand
+      symtab
+      `(definec ,name
+        ,(fold-right (lambda (x prev)
+                       `(λc ,x ,prev))
+                     body vars))))
+    (('definec (? symbol? name) body)
+     (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))))))
     ((f)
      (let ((t e (expand symtab f)))
        (values
@@ -386,3 +409,6 @@
 
 (define-syntax-rule (∷ name type)
   (∷% 'name (parse 'type)))
+
+(define (type-of x)
+  (pt (assoc-ref symtab x)))