[function] following the protocol now

icfp-2016/fig-stats.tex

@@ -3,7 +3,7 @@
   Module             & LOC & $\interp$ (LOC) & $\elab$ (LOC)  \\\hline
   \mod{db}           & 263 &   2  (78) &  2  (101)  \\
   \mod{format}       &  66 &   1  (33) &  1 \,~(21) \\
-  \mod{function}     & 117 &   1  (11) &  2 \,~(51) \\
+  \mod{function}     &  56 &   1   (5) &  2 \,~(27) \\
   \mod{math}         &  90 &   1 ~~(3) &  5 \,~(46) \\
   \mod{regexp}       & 137 &   6  (60) &  5 \,~(33) \\
   \mod{vector}       & 228 &   1  (19) & 13  (163)  \\\hline

private/function.rkt

@@ -1,16 +1,11 @@
 #lang typed/racket/base
 
 ;; TODO get type from a lambda AFTER expansion
-;
-;(require
-; (for-syntax
-;   (only-in typed-racket/private/syntax-properties plambda-property)))
-;
+
 ;; -----------------------------------------------------------------------------
 
 ;; Track procedure arity
 ;; Applications:
-;; - 
 ;; - vectorized ops
 ;; - (TODO) improve apply/map? ask Leif
 ;; - TODO get types, not arity
@@ -35,17 +30,15 @@
     trivial/private/common
 ))
 
-;(require
-;    (prefix-in tr: typed/racket/base)
-;    (prefix-in r: (only-in racket/base quote))
-; (for-syntax
-;  syntax/id-table))
-
 ;; =============================================================================
 
 (begin-for-syntax
   (define TYPE-KEY 'type-label)
 
+  (define (formal->type x)
+    (or (syntax-property x TYPE-KEY)
+        (format-id x "Any"))) ;; Could just use TR's Any from here
+
   (define (parse-procedure-arity stx)
     (syntax-parse stx #:literals (: #%plain-lambda lambda)
      [(#%plain-lambda (x*:id ...) e* ...)
@@ -90,29 +83,8 @@
     ;; --
     #:with Listof-stx (format-id stx "Listof")
     #:with (e+* ...)
-      (for/list ([t (in-list (syntax-e #'p.evidence))]
+      (for/list ([x (in-list (syntax-e #'p.evidence))]
                  [e (in-list (syntax-e #'(e* ...)))])
-        (quasisyntax/loc stx (ann #,e (Listof-stx #,t))))
-    (syntax/loc stx (map p.expanded e+* ...))]
-   [(_ p e* ...)
-    ;; TODO -- this case should be subsumed by the last
-    #:with p+ (expand-expr #'p)
-    #:with evi (fun? #'p+)
-    #:when (syntax-e #'evi)
-    #:when
-      (let ([num-expected (length (syntax-e #'evi))]
-            [num-actual (length (syntax-e #'(e* ...)))])
-        (unless (= num-expected num-actual)
-          (apply raise-arity-error
-            'map:
-            num-expected
-            (map syntax->datum (syntax-e #'(e* ...))))))
-    ;; --
-    #:with Listof-stx (format-id stx "Listof")
-    #:with (e+* ...)
-      (for/list ([t (in-list (syntax-e #'evi))]
-                 [e (in-list (syntax-e #'(e* ...)))])
-        ;; TODO stop using format-id
-        (quasisyntax/loc stx (ann #,e (Listof-stx #,(format-id stx "~a" t)))))
-    (syntax/loc stx (map p+ e+* ...))]))))
+        (quasisyntax/loc stx (ann #,e (Listof-stx #,(formal->type x)))))
+    (syntax/loc stx (map p.expanded e+* ...))]))))
 

test/function-fail.rkt

@@ -3,7 +3,7 @@
 
 (module+ test (test-compile-error
   #:require trivial/function trivial/format
-  #:exn #rx"at:" ;;TODO
+  #:exn #rx"Type Checker|lambda:|λ:" ;; TODO, bummer to include lambda:
   ((curry: (lambda (x y) x)) 0 1)
   (((curry: (lambda (x y z) z)) 'x) 'y 'z)
   (((curry: (lambda ([x : Integer] [y : Integer]) (+ x x y))) 'a) 'b)

test/function-pass.rkt

@@ -18,6 +18,13 @@
     (((curry: (lambda ([x : Integer] [y : Integer]) 2)) 0) 1)
     2)
 
+  (check-true
+    (begin (curry: (lambda ([x : Integer]) x)) #t))
+
+  (check-equal?
+    ((curry: (lambda ([x : Integer]) x)) 3)
+    3)
+
   (check-equal?
     (((curry: (lambda ([x : Integer] [y : Integer]) (+ x x y))) 3) 1)
     7)
@@ -26,6 +33,10 @@
     (((curry: (λ ([x : Any] [y : Any]) x)) 'a) 'b)
     'a)
 
+  (check-equal?
+    (map: (lambda ([x : Natural]) (add1 x)) '(8 2 1 3))
+    '(9 3 2 4))
+
   (check-equal?
     (map: (λ ([x : String] [y : String])
             (string-append x y))
@@ -39,4 +50,12 @@
           '("hello")
           '("world"))
     '("hello world"))
+
+  (check-equal?
+    (map: (lambda ([x : Integer] [y : Integer] [z : Integer])
+            (+ (* x y) z))
+      '(1 2 3)
+      '(4 5 6)
+      '(8 9 10))
+  '(12 19 28))
 )