joy-in-the-morning/language/joy-repl/spec.scm

;;; spec.scm -- Guile language specification for Joy's REPL.
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;;
;;; Joy is free software; you can redistribute it and/or modify it under
;;; the terms of the GNU General Public License as published by the Free
;;; Software Foundation; either version 3 of the License, or (at your
;;; option) any later version.
;;;
;;; Joy 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 Joy.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; This pseudo-language provides support for running Joy expressions
;;; interactively, by automatically applying them to a global stack.
;;;
;;; Code:

(define-module (language joy-repl spec)
  #:use-module (system base language)
  #:use-module (language tree-il)
  #:use-module (language joy parser)
  #:use-module (language joy compile-tree-il)
  #:export (joy-repl compile-repl-tree-il))

(define %joy-stack (make-parameter '()))

;;; Guile 2.2 changed the external representation for a procedure call
;;; from 'apply' to 'call'.
(define call
  (if (and (>= (string->number (major-version)) 2)
           (>= (string->number (minor-version)) 2))
      'call
      'apply))

(define (compile-repl-tree-il expr env opts)
  (call-with-values
      (lambda () (compile-tree-il* expr env opts))
    (lambda (op env cenv)
      (values
       (parse-tree-il
	`(begin
	   (,call (@@ (language joy-repl spec) %joy-stack)
		  (,call (toplevel apply)
			 ,op
			 (,call (@@ (language joy-repl spec) %joy-stack))))
	   (,call (@@ (language joy-repl spec) %joy-stack))))
       env cenv))))

(define-language joy-repl
  #:title      "Joy (REPL)"
  #:reader     (lambda (port env) (parse-joy* port #f))
  #:compilers `((tree-il . ,compile-repl-tree-il))
  #:printer    write
  #:make-default-environment
               (lambda () (%joy-stack '())))