|
1430 | 1430 | ,@(reverse after) |
1431 | 1431 | (unnecessary (tuple ,@(reverse elts)))) |
1432 | 1432 | (let ((L (car lhss)) |
1433 | | - ;; rhss can be null iff L is a vararg |
1434 | | - (R (if (null? rhss) '() (car rhss)))) |
| 1433 | + (R (car rhss))) |
1435 | 1434 | (cond ((and (symbol-like? L) |
1436 | 1435 | (or (not (pair? R)) (quoted? R) (equal? R '(null))) |
1437 | 1436 | ;; overwrite var immediately if it doesn't occur elsewhere |
|
1443 | 1442 | (cons (make-assignment L R) stmts) |
1444 | 1443 | after |
1445 | 1444 | (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) "\"")))) |
1456 | 1445 | ((vararg? R) |
1457 | 1446 | (let ((temp (make-ssavalue))) |
1458 | 1447 | `(block ,@(reverse stmts) |
|
2077 | 2066 | (define (sides-match? l r) |
2078 | 2067 | ;; l and r either have equal lengths, or r has a trailing ... |
2079 | 2068 | (cond ((null? l) (null? r)) |
2080 | | - ((vararg? (car l)) #t) |
2081 | 2069 | ((null? r) #f) |
2082 | 2070 | ((vararg? (car r)) (null? (cdr r))) |
2083 | 2071 | (else (sides-match? (cdr l) (cdr r))))) |
|
2087 | 2075 | (expand-forms |
2088 | 2076 | (tuple-to-assignments lhss x)) |
2089 | 2077 | ;; (a, b, ...) = other |
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))))))) |
| 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)))))) |
2127 | 2098 | ((typed_hcat) |
2128 | 2099 | (error "invalid spacing in left side of indexed assignment")) |
2129 | 2100 | ((typed_vcat) |
|
0 commit comments