; -*- Lisp -*-
; lambda-calculus-parser: an EuLisp library to parse a list of lambda
; calculus tokens to create a lambda term object.
;
; Copyright (c) 2001 Ian Hickson <ian@hixie.ch>
;
; This program 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 2 of the License, or
; (at your option) any later version.
;
; 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, write to the Free Software
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(defmodule lambda-calculus-parser
  (import (level0 lambda-calculus utilities))

  ;; The parser internal error condition
  (defcondition <parser-error> <condition> token-list: ())

  ;; The main function. This should be passed a <list> output from a
  ;; tokeniser. It returns a <lambda-term>
  (defun parse (token-list)
    (parse-term token-list () (make <hash-table>))) ; XXX euscheme bug workaround -- that should be <table>

  (defun parse-term (token-list bound-variables free-variables)
    (or (parse-variable token-list bound-variables free-variables) ; not a list
        (parse-bracketed-term token-list bound-variables free-variables) ; 1 term
        (parse-abstraction token-list bound-variables free-variables) ; 3 terms starting with L
        (parse-application token-list bound-variables free-variables) ; 2 or more terms
        (error "internal error: unrecognised token list construct" <parser-error> token-list)))

  (defun parse-abstraction (token-list bound-variables free-variables)
    ; check that the token-list is what we want
    (if (and (eql (size token-list) 3)
             (equal (element token-list 0) "L"))
        ; it's an abstraction
        ; let's extract the variable and get the body parsed
        (let* ((new-variable (variable (element token-list 1)))
               (new-body (parse-term (element token-list 2) (cons new-variable bound-variables) free-variables)))
          ; create our abstraction and return it
          (abstraction new-variable new-body)))
    )

  (defun parse-application (token-list bound-variables free-variables)
    ; check that the token-list has at least two terms
    (if (>= (size token-list) 2)
        ; it's an application (assuming it's not an abstraction, anyway)
        ; we want to get two terms out of this
        (let ((term2 (parse-term (element token-list (- (size token-list) 1)) bound-variables free-variables)) ; second term is always last term
              (term1 (if (> (size token-list) 2)
                         ; if there are more than two terms, strip off the last one and repeat
                         ; this handles chains of applications, as in 'abc' -> '(ab)c'
                         (parse-application (pop token-list) bound-variables free-variables)
                       ; otherwise only 2 terms, so first term is first element in list
                       (parse-term (element token-list 0) bound-variables free-variables))))
              ; create application object and return it
              (application term1 term2))))

  (defun parse-bracketed-term (token-list bound-variables free-variables)
    ; bracketed terms are simply lists containing just one list
    (if (eql (size token-list) 1)
        ; the list contains only a list, simply expand it
        (parse-term (element token-list 0) bound-variables free-variables)))

  (defun parse-variable (token-list bound-variables free-variables)
    ; is it just a character on its own?
    (if (characterp token-list)
        ; yes! get the character and turn it into a variable
        ; might be bound, so see if we have it already
        (or (grep token-list bound-variables variable-has-name) ; if so, return existing one
            ; not a bound variable. Look it up in our table and failing that create a new one.
            (or (element free-variables token-list)
                ((setter element) free-variables token-list (variable token-list))))))

  (export parse) ; pass it a tokenised <list>, it returns a <lambda-term>
)