;;; toplevel-dispatch.scm
;;;
;;; Procedures to parse top-level Scheme expressions and invoke the 
;;; appropriate lower-level handlers.
;;;
;;; Copyright (C) 2002 Anton van Straaten <anton@ppsolutions.com>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License, 
;;; version 2, as published by the Free Software Foundation.
;;;
;;; This program is distributed in the hope that it will be useful, 
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, see http://www.gnu.org/copyleft/gpl.html
;;;
;;; -------------------------------------------------------------------------

      
(define (expression-meaning-toplevel e)
  (if (not (pair? e))
      (expression-meaning e)
      (case (ds:first e)
        ((begin)  ; top-level begin logic was adapated from lambda command sequence processing
                  (let* ((expr-pair (split-list-at-end (ds:rest e)))
                         (g* (car expr-pair))
                         (e0 (cdr expr-pair)))
                    (lambda (r k)
                      ((meaning-toplevel-command-sequence g*)
                       r
                       ; delay required to avoid out-of-order evaluation of final expression
                       (delay ((expression-meaning-toplevel e0) r k))))))
        ((define) (expression-guard-min e 3
                   (lambda ()
                     (if (pair? (cadr e))
                         (expression-meaning-procedure-definition (ds:second e) (cddr e))
                          (expression-guard e 3
                           (lambda ()
                             (expression-meaning-toplevel-definition (ds:second e) (ds:third e))))))))
        (else     (expression-meaning e)))))

;; The following were adapted from the equivalent semantic functions, 
;; to support processing of commands in a top-level 'begin' expression.
;;
;; adapted from meaning-command-sequence
  
(define (meaning-toplevel-command-sequence g*)
  (if (zero? (ds:length g*))
      (command-meaning-null)
      (toplevel-command-meaning-sequence (ds:first g*) (ds:rest g*))))

;; adapted from command-meaning-sequence
  
(define (toplevel-command-meaning-sequence g0 g*)
  (lambda (r theta)
    ((expression-meaning-toplevel g0) 
     r
     (lambda (e*) ((meaning-toplevel-command-sequence g*) r theta)))))