GitHub PullRequestReviewCommentEvent at 2014-05-19 15:20:20
Repository: racket
Actor: samth
Payload: {"comment":{"url":"https://api.github.com/repos/plt/racket/pulls/comments/12799261","id":12799261,"diff_hunk":"@@ -198,136 +236,141 @@\n     ;; FIXME - do something here\n     [(_ _) #f]))\n \n-(define/cond-contract (cgen/arr V X Y s-arr t-arr)\n-  ((listof symbol?) (listof symbol?) (listof symbol?) arr? arr? . -> . (or/c #f cset?))\n-  (define (cg S T) (cgen V X Y S T))\n-  (match*/early (s-arr t-arr)\n-    ;; the simplest case - no rests, drests, keywords\n-    [((arr: ss s #f #f '())\n-      (arr: ts t #f #f '()))\n-     (% cset-meet\n-        ;; contravariant\n-        (cgen/list V X Y ts ss)\n-        ;; covariant\n-        (cg s t))]\n-    ;; just a rest arg, no drest, no keywords\n-    [((arr: ss s s-rest #f '())\n-      (arr: ts t t-rest #f '()))\n-     (let ([arg-mapping\n-            (cond\n-              ;; both rest args are present, so make them the same length\n-              [(and s-rest t-rest)\n-               (cgen/list V X Y\n-                          (cons t-rest (extend ss ts t-rest))\n-                          (cons s-rest (extend ts ss s-rest)))]\n-              ;; no rest arg on the right, so just pad the left and forget the rest arg\n-              [(and s-rest (not t-rest) (<= (length ss) (length ts)))\n-               (cgen/list V X Y ts (extend ts ss s-rest))]\n-              ;; no rest arg on the left, or wrong number = fail\n-              [else #f])]\n-           [ret-mapping (cg s t)])\n-       (% cset-meet arg-mapping ret-mapping))]\n-    ;; dotted on the left, nothing on the right\n-    [((arr: ss s #f (cons dty dbound) '())\n-      (arr: ts t #f #f                '()))\n+(define/cond-contract (cgen/seq V X Y s-seq t-seq)\n+  ((listof symbol?) (listof symbol?) (listof symbol?) seq? seq? . -> . (or/c #f cset?))\n+  (match*/early (s-seq t-seq)\n+    ;; The simplest case - both are null-end\n+    [((seq ss (null-end))\n+      (seq ts (null-end)))\n+      (cgen/list V X Y ss ts)]\n+    ;; One is null-end the other is uniform-end\n+    [((seq ss (null-end))\n+      (seq ts (uniform-end t-rest)))\n+     (cgen/list V X Y ss (extend ss ts t-rest))]\n+    [((seq ss (uniform-end s-rest))\n+      (seq ts (null-end)))\n+     #f]\n+    ;; Both are uniform-end\n+    [((seq ss (uniform-end s-rest))\n+      (seq ts (uniform-end t-rest)))\n+     (cgen/list V X Y\n+                (cons s-rest ss)\n+                (cons t-rest (extend ss ts t-rest)))]\n+    ;; dotted below, nothing above\n+    [((seq ss (dotted-end dty dbound))\n+      (seq ts (null-end)))\n      #:return-unless (memq dbound Y)\n      #f\n      #:return-unless (<= (length ss) (length ts))\n      #f\n-     (let* ([vars      (var-store-take dbound dty (- (length ts) (length ss)))]\n-            [new-tys   (for/list ([var (in-list vars)])\n-                         (substitute (make-F var) dbound dty))]\n-            [new-s-arr (make-arr (append ss new-tys) s #f #f null)]\n-            [new-cset  (cgen/arr V (append vars X) Y new-s-arr t-arr)])\n-       (% move-vars-to-dmap new-cset dbound vars))]\n-    ;; dotted on the right, nothing on the left\n-    [((arr: ss s #f #f                '())\n-      (arr: ts t #f (cons dty dbound) '()))\n+     (let* ([vars    (var-store-take dbound dty (- (length ts) (length ss)))]\n+            [new-tys (for/list ([var (in-list vars)])\n+                       (substitute (make-F var) dbound dty))])\n+       (% move-vars-to-dmap (cgen/list V (append vars X) Y (append ss new-tys) ts) dbound vars))]\n+    ;; dotted above, nothing below\n+    [((seq ss (null-end))\n+      (seq ts (dotted-end dty dbound)))\n      #:return-unless (memq dbound Y)\n      #f\n      #:return-unless (<= (length ts) (length ss))\n      #f\n-     (let* ([vars     (var-store-take dbound dty (- (length ss) (length ts)))]\n-            [new-tys  (for/list ([var (in-list vars)])\n-                        (substitute (make-F var) dbound dty))]\n-            [new-t-arr (make-arr (append ts new-tys) t #f #f null)]\n-            [new-cset (cgen/arr V (append vars X) Y s-arr new-t-arr)])\n-       (% move-vars-to-dmap new-cset dbound vars))]\n-    ;; this case is just for constrainting other variables, not dbound\n-    [((arr: ss s #f (cons s-dty dbound) '())\n-      (arr: ts t #f (cons t-dty dbound) '()))\n+     (let* ([vars    (var-store-take dbound dty (- (length ss) (length ts)))]","path":"pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt","position":144,"original_position":144,"commit_id":"f8c102dd09d287d6fac9cdaa5b695e9528f83fe8","original_commit_id":"f8c102dd09d287d6fac9cdaa5b695e9528f83fe8","user":{"login":"samth","id":244723,"avatar_url":"https://avatars.githubusercontent.com/u/244723?","gravatar_id":"83ddd182088d107264f567d1669103b4","url":"https://api.github.com/users/samth","html_url":"https://github.com/samth","followers_url":"https://api.github.com/users/samth/followers","following_url":"https://api.github.com/users/samth/following{/other_user}","gists_url":"https://api.github.com/users/samth/gists{/gist_id}","starred_url":"https://api.github.com/users/samth/starred{/owner}{/repo}","subscriptions_url":"https://api.github.com/users/samth/subscriptions","organizations_url":"https://api.github.com/users/samth/orgs","repos_url":"https://api.github.com/users/samth/repos","events_url":"https://api.github.com/users/samth/events{/privacy}","received_events_url":"https://api.github.com/users/samth/received_events","type":"User","site_admin":false},"body":"`define` here too.\r\nAlso, this case is so similar to the previous one that I think abstraction would be nice.\r\n","created_at":"2014-05-19T15:20:20Z","updated_at":"2014-05-19T15:20:20Z","html_url":"https://github.com/plt/racket/pull/646#discussion_r12799261","pull_request_url":"https://api.github.com/repos/plt/racket/pulls/646","_links":{"self":{"href":"https://api.github.com/repos/plt/racket/pulls/comments/12799261"},"html":{"href":"https://github.com/plt/racket/pull/646#discussion_r12799261"},"pull_request":{"href":"https://api.github.com/repos/plt/racket/pulls/646"}}}}