; $Id: gen-app.scm 2156 2008-01-25 13:25:12Z schimans $

; Generic applications: The user hook to define new syntax, written as
; application.

; The global look-up table for all kinds of applications:

(define GENERIC-APPLICATION-TABLE '())
(define INITIAL-GENERIC-APPLICATION-TABLE GENERIC-APPLICATION-TABLE)

; The interface to the parser:

(define (make-gen-application x y)
  (define (make-gen-app-aux l type x y)
    (cond
     ((null? l)
      (myerror "make-gen-application: unknown form of application"
	       (type-to-string type)))
     (((caar l) type) ((cdar l) x y))
     (else (make-gen-app-aux (cdr l) type x y))))
  (make-gen-app-aux GENERIC-APPLICATION-TABLE (term-to-type x) x y))

; The interface for the user:

(define (add-new-application pred fun)
  (set! GENERIC-APPLICATION-TABLE
	(cons (cons pred fun)
	      GENERIC-APPLICATION-TABLE)))

; The inverse: User can specify terms to be recognized as generic
; applications

(define GENERIC-APPLICATION-SYNTAX-TABLE '())
(define INITIAL-GENERIC-APPLICATION-SYNTAX-TABLE
  GENERIC-APPLICATION-SYNTAX-TABLE)

(define (add-new-application-syntax pred toarg toop)
  (set! GENERIC-APPLICATION-SYNTAX-TABLE
	(cons (list pred toarg toop)
	      GENERIC-APPLICATION-SYNTAX-TABLE)))

(define (term-in-symbolic-app-form? term)
  (term-in-symbolic-app-form-aux GENERIC-APPLICATION-SYNTAX-TABLE term))

(define (term-in-symbolic-app-form-aux l term)
  (cond ((null? l) #f)
	(((caar l) term) #t)
	(else (term-in-symbolic-app-form-aux (cdr l) term))))
	 
(define (term-in-symbolic-app-form-to-arg term)
  (term-in-symbolic-app-form-to-arg-aux GENERIC-APPLICATION-SYNTAX-TABLE term))

(define (term-in-symbolic-app-form-to-arg-aux l term)
  (cond ((null? l)
	 (myerror "term-in-symbolic-app-form-to-arg: not a symbolic app!"
		  (term-to-string term)))
	(((caar l) term)
	 ((cadar l) term))
	(else (term-in-symbolic-app-form-to-arg-aux (cdr l) term))))

(define (term-in-symbolic-app-form-to-op term)
  (term-in-symbolic-app-form-to-op-aux GENERIC-APPLICATION-SYNTAX-TABLE term))

(define (term-in-symbolic-app-form-to-op-aux l term)
  (cond ((null? l)
	 (myerror "term-in-symbolic-app-form-to-op: not a symbolic app!"
		  (term-to-string term)))
	(((caar l) term)
	 ((caddar l) term))
	(else (term-in-symbolic-app-form-to-op-aux (cdr l) term))))
