1#lang racket/base 2(require racket/list 3 racket/port 4 "match.rkt" 5 "out.rkt" 6 "prune.rkt" 7 "unique.rkt" 8 "sort.rkt" 9 "id.rkt" 10 "vehicle.rkt" 11 "top-name.rkt" 12 "prim-name.rkt" 13 "ref.rkt" 14 "function.rkt" 15 "state.rkt" 16 "generate.rkt" 17 "lambda.rkt" 18 "struct.rkt" 19 "union.rkt" 20 "debug.rkt") 21 22(provide (rename-out [main-cify cify]) 23 re-unique) 24 25(define (main-cify out-file exports in-e prim-knowns 26 #:debug? [debug? #f] 27 #:preamble [preamble '()] 28 #:postamble [postamble '()]) 29 (current-debug debug?) 30 (call-with-output-file* 31 out-file 32 #:exists 'truncate/replace 33 (lambda (out) 34 (parameterize ([current-c-output-port out]) 35 (for-each out-exact preamble) 36 (to-c exports in-e prim-knowns) 37 (for-each out-exact postamble))))) 38 39;; ---------------------------------------- 40 41(define (to-c exports in-e prim-knowns) 42 (generate-header) 43 44 ;; Inlining may have made some definitions useless: 45 (define pruned-e (prune-unused in-e exports)) 46 47 ;; Make sure all names are unique: 48 (define unique-e (re-unique pruned-e)) 49 50 ;; Find all `define`d names and `let[rec[*]]` names that are 51 ;; flattend into the top sequence: 52 (define top-names (extract-top-names #hasheq() unique-e)) 53 54 ;; Find all the primitives that we'll need to call: 55 (define prim-names (extract-prim-names unique-e top-names)) 56 57 ;; Find mutable variables, which will need to be boxed: 58 (define state (make-state)) 59 (extract-state! state unique-e) 60 61 ;; Wrap `ref` around every local-variable reference. Also, 62 ;; perform copy propagation: 63 (define e (wrap-ref unique-e top-names prim-names state)) 64 65 ;; Find all `lambda`s and `case-lambda`s, mapping each to 66 ;; a newly synthesized name: 67 (define lambdas (make-hasheq)) 68 (extract-lambdas! lambdas e) 69 70 (define struct-knowns (extract-structs e)) 71 72 ;; Find all functions that do not need to be kept in a closure. 73 ;; Top-level functions and functions bound with `letrec` are in this 74 ;; category: 75 (define functions (extract-functions #hasheq() e lambdas)) 76 (for ([(id f) (in-sorted-hash functions symbol<?)]) 77 (define e (function-e f)) 78 (hash-set! lambdas e (make-lam id e))) 79 80 (define knowns (hash-directed-union struct-knowns functions)) 81 82 ;; Generate top-level sequence just to set free-variable lists and 83 ;; other state for each lambda: 84 (define max-top-runstack-depth 85 (parameterize ([current-c-output-port (open-output-nowhere)]) 86 (define vehicles (for/list ([lam (in-sorted-hash-values lambdas (compare symbol<? lam-id))]) 87 (lam-vehicle lam))) 88 (define max-top-runstack-depth 89 (generate-tops e 0 exports knowns top-names state lambdas prim-names prim-knowns)) 90 (generate-vehicles vehicles lambdas knowns top-names state prim-names prim-knowns) 91 (hash-set! state '#:done? #t) 92 (reset-genid-counters! '(c_args)) 93 max-top-runstack-depth)) 94 95 ;; Now we know if a function that isn't already in `functions` 96 ;; has zero free variables. If so, effectively lift it to 97 ;; allocate the closure once 98 (define closed-anonymous-functions 99 (for/hash ([lam (in-hash-values lambdas)] 100 #:when (and (null? (lam-free-var-refs lam)) 101 ;; No need if it's only formed at the top, unless 102 ;; `c_self` isn't available for overflow handling: 103 (or (lam-under-lambda? lam) 104 (not (vehicle-closure? (lam-vehicle lam)))) 105 (not (hash-ref functions (lam-id lam) #f)) 106 (not (lam-unused? lam)))) 107 (set-lam-moved-to-top?! lam #t) 108 (values (lam-id lam) lam))) 109 110 ;; Generate prim record: 111 (generate-struct "c_prims" prim-names) 112 (out "static struct c_prims_t c_prims;") 113 114 ;; Generate top-variable record: 115 (generate-struct "startup_instance_top" (hash-union (hash-union top-names functions) 116 closed-anonymous-functions)) 117 (out "THREAD_LOCAL_DECL(static struct startup_instance_top_t *c_startup_instance_top);") 118 (out "#define c_top c__startup_instance_top") 119 120 (define vehicles (merge-vehicles! lambdas state)) 121 122 ;; Generate all the lambda bodies: 123 (generate-prototypes vehicles) 124 (generate-vehicles vehicles lambdas knowns top-names state prim-names prim-knowns) 125 126 ;; Generate top-level sequence, this time to output: 127 (hash-set! state '#:tops? #t) 128 (generate-tops e max-top-runstack-depth exports knowns top-names state lambdas prim-names prim-knowns) 129 130 (generate-footer)) 131