Inlining

qi-lib/flow/core/compiler.rkt

@@ -4,10 +4,11 @@
 
 (require (for-syntax racket/base
                      syntax/parse)
-         "compiler/1000-qi0.rkt"
-         "compiler/2000-bindings.rkt"
+         "compiler/0005-inline.rkt"
          "compiler/0010-normalize.rkt"
          "compiler/0100-deforest.rkt"
+         "compiler/1000-qi0.rkt"
+         "compiler/2000-bindings.rkt"
          "passes.rkt")
 
 (begin-for-syntax

qi-lib/flow/core/compiler/0005-inline.rkt

@@ -0,0 +1,64 @@
+#lang racket/base
+
+(provide (for-syntax inline-pass
+                     flowdef))
+
+(require (for-syntax racket/base
+                     racket/promise
+                     racket/syntax
+                     syntax/parse
+                     syntax/id-table
+                     "../strategy.rkt"
+                     "../private/form-property.rkt")
+         "../passes.rkt")
+
+(begin-for-syntax
+  (struct flowdef (name expanded)
+    #:transparent
+    #:property prop:set!-transformer
+    (λ (flowdef-instance stx)
+      ;; stx is either (flow-name arg ...) or simply flow-name
+      (syntax-parse stx
+        [_:id (flowdef-name flowdef-instance)]
+        ;; use . args instead of ... to be agnostic to the possibility
+        ;; of any #%app transformers being at play
+        [(id:id . args) (datum->syntax stx
+                          (cons #'(#%expression id) #'args) stx)]
+        [((~literal set!) _1 _2)
+         (raise-syntax-error #f "set! not allowed!")]))))
+
+(begin-for-syntax
+  (define ((inline-rewrite already-inlined-table) stx)
+    (syntax-parse stx
+      #:track-literals
+      #:datum-literals (#%host-expression
+                        esc)
+      [(esc (#%host-expression id))
+       #:declare id (static flowdef? "flow name")
+       #:fail-when (free-id-table-ref already-inlined-table
+                                      #'id
+                                      #false) #false
+       ;; def is now bound to the flowdef struct instance
+       (define def (attribute id.value))
+       (define inlinable-code (force (flowdef-expanded def)))
+       (define already-inlined-table*
+         (free-id-table-set already-inlined-table
+                            #'id
+                            #true))
+       (define inlined-def
+         (find-and-map/qi
+          (inline-rewrite already-inlined-table*)
+          inlinable-code))
+       (syntax-property inlined-def 'qi-do-not-recurse #t)]
+      [_ stx]))
+
+  (define-and-register-pass 5 (inline-pass stx)
+    (attach-form-property
+     (find-and-map/qi
+      ;; "knapsack" problem
+      (inline-rewrite (make-immutable-free-id-table)) ; don't use fixed-point finding
+      ;; check if identifier
+      ;; check if bound to flowdef struct
+      ;; then do inlining
+      ;; can probably use syntax-local-apply-transformer, should do everything that we need.
+      stx))))

qi-lib/flow/core/compiler/1000-qi0.rkt

@@ -22,125 +22,129 @@
   ;; this is a macro so it receives the entire expression
   ;; (qi0->racket ...). We use cadr here to parse the
   ;; contained expression.
-  (syntax-parse (cadr (syntax->list stx))
-
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;;;; Core language forms ;;;;
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-    ;; A note regarding symbolic aliases like ~>, ⏚ and △:
-    ;;
-    ;; These aren't technically part of the core language
-    ;; as they aren't directly part of the syntax
-    ;; spec in the expander (which includes only, e.g.,
-    ;; thread and tee and so on). Instead, they are simply
-    ;; aliased at the module level there when provided.
-    ;; Yet, during code generation in the present module,
-    ;; it's more convenient to express expansions
-    ;; using these symbolic aliases, and that's the
-    ;; reason we retain these in the patterns below. As
-    ;; these patterns are matched as _datum literals_,
-    ;; it doesn't matter that they aren't actually the
-    ;; literal core forms declared in the expander.
-
-    [((~datum gen) ex:expr ...)
-     #'(λ _ (values ex ...))]
-    ;; pass-through (identity flow)
-    [(~datum _) #'values]
-    ;; routing
-    [(~or* (~datum ⏚) (~datum ground)) ; NOTE: technically not core
-     #'(qi0->racket (select))]
-    [((~or* (~datum ~>) (~datum thread)) onex:clause ...)
-     #`(compose . #,(reverse
-                     (syntax->list
-                      #'((qi0->racket onex) ...))))]
-    [e:relay-form (relay-parser #'e)]
-    [e:tee-form (tee-parser #'e)]
-    ;; map and filter
-    [e:amp-form (amp-parser #'e)] ; NOTE: technically not core
-    [e:pass-form (pass-parser #'e)] ; NOTE: technically not core
-    ;; prisms
-    [e:sep-form (sep-parser #'e)]
-    [(~or* (~datum ▽) (~datum collect))
-     #'list]
-    ;; predicates
-    [(~or* (~datum NOT) (~datum !))
-     #'not]
-    [(~datum XOR)
-     #'parity-xor]
-    [((~datum and) onex:clause ...)
-     #'(conjoin (qi0->racket onex) ...)]
-    [((~datum or) onex:clause ...)
-     #'(disjoin (qi0->racket onex) ...)]
-    [((~datum not) onex:clause) ; NOTE: technically not core
-     #'(negate (qi0->racket onex))]
-    [((~datum all) onex:clause)
-     #`(give (curry andmap (qi0->racket onex)))]
-    [((~datum any) onex:clause)
-     #'(give (curry ormap (qi0->racket onex)))]
-
-    ;; selection
-    [e:select-form (select-parser #'e)]
-    [e:block-form (block-parser #'e)]
-    [e:group-form (group-parser #'e)]
-    ;; conditionals
-    [e:if-form (if-parser #'e)]
-    [e:sieve-form (sieve-parser #'e)]
-    [e:partition-form (partition-parser #'e)]
-    ;; exceptions
-    [e:try-form (try-parser #'e)]
-    ;; folds
-    [e:fold-left-form (fold-left-parser #'e)]
-    [e:fold-right-form (fold-right-parser #'e)]
-    ;; high-level routing
-    [e:fanout-form (fanout-parser #'e)]
-    ;; looping
-    [e:feedback-form (feedback-parser #'e)]
-    [e:loop-form (loop-parser #'e)]
-    [((~datum loop2) pred:clause mapex:clause combex:clause)
-     #'(letrec ([loop2 (qi0->racket (if pred
-                                        (~> (== (-< (esc cdr)
-                                                    (~> (esc car) mapex)) _)
-                                            (group 1 _ combex)
-                                            (esc loop2))
-                                        (select 2)))])
-         loop2)]
-    ;; towards universality
-    [(~datum appleye)
-     #'call]
-    [e:clos-form (clos-parser #'e)]
-    [e:deforestable-form (deforestable-parser #'e)]
-    ;; escape hatch for racket expressions or anything
-    ;; to be "passed through"
-    [((~datum esc) ex:expr)
-     #'ex]
-
-    ;;; Miscellaneous
-
-    ;; Partial application with syntactically pre-supplied arguments
-    ;; in a blanket template
-    [((~datum #%blanket-template) e)
-     (blanket-template-form-parser this-syntax)]
-
-    ;; Fine-grained template-based application
-    ;; This handles templates that indicate a specific number of template
-    ;; variables (i.e. expected arguments). The semantics of template-based
-    ;; application here is fulfilled by the fancy-app module. In order to use
-    ;; it, we simply use the #%app macro provided by fancy-app instead of the
-    ;; implicit one used for function application in racket/base.
-    ;; "prarg" = "pre-supplied argument"
-    [((~datum #%fine-template) (prarg-pre ... (~datum _) prarg-post ...))
-     #'(fancy:#%app prarg-pre ... _ prarg-post ...)]
-
-    ;; If in the course of optimization we ever end up with a fully
-    ;; simplified host expression, the compiler would a priori reject it as
-    ;; not being a core Qi expression. So we add this extra rule here
-    ;; to simply pass this expression through.
-    ;; TODO: should `#%host-expression` be formally declared as being part
-    ;; of the core language by including it in the syntax-spec grammar
-    ;; in extended/expander.rkt?
-    [((~datum #%host-expression) hex)
-     this-syntax]))
+  (define argument-stx (cadr (syntax->list stx)))
+  (syntax-track-origin
+   (syntax-parse argument-stx
+
+     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+     ;;;; Core language forms ;;;;
+     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+     ;; A note regarding symbolic aliases like ~>, ⏚ and △:
+     ;;
+     ;; These aren't technically part of the core language
+     ;; as they aren't directly part of the syntax
+     ;; spec in the expander (which includes only, e.g.,
+     ;; thread and tee and so on). Instead, they are simply
+     ;; aliased at the module level there when provided.
+     ;; Yet, during code generation in the present module,
+     ;; it's more convenient to express expansions
+     ;; using these symbolic aliases, and that's the
+     ;; reason we retain these in the patterns below. As
+     ;; these patterns are matched as _datum literals_,
+     ;; it doesn't matter that they aren't actually the
+     ;; literal core forms declared in the expander.
+
+     [((~datum gen) ex:expr ...)
+      #'(λ _ (values ex ...))]
+     ;; pass-through (identity flow)
+     [(~datum _) #'values]
+     ;; routing
+     [(~or* (~datum ⏚) (~datum ground)) ; NOTE: technically not core
+      #'(qi0->racket (select))]
+     [((~or* (~datum ~>) (~datum thread)) onex:clause ...)
+      #`(compose . #,(reverse
+                      (syntax->list
+                       #'((qi0->racket onex) ...))))]
+     [e:relay-form (relay-parser #'e)]
+     [e:tee-form (tee-parser #'e)]
+     ;; map and filter
+     [e:amp-form (amp-parser #'e)] ; NOTE: technically not core
+     [e:pass-form (pass-parser #'e)] ; NOTE: technically not core
+     ;; prisms
+     [e:sep-form (sep-parser #'e)]
+     [(~or* (~datum ▽) (~datum collect))
+      #'list]
+     ;; predicates
+     [(~or* (~datum NOT) (~datum !))
+      #'not]
+     [(~datum XOR)
+      #'parity-xor]
+     [((~datum and) onex:clause ...)
+      #'(conjoin (qi0->racket onex) ...)]
+     [((~datum or) onex:clause ...)
+      #'(disjoin (qi0->racket onex) ...)]
+     [((~datum not) onex:clause) ; NOTE: technically not core
+      #'(negate (qi0->racket onex))]
+     [((~datum all) onex:clause)
+      #`(give (curry andmap (qi0->racket onex)))]
+     [((~datum any) onex:clause)
+      #'(give (curry ormap (qi0->racket onex)))]
+
+     ;; selection
+     [e:select-form (select-parser #'e)]
+     [e:block-form (block-parser #'e)]
+     [e:group-form (group-parser #'e)]
+     ;; conditionals
+     [e:if-form (if-parser #'e)]
+     [e:sieve-form (sieve-parser #'e)]
+     [e:partition-form (partition-parser #'e)]
+     ;; exceptions
+     [e:try-form (try-parser #'e)]
+     ;; folds
+     [e:fold-left-form (fold-left-parser #'e)]
+     [e:fold-right-form (fold-right-parser #'e)]
+     ;; high-level routing
+     [e:fanout-form (fanout-parser #'e)]
+     ;; looping
+     [e:feedback-form (feedback-parser #'e)]
+     [e:loop-form (loop-parser #'e)]
+     [((~datum loop2) pred:clause mapex:clause combex:clause)
+      #'(letrec ([loop2 (qi0->racket (if pred
+                                         (~> (== (-< (esc cdr)
+                                                     (~> (esc car) mapex)) _)
+                                             (group 1 _ combex)
+                                             (esc loop2))
+                                         (select 2)))])
+          loop2)]
+     ;; towards universality
+     [(~datum appleye)
+      #'call]
+     [e:clos-form (clos-parser #'e)]
+     [e:deforestable-form (deforestable-parser #'e)]
+     ;; escape hatch for racket expressions or anything
+     ;; to be "passed through"
+     [((~datum esc) ex:expr)
+      #'ex]
+
+     ;;; Miscellaneous
+
+     ;; Partial application with syntactically pre-supplied arguments
+     ;; in a blanket template
+     [((~datum #%blanket-template) e)
+      (blanket-template-form-parser this-syntax)]
+
+     ;; Fine-grained template-based application
+     ;; This handles templates that indicate a specific number of template
+     ;; variables (i.e. expected arguments). The semantics of template-based
+     ;; application here is fulfilled by the fancy-app module. In order to use
+     ;; it, we simply use the #%app macro provided by fancy-app instead of the
+     ;; implicit one used for function application in racket/base.
+     ;; "prarg" = "pre-supplied argument"
+     [((~datum #%fine-template) (prarg-pre ... (~datum _) prarg-post ...))
+      #'(fancy:#%app prarg-pre ... _ prarg-post ...)]
+
+     ;; If in the course of optimization we ever end up with a fully
+     ;; simplified host expression, the compiler would a priori reject it as
+     ;; not being a core Qi expression. So we add this extra rule here
+     ;; to simply pass this expression through.
+     ;; TODO: should `#%host-expression` be formally declared as being part
+     ;; of the core language by including it in the syntax-spec grammar
+     ;; in extended/expander.rkt?
+     [((~datum #%host-expression) hex)
+      this-syntax])
+   argument-stx
+   #'qi0->racket))
 
 #|
 

qi-lib/flow/core/strategy.rkt

@@ -21,15 +21,15 @@
   ;; f : syntax? -> (or/c syntax? #f)
   (match stx
     [(? syntax?) (let ([stx^ (f stx)])
-                   (if stx^
-                       ;; we keep traversing the produced syntax
-                       ;; to transform nested syntax as needed
-                       (datum->syntax stx^
-                         (find-and-map f (syntax-e stx^))
-                         stx^
-                         stx^)
-                       ;; false was returned, so we stop
-                       stx))]
+                   (cond [(not stx^) stx] ; false was returned, so we stop
+                         [(syntax-property stx^ 'qi-do-not-recurse)
+                          (syntax-property-remove stx^ 'qi-do-not-recurse)]
+                         ;; we keep traversing the produced syntax
+                         ;; to transform nested syntax as needed
+                         [else (datum->syntax stx^
+                                 (find-and-map f (syntax-e stx^))
+                                 stx^
+                                 stx^)]))]
     [(cons a d) (cons (find-and-map f a)
                       (find-and-map f d))]
     [_ stx]))

qi-lib/on.rkt

@@ -9,11 +9,16 @@
 (require syntax/parse/define
          (for-syntax racket/base
                      syntax/parse/lib/function-header
-                     "flow/aux-syntax.rkt")
+                     "flow/aux-syntax.rkt"
+                     racket/syntax
+                     racket/promise)
+         (only-in "flow/core/compiler/0005-inline.rkt"
+                  flowdef)
          "flow.rkt"
          (only-in "private/util.rkt"
                   define-alias
-                  params-parser))
+                  params-parser)
+         (submod "flow/extended/expander.rkt" invoke))
 
 (define-syntax-parser on
   [(_ args:subject)
@@ -37,12 +42,17 @@
 (define-alias π flow-lambda)
 (define-alias flow-λ flow-lambda)
 
+;; TODO: disallow set! of these bindings to anything else
 (define-syntax-parser define-flow
   [(_ ((~or* head:id head:function-header) . args:formals)
       clause:clause)
    #'(define head
        (flow-lambda args
-         clause))]
+                    clause))]
   [(_ name:id clause:clause)
-   #'(define name
-       (flow clause))])
+   #:with new-name (format-id #'hi "flow:~a" #'name)
+   #'(begin
+       (define-syntax name
+         (flowdef #'new-name (delay (expand-flow #'clause))))
+       (define new-name
+         (flow clause)))])