|
65 | 65 | [indices (listof symbol?)]) #:transparent) |
66 | 66 |
|
67 | 67 | (define (context-add-vars ctx vars) |
68 | | - (match ctx |
69 | | - [(context V X Y) |
70 | | - (context V (append vars X) Y)])) |
| 68 | + (match-define (context V X Y) ctx) |
| 69 | + (context V (append vars X) Y)) |
71 | 70 |
|
72 | 71 | (define (context-add-var ctx var) |
73 | | - (match ctx |
74 | | - [(context V X Y) |
75 | | - (context V (cons var X) Y)])) |
| 72 | + (match-define (context V X Y) ctx) |
| 73 | + (context V (cons var X) Y)) |
76 | 74 |
|
77 | 75 | (define (context-add ctx #:bounds [bounds empty] #:vars [vars empty] #:indices [indices empty]) |
78 | | - (match ctx |
79 | | - [(context V X Y) |
80 | | - (context (append bounds V) (append vars X) (append indices Y))])) |
| 76 | + (match-define (context V X Y) ctx) |
| 77 | + (context (append bounds V) (append vars X) (append indices Y))) |
81 | 78 |
|
82 | 79 | (define (inferable-index? ctx bound) |
83 | | - (match ctx |
84 | | - [(context _ _ Y) |
85 | | - (memq bound Y)])) |
| 80 | + (match-define (context _ _ Y) ctx) |
| 81 | + (memq bound Y)) |
86 | 82 |
|
87 | 83 | (define ((inferable-var? ctx) var) |
88 | | - (match ctx |
89 | | - [(context _ X _) |
90 | | - (memq var X)])) |
| 84 | + (match-define (context _ X _) ctx) |
| 85 | + (memq var X)) |
91 | 86 |
|
92 | 87 | (define (empty-cset/context ctx) |
93 | | - (match ctx |
94 | | - [(context _ X Y) |
95 | | - (empty-cset X Y)])) |
| 88 | + (match-define (context _ X Y) ctx) |
| 89 | + (empty-cset X Y)) |
96 | 90 |
|
97 | 91 |
|
98 | 92 |
|
|
766 | 760 | (list values -Nat))) |
767 | 761 | (define type |
768 | 762 | (for/or ([pred-type (in-list possibilities)]) |
769 | | - (match pred-type |
770 | | - [(list pred? type) |
771 | | - (and (pred? n) type)]))) |
| 763 | + (match-define (list pred? type) pred-type) |
| 764 | + (and (pred? n) type))) |
772 | 765 | (cgen/seq context (seq (list type) -null-end) ts*)] |
773 | 766 | ;; numeric? == #true |
774 | 767 | [((Base-bits: #t _) (SequenceSeq: ts*)) |
|
917 | 910 | ;; c : Constaint |
918 | 911 | ;; variance : Variance |
919 | 912 | (define (constraint->type v variance) |
920 | | - (match v |
921 | | - [(c S T) |
922 | | - (match variance |
923 | | - [(? variance:const?) S] |
924 | | - [(? variance:co?) S] |
925 | | - [(? variance:contra?) T] |
926 | | - [(? variance:inv?) (let ([gS (generalize S)]) |
927 | | - (if (subtype gS T) |
928 | | - gS |
929 | | - S))])])) |
| 913 | + (match-define (c S T) v) |
| 914 | + (match variance |
| 915 | + [(? variance:const?) S] |
| 916 | + [(? variance:co?) S] |
| 917 | + [(? variance:contra?) T] |
| 918 | + [(? variance:inv?) (let ([gS (generalize S)]) (if (subtype gS T) gS S))])) |
930 | 919 |
|
931 | 920 | ;; Since we don't add entries to the empty cset for index variables (since there is no |
932 | 921 | ;; widest constraint, due to dcon-exacts), we must add substitutions here if no constraint |
|
936 | 925 | (hash-union |
937 | 926 | (for/hash ([v (in-list Y)] |
938 | 927 | #:unless (hash-has-key? S v)) |
939 | | - (let ([var (hash-ref idx-hash v variance:const)]) |
940 | | - (values v |
941 | | - (match var |
942 | | - [(? variance:const?) (i-subst null)] |
943 | | - [(? variance:co?) (i-subst null)] |
944 | | - [(? variance:contra?) (i-subst/starred null Univ)] |
945 | | - ;; TODO figure out if there is a better subst here |
946 | | - [(? variance:inv?) (i-subst null)])))) |
| 928 | + (define var (hash-ref idx-hash v variance:const)) |
| 929 | + (values v |
| 930 | + (match var |
| 931 | + [(? variance:const?) (i-subst null)] |
| 932 | + [(? variance:co?) (i-subst null)] |
| 933 | + [(? variance:contra?) (i-subst/starred null Univ)] |
| 934 | + ;; TODO figure out if there is a better subst here |
| 935 | + [(? variance:inv?) (i-subst null)]))) |
947 | 936 | S)) |
948 | 937 | (define (build-subst m) |
949 | | - (match m |
950 | | - [(cons cmap (dmap dm)) |
951 | | - (let* ([subst (hash-union |
952 | | - (for/hash ([(k dc) (in-hash dm)]) |
953 | | - (define (c->t c) (constraint->type c (hash-ref idx-hash k variance:const))) |
954 | | - (values |
955 | | - k |
956 | | - (match dc |
957 | | - [(dcon fixed #f) |
958 | | - (i-subst (map c->t fixed))] |
959 | | - [(or (dcon fixed rest) (dcon-exact fixed rest)) |
960 | | - (i-subst/starred |
961 | | - (map c->t fixed) |
962 | | - (c->t rest))] |
963 | | - [(dcon-dotted fixed dc dbound) |
964 | | - (i-subst/dotted |
965 | | - (map c->t fixed) |
966 | | - (c->t dc) |
967 | | - dbound)]))) |
968 | | - (for/hash ([(k v) (in-hash cmap)]) |
969 | | - (values k (t-subst (constraint->type v (hash-ref var-hash k variance:const))))))] |
970 | | - [subst (for/fold ([subst subst]) ([v (in-list X)]) |
971 | | - (let ([entry (hash-ref subst v #f)]) |
972 | | - ;; Make sure we got a subst entry for a type var |
973 | | - ;; (i.e. just a type to substitute) |
974 | | - ;; If we don't have one, there are no constraints on this variable |
975 | | - (if (and entry (t-subst? entry)) |
976 | | - subst |
977 | | - (hash-set subst v (t-subst Univ)))))]) |
978 | | - ;; verify that we got all the important variables |
979 | | - (extend-idxs subst))])) |
| 938 | + (match-define (cons cmap (dmap dm)) m) |
| 939 | + (let* ([subst (hash-union |
| 940 | + (for/hash ([(k dc) (in-hash dm)]) |
| 941 | + (define (c->t c) |
| 942 | + (constraint->type c (hash-ref idx-hash k variance:const))) |
| 943 | + (values k |
| 944 | + (match dc |
| 945 | + [(dcon fixed #f) (i-subst (map c->t fixed))] |
| 946 | + [(or (dcon fixed rest) (dcon-exact fixed rest)) |
| 947 | + (i-subst/starred (map c->t fixed) (c->t rest))] |
| 948 | + [(dcon-dotted fixed dc dbound) |
| 949 | + (i-subst/dotted (map c->t fixed) (c->t dc) dbound)]))) |
| 950 | + (for/hash ([(k v) (in-hash cmap)]) |
| 951 | + (values k (t-subst (constraint->type v (hash-ref var-hash k variance:const))))))] |
| 952 | + [subst (for/fold ([subst subst]) ([v (in-list X)]) |
| 953 | + (define entry (hash-ref subst v #f)) |
| 954 | + ;; Make sure we got a subst entry for a type var |
| 955 | + ;; (i.e. just a type to substitute) |
| 956 | + ;; If we don't have one, there are no constraints on this variable |
| 957 | + (if (and entry (t-subst? entry)) |
| 958 | + subst |
| 959 | + (hash-set subst v (t-subst Univ))))]) |
| 960 | + ;; verify that we got all the important variables |
| 961 | + (extend-idxs subst))) |
980 | 962 | (if multiple-substitutions? |
981 | 963 | (for/list ([md (in-stream (cset-maps C))]) |
982 | 964 | (build-subst md)) |
|
0 commit comments