Changeset 15234 in project
- Timestamp:
- 07/17/09 20:59:08 (12 years ago)
- Location:
- chicken/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/compiler.scm
r15123 r15234 913 913 se2 #f) ] ) 914 914 (set-real-names! aliases vars) 915 `( lambda ,aliases ,body) ) )915 `(##core#lambda ,aliases ,body) ) ) 916 916 917 917 ((set! ##core#set!) … … 1251 1251 (mapwalk x e se) ) 1252 1252 1253 ((and (pair? (car x))1254 (symbol? (caar x))1255 (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))1256 (let ([lexp (car x)]1257 [args (cdr x)] )1258 (emit-syntax-trace-info x #f)1259 (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)1260 (let ([llist (cadr lexp)])1261 (if (and (proper-list? llist) (= (llist-length llist) (length args)))1262 (walk `(##core#let1263 ,(map list llist args) ,@(cddr lexp))1264 e se dest)1265 (let ((var (gensym 't)))1266 (walk1267 `(##core#let1268 ((,var ,(car x)))1269 (,var ,@(cdr x)) )1270 e se dest) ) ) ) ) )1271 1272 1253 (else 1273 1254 (emit-syntax-trace-info x #f) 1274 (mapwalk x e se)) ) ) 1255 (let ((x (mapwalk x e se))) 1256 (if (and (pair? (car x)) 1257 (symbol? (caar x)) 1258 (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda))) 1259 (let ((lexp (car x)) 1260 (args (cdr x)) ) 1261 (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se) 1262 (let ((llist (cadr lexp))) 1263 (if (and (proper-list? llist) (= (llist-length llist) (length args))) 1264 `(let ,(map list llist args) ,@(cddr lexp)) 1265 (let ((var (gensym 't))) 1266 `(let ((,var ,(car x))) 1267 (,var ,@(cdr x)) ) ) ) ) ) 1268 x))) ) ) 1275 1269 1276 1270 (define (mapwalk xs e se) -
chicken/trunk/optimizer.scm
r15117 r15234 1822 1822 (if (symbol? names) (list names) names) ) ) ) 1823 1823 1824 (r-c-s 1825 '(o #%o) 1826 (lambda (x r c) 1827 (if (fx> (length x) 1) 1828 (let ((%tmp (r 'tmp))) 1829 `(,(r 'lambda) (,%tmp) ,(fold-right list %tmp (cdr x)))) 1830 x))) 1831 1824 1832 (r-c-s 1825 1833 '(for-each ##sys#for-each #%for-each) -
chicken/trunk/support.scm
r15117 r15234 348 348 (for-each 349 349 (lambda (s) 350 (mark-variable s '##compiler#intrinsic 'extended)) 350 (mark-variable s '##compiler#intrinsic 'extended) 351 (when (memq s foldable-bindings) 352 (mark-variable s '##compiler#foldable #t))) 351 353 extended-bindings) 352 354 (for-each
Note: See TracChangeset
for help on using the changeset viewer.