module/language/ghil/spec.scm

   1 ;;; Guile High Intermediate Language
   2
   3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   4
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Code:
  20
  21 (define-module (language ghil spec)
  22   #:use-module (system base language)
  23   #:use-module (language glil)
  24   #:use-module (language ghil)
  25   #:use-module (language ghil compile-glil)
  26   #:export (ghil))
  27
  28 (define (write-ghil exp . port)
  29   (apply write (unparse-ghil exp) port))
  30
  31 (define (parse x)
  32   (call-with-ghil-environment (make-ghil-toplevel-env (current-module)) '()
  33     (lambda (env vars)
  34       (make-ghil-lambda env #f vars #f '() (parse-ghil env x)))))
  35
  36 (define (join exps env)
  37   (if (or-map (lambda (x)
  38                 (or (not (ghil-lambda? x))
  39                     (ghil-lambda-rest x)
  40                     (memq 'argument
  41                           (map ghil-var-kind
  42                                (ghil-env-variables (ghil-lambda-env x))))))
  43               exps)
  44       (error "GHIL expressions to join must be thunks"))
  45
  46   (let ((env (make-ghil-env env '()
  47                             (apply append
  48                                    (map ghil-env-variables
  49                                         (map ghil-lambda-env exps))))))
  50     (make-ghil-lambda env #f '() #f '()
  51                       (make-ghil-begin env #f
  52                                        (map ghil-lambda-body exps)))))
  53
  54 (define-language ghil
  55   #:title       "Guile High Intermediate Language (GHIL)"
  56   #:version     "0.3"
  57   #:reader      read
  58   #:printer     write-ghil
  59   #:parser      parse
  60   #:joiner      join
  61   #:compilers   `((glil . ,compile-glil))
  62   )