suzanne.soy/macrotypes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix match2 bug with nested user-defined datatypes

Browse Source
This commit is contained in:
Stephen Chang 2016-03-30 23:25:24 -04:00
parent e9290629da
commit d5435eb71b
2 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
tapl/mlish.rkt
View File

@ -335,8 +335,9 @@
#:with ((~literal #%plain-lambda) (RecName)
((~literal let-values) ()
((~literal let-values) ()
. info-body)))
. (((~literal #%plain-app) ((~literal quote) C) . rst) ...))))
(get-extra-info #'ty)
#:when (member (syntax->datum #'A) (syntax->datum #'(C ...)))
#'()]
[(x:id ty) #'((x ty))]
[((p1 (unq p) ...) ty) ; comma tup stx
@ -403,8 +404,9 @@
#:with ((~literal #%plain-lambda) (RecName)
((~literal let-values) ()
((~literal let-values) ()
. info-body)))
. (((~literal #%plain-app) ((~literal quote) C) . rst) ...))))
(get-extra-info ty)
#:when (member (syntax->datum #'A) (syntax->datum #'(C ...)))
(compile-pat #'(A) ty)]
[x:id p]
[(p1 (unq p) ...) ; comma tup stx
@ -680,12 +682,10 @@
(stx-map
(lambda (tyin)
(define old-orig (get-orig tyin))
(displayln old-orig)
(define new-orig
(and old-orig
(substs (stx-map get-orig #'(τ_solved ...)) #'Xs old-orig
(lambda (x y) (equal? (syntax->datum x) (syntax->datum y))))))
(displayln new-orig)
(syntax-property tyin 'orig (list new-orig)))
#'(τ_in ...)))
(⊢ (#%app e_fn- e_arg- ...) : τ_out)])

10
tapl/tests/mlish/bg/monad.mlish
View File

@ -110,3 +110,13 @@
⇒ (Some (BQ (∷ 4 (∷ 5 (∷ 6 (∷ 7 (∷ 8 (∷ 9 Nil)))))) Nil)))
(check-type (>> (inst bq-head Int) bq-tails-result) : (Option Int) -> (Some 4))
;; check match2 nested datatype bug
(check-type
(match bq-tails-result with
[None -> (None {Int})]
[Some bq -> (bq-head bq)]) : (Option Int) -> (Some 4))
(check-type
(match2 bq-tails-result with
[None -> (None {Int})]
[Some bq -> (bq-head bq)]) : (Option Int) -> (Some 4))