Stefan pushed to branch main at Stefan / Typer

Commits: 3855c3d2 by Maxim Bernard at 2024-10-28T00:18:33-04:00 Fix `<-` macro not handling nested tuples properly.

* btl/assign-datacons.typer: Convert `_,_` forms to the corresponding `tupleN` form for nested patterns as well as the top-level one. Add test that covers this case.

* btl/tuple.typer: Add `get-name-from-list` function for use in assign-datacons.typer.

- - - - -

2 changed files:

- btl/assign-datacons.typer - btl/tuple.typer

Changes:

===================================== btl/assign-datacons.typer ===================================== @@ -36,12 +36,12 @@ get-subpatterns pattern-sexp = (lambda _ -> nil) (lambda _ -> nil);

-% If `pattern-sexp` is of the form `a,b,c,...`, converts in into the appropriate -% tuple (e.g. `tuple3 a b c`). -expand-tuple pattern-sexp = - if String_eq "_,_" (get-constructor-name pattern-sexp) - then tuple-lib.make-tuple-impl (get-subpatterns pattern-sexp) - else pattern-sexp; +% If the constructor is the "comma" tuple constructor (for tuples of the form +% `(a, b, c, ...)`, return the corresponding datacons name. +normalize-tuple-name cstr-name nb-params = + if String_eq "_,_" cstr-name + then tuple-lib.get-name-from-list (tuple-lib.tuple-cstr-names) nb-params + else cstr-name;

% E.g. with argument `(a (b x y) z)`, returns `["x", "y", "z"]` get-newvars-names : List Sexp -> List String; @@ -83,7 +83,8 @@ make-single-case subject cstr-name nb-params var-idx var-sym ret-val = in if Int_< i nb-params then cons current-sym (mk-pat-params (Int_+ 1 i)) else nil; - pattern = (Sexp_node (Sexp_symbol cstr-name) (mk-pat-params 0)); + pattern = (Sexp_node (Sexp_symbol (normalize-tuple-name cstr-name nb-params)) + (mk-pat-params 0)); branch-node = (Sexp_node (Sexp_symbol "_=>_") (cons pattern (cons ret-val nil))) in Sexp_node (Sexp_symbol "##case_") @@ -134,7 +135,7 @@ make-case-for-var var-name cstr-name subpatterns subject temp-matching-var = (lambda _ -> Sexp_error)) | none => % Logically should not occur - Sexp_symbol "error none"; + Sexp_symbol "Internal error in assing-datacons";

assign-datacons = macro (lambda args -> @@ -142,10 +143,8 @@ assign-datacons = macro pattern-sexp = List_nth 0 args Sexp_error; % e.g. `(a (b x y) z)` value-sexp = List_nth 1 args Sexp_error; % e.g. `someFunction 1 2 3`

- pattern-sexp-norm = expand-tuple pattern-sexp; - - cstr-name = get-constructor-name pattern-sexp-norm; - subpatterns = get-subpatterns pattern-sexp-norm; + cstr-name = get-constructor-name pattern-sexp; + subpatterns = get-subpatterns pattern-sexp;

new-bound-variables = get-newvars-names subpatterns; % `["x", "y", "z"]`

@@ -200,6 +199,16 @@ test1 = cons (quote (a (b x y) z)) test2 = cons (quote (a, (b x _ z), c)) (cons (quote sometuple) nil);

+% `(a (b (x, y, z) w) z) <- somevalue` +test3 = cons (quote (a (b (x, y, z) w) v)) + (cons (quote sometuple) nil); + +t = cons (quote (exists (hp, hqr) (pf-p-hp, + pf-qr-hqr, + pf-hp-hqr-disjoint, + pf-heap-eq-hp-hqr))) + (cons (quote pf-hyp) nil); + runtest test = IO_run (do {

===================================== btl/tuple.typer ===================================== @@ -65,13 +65,20 @@ tuple-type-names = (cons "Tuple9" (cons "Tuple10" nil))))))));

+excess-items-message = "<ERROR: limit 10 items per tuple>"; + +get-name-from-list name-list nb-args = + List_nth (Int_- nb-args 2) + name-list + excess-items-message; + make-sexp-from-names : List String -> List Sexp -> Sexp; make-sexp-from-names name-list args = let nb-args = List_length args; - tuple-name = List_nth (Int_- nb-args 2) name-list "" + tuple-name = get-name-from-list name-list nb-args in if Int_<= nb-args 10 then Sexp_node (Sexp_symbol tuple-name) args - else Sexp_symbol "<ERROR: limit 10 items per tuple>"; + else Sexp_symbol excess-items-message;

make-tuple-impl = make-sexp-from-names tuple-cstr-names; tuple-type-impl = make-sexp-from-names tuple-type-names;

View it on GitLab: https://gitlab.com/monnier/typer/-/commit/3855c3d23d0dbd161076651301251e198f...