-*- scheme -*-

===========================================================================
macromod Notes:

 - Make the module store explicit.
   - keyed by full module name/path?
   - tie in to vicinities? (recent SRFI proposal)

 - compile-module :: form * modulestore --> modulestore

   - adds <reqd> annotations to forms in the module body, for
     use by compile-expr later.

 - compile-expr :: form * phase * eenv * store --> parsed-exp * store

Note that 'store' above holds the bindings-at-toplevel for
visited and invoked modules, and compile-time-state. The 'eenv'
is the lexical compile-time environment. The 'modulestore' is the
total set of (not-yet-visited) modules, i.e. module templates.

The algorithms for 'visit!' and 'invoke!' below are taken from
the prose in section 5 of the macromod paper:

 - visit :: modulename * phase * modulestore * store --> store

   ;; Modifies module-store (through compilation of modules not-yet-compiled)
   ;; and namespace (by adding bindings for the visited module)
   (define (visit! module-name relative-phase module-store namespace)
     (let ((module-definition (lookup-or-compile-module-definition module-store module-name)))
       (for-each (lambda (required-name)
		   (visit! required-name relative-phase module-store namespace))
		 (module-definition-direct-requires module-definition))
       (for-each (lambda (required-name)
		   (visit! required-name (+ relative-phase 1) module-store namespace)
		   (invoke! required-name (+ relative-phase 1) module-store namespace))
		 (module-definition-direct-requires-for-syntax module-definition))
       (parameterize ((relative-phase-shift relative-phase))
	 (for-each (lambda (binding-name parsed-exp)
		     (install-module-binding! namespace
					      module-name
					      binding-name
					      ;; is a phase offset required?
					      (parsed-exp-eval parsed-exp namespace)))
		   (module-definition-syntax-bindings module-definition)))))

 - invoke :: modulename * phase * modulestore * store --> store

   (define (invoke! module-name relative-phase module-store namespace)
     (let ((module-definition (lookup-or-compile-module-definition module-store module-name)))
       (for-each (lambda (required-name)
		   (invoke! required-name relative-phase module-store namespace))
		 (module-definition-direct-requires module-definition))
       (parameterize ((relative-phase-shift relative-phase))
	 (for-each (lambda (binding-name parsed-exp)
		     (install-module-binding! namespace
					      module-name
					      binding-name
					      ;; is a phase offset required?
					      (parsed-exp-eval parsed-exp namespace)))
		   (module-definition-bindings module-definition)))))

Old note, not sure what I meant:
  Captured continuations need annotating with their phase??

===========================================================================
syntax-case Notes:

Implementing syntax-case and the syntax template producer:
 - pattern-variables need annotating with their ellipsis-nesting-level
 - ellipsis quoting: ((... ...) (... ...)) etc.

Each syntax-case clause
 - matches against the pattern
 - if the match is successful, transmits the binding(-list)s out
 - evaluates its optional guard
 - binds the bindings as leveled pattern variables in the RHS

Each syntax form
 - refers to pattern variables in a kind of list-comprehension stylee
 - nesting of comprehensions must match levels in the same way
   the packrat expander does

(sc-expand '
(define-syntax example
  (lambda (x)
    (syntax-case x ()
      ((_ a (c ...) (b ...) ...)
       (syntax '(((a b c) ...) ...))))))
)

>>> (example 1 (2 3) (4 5) (6 7))
--> (((1 4 2) (1 5 3)) ((1 6 2) (1 7 3)))

(lambda (x)
  (let ((matchresult ($syntax-dispatch (#%annotate x value)
				       (#%quote (any any each-any . #2(each each-any))))))
    (if matchresult
	(apply (lambda (_ a c b)
		 (list <quote-id>
		       (map (lambda (b1)
			      (map (lambda (c1 b2)
				     (list a
					   b2
					   c1))
				   c
				   b1))
			    b)))
	       matchresult)
	(syntax-error x))))

;; From SISC's sc-expand on the example macro above:
($sc-put-cte
  'example
  (#%lambda #t
    (|x_qV3fJeuQJ|)
    ()
    ((#%lambda #t
       (|tmp_qVpbHHuQJ|)
       ()
       ((#%lambda #t
          (|matchresult|)
          (|tmp_qVpbHHuQJ|)
          (#%if |matchresult|
            (apply (#%lambda #t
                     (|__qV54DBvQJ|
                       |a_qVr0B2wQJ|
                       |c_qVNYyvwQJ|
                       |b_qV7VwYwQJ|)
                     ()
                     (list #3(syntax-object
                              quote
                              ((top)
                               #4(ribcage
                                  #4(_ a c b)
                                  #4((top))
                                  #4("i" "i" "i" "i"))
                               #4(ribcage ())
                               #4(ribcage #1(x) #1((top)) #1("i"))
                               #4(ribcage (#2(import-token *top*)) ())))
                           (map (#%lambda #t
                                  (|b1|)
                                  (|c_qVNYyvwQJ| |a_qVr0B2wQJ|)
                                  (map (#%lambda #t
                                         (c1 b2)
                                         (|a_qVr0B2wQJ|)
                                         (list |a_qVr0B2wQJ|
                                               b2
                                               c1))
                                       |c_qVNYyvwQJ|
                                       |b1|))
                                |b_qV7VwYwQJ|)))
                   |matchresult|)
            (syntax-error |tmp_qVpbHHuQJ|)))
        ($syntax-dispatch
          (#%annotate |tmp_qVpbHHuQJ| value)
          (#%quote (any any each-any . #2(each each-any))))))
     |x_qV3fJeuQJ|)))


;; Expansions from psyntax:

(define-syntax and
   (lambda (x)
      (syntax-case x ()
         ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
         ((_ e) (syntax e))
         ((_) (syntax #t)))))

($sc-put-cte
  'and
  (lambda (g2284)
    (let ((g2286 ($syntax-dispatch g2284 '(any any any . each-any))))
      (if g2286
	  (apply
	   (lambda (g2287 g2288 g2289 g2290)
	     (cons <if-id>
		   (cons g2288
			 (cons (cons <and-id>
				     (cons g2289 g2290))
			       <literal-false>))))
	   g2286)
	  (let ((g2292 ($syntax-dispatch g2284 '(any any))))
	    (if g2292
		(apply (lambda (g2293 g2294) g2294) g2292)
		(let ((g2295 ($syntax-dispatch g2284 '(any))))
		  (if g2295
		      (apply (lambda (g2296) <literal-true>) g2295)
		      (syntax-error g2284))))))))
  '*top*)

(pretty-print (parsed-expression->datum (expand
'(lambda (x)
   (syntax-case x ()
     ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
     ((_ e) (syntax e))
     ((_) (syntax #t))))
(initial-eenv))))

;;; Local Variables:
;;; eval: (put 'match-pair 'scheme-indent-function 1)
;;; End: