source: project/release/5/slib-prec/trunk/slib-prec-grammar.scm @ 38598

;;;; slib-prec-grammar.scm  -*- Scheme -*-
;;;; Kon Lovett, Apr '20
;;;; Kon Lovett, Apr '18

(module slib-prec-grammar

(;export
  ;
  active-grammar
  active-grammar-set!
  read-syntax-setup!
  ;
  make-grammar
  grammar?
  grammar-name
  grammar-reader
  grammar-read-tab
  grammar-writer
  grammar-write-tab
  ;
  grammar-id-name-set!
  grammar-id-name
  list-of-grammar-ids
  count-of-grammar-ids
  clear-grammar-ids
  grammar-id-name-setup!
  ;
  defgrammar
  get-grammar
  list-of-grammars
  count-of-grammars
  get-grammar/id
  clear-grammars
  ;
  read-sexp
  write-sexp
  print-using-grammar
  flush-input-whitespace)

(import scheme)
(import (chicken base))
(import (chicken type))
(import slib-prec)

;;;

(define mod modulo)

(include "slib-compat")

(define (math:error . args) (apply slib:error 'math: args))
(define (math:warn . args) (apply slib:warn 'math: args))
(define (math:exit b) #;(cleanup-handlers!) (slib:error "error in math system"))

(include "slib-grammar")

(define *input-grammar*)
(define *output-grammar*)
(define *echo-grammar*)

(include "output-grammars")
(include "input-grammars")

(defgrammar 'null
  (make-grammar
    'null
                (lambda (grm) (math:error 'cannot-read-null-grammar))
                #f
                (lambda (sexp grm) #t)
                #f))

(defgrammar 'scheme
  (make-grammar
    'scheme
                (lambda (grm) (read))
                #f
                (lambda (sexp grm) (write sexp) (force-output))
                #f))

;;; Establish autoload for PRETTY-PRINT.
(defgrammar 'schemepretty
  (make-grammar
    'schemepretty
    (lambda (grm)
      (read) )
    #f
    (lambda (sexp grm)
      (import (chicken pretty-print))
      (pretty-print sexp)
      (force-output) )
    #f))

(define (active-grammar-set! input output #!optional (echo 'null))
  (set! *input-grammar* (get-grammar input))
  (set! *output-grammar* output)
  (set! *echo-grammar* echo) )

(define (active-grammar) (values *input-grammar* *output-grammar* *echo-grammar*))

;;

(define (read-syntax-setup!)
  (import (only (chicken base) parentheses-synonyms))
  (import (only (chicken read-syntax) set-sharp-read-syntax! set-parameterized-read-syntax!))
  (parentheses-synonyms #f)
  (set-sharp-read-syntax! #\{
    (lambda (port)
      (read-sexp/delim (get-grammar/id 0) #\} port)))
  (set-parameterized-read-syntax! #\{
    (lambda (port id)
      (read-sexp/delim (get-grammar/id id) #\} port))) )

;;

;init by id-# grammar lookup
(define-constant DEFAULT-GRAMMARS '(
  standard disp2d tex
  null scheme schemepretty))
(grammar-id-name-setup! DEFAULT-GRAMMARS)

) ;slib-prec-grammar