|
1430 | 1430 | ,@(reverse after)
|
1431 | 1431 | (unnecessary (tuple ,@(reverse elts))))
|
1432 | 1432 | (let ((L (car lhss))
|
1433 |
| - (R (car rhss))) |
| 1433 | + ;; rhss can be null iff L is a vararg |
| 1434 | + (R (if (null? rhss) '() (car rhss)))) |
1434 | 1435 | (cond ((and (symbol-like? L)
|
1435 | 1436 | (or (not (pair? R)) (quoted? R) (equal? R '(null)))
|
1436 | 1437 | ;; overwrite var immediately if it doesn't occur elsewhere
|
|
1442 | 1443 | (cons (make-assignment L R) stmts)
|
1443 | 1444 | after
|
1444 | 1445 | (cons R elts)))
|
| 1446 | + ((vararg? L) |
| 1447 | + (if (null? (cdr lhss)) |
| 1448 | + (let ((temp (make-ssavalue))) |
| 1449 | + `(block ,@(reverse stmts) |
| 1450 | + (= ,temp (tuple ,@rhss)) |
| 1451 | + ,@(reverse after) |
| 1452 | + (= ,(cadr L) ,temp) |
| 1453 | + (unnecessary (tuple ,@(reverse elts) (... ,temp))))) |
| 1454 | + (error (string "invalid \"...\" on non-final assignment location \"" |
| 1455 | + (cadr L) "\"")))) |
1445 | 1456 | ((vararg? R)
|
1446 | 1457 | (let ((temp (make-ssavalue)))
|
1447 | 1458 | `(block ,@(reverse stmts)
|
|
2066 | 2077 | (define (sides-match? l r)
|
2067 | 2078 | ;; l and r either have equal lengths, or r has a trailing ...
|
2068 | 2079 | (cond ((null? l) (null? r))
|
| 2080 | + ((vararg? (car l)) #t) |
2069 | 2081 | ((null? r) #f)
|
2070 | 2082 | ((vararg? (car r)) (null? (cdr r)))
|
2071 | 2083 | (else (sides-match? (cdr l) (cdr r)))))
|
|
2075 | 2087 | (expand-forms
|
2076 | 2088 | (tuple-to-assignments lhss x))
|
2077 | 2089 | ;; (a, b, ...) = other
|
2078 |
| - (let* ((xx (if (or (and (symbol? x) (not (memq x lhss))) |
2079 |
| - (ssavalue? x)) |
2080 |
| - x (make-ssavalue))) |
2081 |
| - (ini (if (eq? x xx) '() (list (sink-assignment xx (expand-forms x))))) |
2082 |
| - (n (length lhss)) |
2083 |
| - (st (gensy))) |
2084 |
| - `(block |
2085 |
| - (local ,st) |
2086 |
| - ,@ini |
2087 |
| - ,.(map (lambda (i lhs) |
2088 |
| - (expand-forms |
2089 |
| - (lower-tuple-assignment |
2090 |
| - (if (= i (- n 1)) |
2091 |
| - (list lhs) |
2092 |
| - (list lhs st)) |
2093 |
| - `(call (top indexed_iterate) |
2094 |
| - ,xx ,(+ i 1) ,.(if (eq? i 0) '() `(,st)))))) |
2095 |
| - (iota n) |
2096 |
| - lhss) |
2097 |
| - (unnecessary ,xx)))))) |
| 2090 | + (begin |
| 2091 | + ;; like memq, but if last element of lhss is (... sym), |
| 2092 | + ;; check against sym instead |
| 2093 | + (define (in-lhs? x lhss) |
| 2094 | + (if (null? lhss) |
| 2095 | + #f |
| 2096 | + (let ((l (car lhss))) |
| 2097 | + (cond ((and (pair? l) (eq? (car l) '|...|)) |
| 2098 | + (if (null? (cdr lhss)) |
| 2099 | + (eq? (cadr l) x) |
| 2100 | + (error (string "invalid \"...\" on non-final assignment location \"" |
| 2101 | + (cadr l) "\"")))) |
| 2102 | + ((eq? l x) #t) |
| 2103 | + (else (in-lhs? x (cdr lhss))))))) |
| 2104 | + ;; in-lhs? also checks for invalid syntax, so always call it first |
| 2105 | + (let* ((xx (if (or (and (not (in-lhs? x lhss)) (symbol? x)) |
| 2106 | + (ssavalue? x)) |
| 2107 | + x (make-ssavalue))) |
| 2108 | + (ini (if (eq? x xx) '() (list (sink-assignment xx (expand-forms x))))) |
| 2109 | + (n (length lhss)) |
| 2110 | + (st (gensy))) |
| 2111 | + `(block |
| 2112 | + (local ,st) |
| 2113 | + ,@ini |
| 2114 | + ,.(map (lambda (i lhs) |
| 2115 | + (expand-forms |
| 2116 | + (if (and (pair? lhs) (eq? (car lhs) '|...|)) |
| 2117 | + `(= ,(cadr lhs) (call (top rest) ,xx ,.(if (eq? i 0) '() `(,st)))) |
| 2118 | + (lower-tuple-assignment |
| 2119 | + (if (= i (- n 1)) |
| 2120 | + (list lhs) |
| 2121 | + (list lhs st)) |
| 2122 | + `(call (top indexed_iterate) |
| 2123 | + ,xx ,(+ i 1) ,.(if (eq? i 0) '() `(,st))))))) |
| 2124 | + (iota n) |
| 2125 | + lhss) |
| 2126 | + (unnecessary ,xx))))))) |
2098 | 2127 | ((typed_hcat)
|
2099 | 2128 | (error "invalid spacing in left side of indexed assignment"))
|
2100 | 2129 | ((typed_vcat)
|
|
0 commit comments