1#lang racket/base
2(require "wrap.rkt"
3         "match.rkt"
4         "infer-known.rkt"
5         "mutated-state.rkt"
6         "aim.rkt")
7
8(provide letrec-splitable-values-binding?
9         letrec-split-values-binding
10         letrec-conversion)
11
12;; Detect binding of lambdas that were probably generated from an
13;; R[56]RS program
14
15(define (letrec-splitable-values-binding? idss rhss)
16  (and (pair? idss)
17       (null? (cdr idss))
18       (wrap-pair? (car rhss))
19       (eq? 'values (wrap-car (car rhss)))
20       (= (length (wrap-cdr (car rhss)))
21          (length (car idss)))
22       (for/and ([rhs (in-list (wrap-cdr (car rhss)))])
23         (lambda? rhs #:simple? #t))))
24
25(define (letrec-split-values-binding idss rhss bodys)
26  `(letrec-values ,(for/list ([id (in-list (car idss))]
27                              [rhs (in-list (wrap-cdr (car rhss)))])
28                     `[(,id) ,rhs])
29     . ,bodys))
30
31(define (letrec-conversion ids mutated target e)
32  (define need-convert?
33    (and (not (aim? target 'cify))
34         (let loop ([ids ids])
35           (cond
36             [(symbol? ids)
37              (needs-letrec-convert-mutated-state? (hash-ref mutated ids #f))]
38             [(wrap? ids) (loop (unwrap ids))]
39             [(pair? ids) (or (loop (car ids))
40                              (loop (cdr ids)))]
41             [else #f]))))
42  (if need-convert?
43      (match e
44        [`(,_ ([,ids ,rhss] ...) . ,body)
45         `(let ,(for/list ([id (in-list ids)])
46                  `[,id unsafe-undefined])
47            ,@(for/list ([id (in-list ids)]
48                         [rhs (in-list rhss)])
49                `(set! ,id ,rhs))
50            . ,body)])
51      e))
52