home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / b116_1 / jacal / English < prev    next >
Text File  |  1993-12-21  |  17KB  |  508 lines
  1. ;;; JACAL: Symbolic Mathematics System.        -*-scheme-*-
  2. ;;; Copyright (C) 1989, 1990, 1991, 1992, 1993 Aubrey Jaffer.
  3. ;;; See the file `COPYING' for terms applying to this program.
  4.  
  5. (define tran:translations
  6.   '((Last-expression-lost . "; Last expression lost.")
  7.     (bad-arglist . "bad arglist ")
  8.     (Column-of-non-matrix?:-- . "Column of non-matrix?: ")
  9.     (Coordinate-out-of-range:-- . "Coordinate out of range: ")
  10.     (funny-length-vectors . "funny length vectors ")
  11.     (unequal-length-vectors . "unequal length vectors ")
  12.     (Did-not-verify: . "Did not verify:")
  13.     (ERROR . "ERROR")
  14.     (Expt-of-equation?:-- . "Expt of equation?: ")
  15.     (Inexact-number-to-eval:- . "Inexact number to eval: ")
  16.     (Non-rational-radicand:-- . "Non-rational radicand: ")
  17.     (Not-a-Number . "Not a Number")
  18.     (Not-a-matrix:-- . "Not a matrix: ")
  19.     (Row-of-non-matrix?:-- . "Row of non-matrix?: ")
  20.     (application . "application ")
  21.     (argument . " argument ")
  22.     (arguments . " arguments ")
  23.     (bad-info-entry . "bad info entry")
  24.     (bunch . "bunch")
  25.     (can-not-be-read . "can not be read")
  26.     (can-not-be-set . "can not be set")
  27.     (cannot-be-coerced-to-expl:-- . "cannot be coerced to expl:")
  28.     (cannot-be-coerced-to-expr:-- . "cannot be coerced to expr: ")
  29.     (cannot-be-coerced-to-implicit:-- . "cannot be coerced to implicit: ")
  30.     (cannot-be-coerced-to-poly-eqn:-- . "cannot be coerced to poly eqn: ")
  31.     (cannot-extract-denominator- . "cannot extract denominator ")
  32.     (cannot-extract-numerator- . "cannot extract numerator ")
  33.     (cannot-read-null-grammar . "cannot read null grammar")
  34.     (cannot-suchthat-a-vector . "cannot suchthat a vector")
  35.     (cc-of . "cc of ")
  36.     (column-vector . "column vector")
  37.     (could-not-clear-denominator-of:- . "could not clear denominator of: ")
  38.     (delimiter-expected--ignoring-rest . "delimiter expected-ignoring rest")
  39.     (determinant-of-non-square-matrix . "determinant of non-square matrix")
  40.     (differential- . "differential ")
  41.     (does-not-appear-in- . " does not appear in ")
  42.     (does-not-divide- . " does not divide ")
  43.     (does-not-udivide- . " does not udivide ")
  44.     (dotproduct-of-unequal-size-matrices:-- . "dotproduct of unequal size matrices: ")
  45.     (elim-bunch?- . "elim bunch?")
  46.     (eliminating-from-more-than-one-expression?- . "eliminating from more than one expression?")
  47.     (eliminating: . "eliminating:")
  48.     (elimination-type-not-handled . "elimination type not handled")
  49.     (equation . "equation")
  50.     (expected-boolean . "expected boolean")
  51.     (expected-boolean-or-number . "expected boolean or number")
  52.     (expected-simple-symbol . "expected simple symbol")
  53.     (expression-missing . "expression missing")
  54.     (extra-delimiter . "extra delimiter")
  55.     (extra-separator . "extra separator")
  56.     (false . "false")
  57.     (flag . "flag")
  58.     (for-help. . " for help.")
  59.     (free-var-to-var:elim . "free var to var:elim")
  60.     (from: . " from:")
  61.     (function-of- . " function of ")
  62.     (grammar . "grammar")
  63.     (implicit-expression . "implicit expression")
  64.     (is-not-defined . "is not defined")
  65.     (matrix . "matrix")
  66.     (matrix-product-of-unequal-size-matrices:-- . "matrix product of unequal size matrices: ")
  67.     (mismatched-delimiter . "mismatched delimiter")
  68.     (more . "--more--")
  69.     (no-example-for . "no example for ")
  70.     (no-value-to-set . "no value to set")
  71.     (no-variables? . "no variables?")
  72.     (non-integer-power?-- . "non-integer power? ")
  73.     (normalize-symbol?- . "normalize symbol? ")
  74.     (normalizing: . "normalizing:")
  75.     (not-a-bunch? . "not a bunch?")
  76.     (not-a-function? . "not a function?")
  77.     (not-a-polynomial-equation . "not a polynomial equation")
  78.     (not-a-polynomial? . "not a polynomial?")
  79.     (not-a-simple-variable:- . "not a simple variable: ")
  80.     (not-an-integer- . "not an integer ")
  81.     (not-an-operator . "not an operator")
  82.     (not-canonical . "not canonical ")
  83.     (not-enough-equations . "not enough equations")
  84.     (not-known . "not known")
  85.     (not-s-expression . " not s-expression")
  86.     (number . "number")
  87.     (of- . " of ")
  88.     (off . "off")
  89.     (on . "on")
  90.     (or- . " or ")
  91.     (partial-with-respect-to? . "partial with respect to?")
  92.     (polynomial . "polynomial")
  93.     (q-to-quit-space-for-more:- . " q to quit, space for more: ")
  94.     (radical . "radical")
  95.     (rational-expression . "rational expression")
  96.     (redefined-from- . " redefined from ")
  97.     (redefined-to- . " redefined to ")
  98.     (row-vector . "row vector")
  99.     (to- . " to ")
  100.     (to-return-to- . " to return to ")
  101.     (trouble-with . "trouble with ")
  102.     (true . "true")
  103.     (type . "type ")
  104.     (type- . ", type ")
  105.     (unknown . "unknown")
  106.     (value-expected-equation-found:-- . "value expected, equation found: ")
  107.     (variable . "variable ")
  108.     (wna . ": Wrong number of args ")
  109.     (wta . ": Wrong type ")
  110.     (yielding: . "yielding:")))
  111.  
  112. ;;;; Here are the templates for 2 dimensional output
  113.  
  114. (define tps:2d
  115.   '(
  116.     (TEMPLATE:DEFAULT 140 #d0140 "(" #d1010 #(REST ", " #d2010) ")")
  117.     (TEMPLATE:BUNCH 140 "[" #d0010 #(REST ", " BREAK #d1010) "]")
  118.     (TEMPLATE:MATRIX 140 (#\[) #d0010 #(REST "  " #d1010) (#\]))
  119.     (TEMPLATE:PARENTHESIS 200 "(" #d1010 ")")
  120.     (- 100 #d1100 " - " BREAK #d2101 #(REST " - " BREAK #d3101))
  121.     (NEGATE 100 "- " #d1100)
  122.     (+ 100 #d1100 #(REST " + " BREAK #d2101))
  123.     (* 120 #d1120 #(REST " " #d2121))
  124.     (/ 120 #d1120 "/" #d2121)
  125.     (OVER 120 ((-1 #d1040)
  126.            (0 #\-)
  127.            (1 #d2040)))
  128.     (^ 140 #d1141 ((-1 #d2100)))
  129.     (= 80 #d1080 " = " BREAK #d2080 #(REST " = " BREAK #d3080))
  130.     (DIFFERENTIAL 170 #d1170 "'")
  131.     (PARTIAL 130 " " ((-1 "%")
  132.               (0 #\-)
  133.               (1 "%" #d2140)) " " #d1140)
  134.     (SUCHTHAT 40 "{" #d1190 " | " #d2040 "}")
  135.     (DEFINE 200 #d1120 ": " ((0 #d2010)))
  136.     (RAPPLY 200 #d1200 ((1 #d2030 #(REST "," #d3010))))
  137.     (ABS 200 (#\|) #d1010 (#\|))
  138.     (BOX 200 ((-1 #\")
  139.           (0 (#\") #d1010 (#\"))
  140.           (1 #\")))
  141.     (FACTORIAL 160 #d1160 "!")
  142.     (INTEGRATE 120 ((-3 #(OPTIONAL #d4090))
  143.             (-2 "/ ")
  144.             (-1 "! ")
  145.             (0 "! ")
  146.             (1 "! ")
  147.             (2 "/ ")
  148.             (3 #(OPTIONAL #d3090)))
  149.            #d1090 "d" #d2120)
  150.     (LIMIT 90 ((0 "limit ")
  151.            (1 #d2090 "->" #d3090))
  152.        #d1090)
  153.     (SUM 90 ((-3 #(OPTIONAL #d4090))
  154.          (-2 "====")
  155.          (-1 "\\   ")
  156.          (0 " >  ")
  157.          (1 "/   ")
  158.          (2 "====")
  159.          (3 #(OPTIONAL #d2090 #(OPTIONAL" = " #d3090))))
  160.      #d1090)
  161.     (PROD 90 ((-3 " " #(OPTIONAL #d4090))
  162.           (-2 "/===/")
  163.           (-1 " ! ! ")
  164.           (0  " ! ! ")
  165.           (1  " ! ! ")
  166.           (2 #(OPTIONAL #d2090 #(OPTIONAL" = " #d3090))))
  167.       #d1090)
  168.     (AT 90 #d1090
  169.     ((-2 "!")
  170.      (-1 "!")
  171.      (0 "!")
  172.      (1 "!")
  173.      (2 "!"))
  174.     ((2 #d2010 #(REST ", " #d3010))))
  175.     (HELP 100 "help;")
  176.     (QED 100 "qed;")
  177.     (% 200 "%")
  178.     (NCMULT 110 #d1109 " . " #d2109)
  179.     (^^ 210 #d1211 "^^" #d2210)
  180.     ))
  181.  
  182. (define tps:c
  183.   '(
  184.     (TEMPLATE:DEFAULT 140 #d0140 "(" #d1010 #(REST ", " #d2010) ")")
  185.     (TEMPLATE:BUNCH 140 "{" #d0010 #(REST ", " #d1010) "}")
  186.     (TEMPLATE:PARENTHESIS 200 "(" #d1010 ")")
  187.     (= 80 #d1080 " == " BREAK #d2080 #(REST "==" BREAK #d3080))
  188.     (- 100 #d1100 " - " BREAK #d2101 #(REST " - " BREAK #d3101))
  189.     (+ 100 #d1100 #(REST " + " BREAK #d2101))
  190.     (* 120 #d1120 #(REST " * " #d2121))
  191.     (NEGATE 90 "- " #d1090)
  192.     (/ 120 #d1120 "/" #d2121)
  193.     (OVER 120 #d1120 "/" #d2121)
  194.     (^ 140 "pow(" #d1141 ", " #d2100 ")")
  195.     (RAPPLY 200 #d1200 "[" #d2030 #(REST "," #d3010) "]")
  196.     (BOX 200 ((-1 #\")
  197.           (0 (#\") #d1010 (#\"))
  198.           (1 #\")))
  199.     (DEFINE 200 #d1120 " = " #d2010)
  200.     (SET 20 "set " #d1120 " " #d2010)
  201.     (SHOW 20 "show " #d1120)
  202.     ))
  203.  
  204. (define tps:std
  205.   '(
  206.     (TEMPLATE:DEFAULT 140 #d0140 "(" #d1010 #(REST ", " #d2010) ")")
  207.     (TEMPLATE:BUNCH 140 "[" #d0010 #(REST ", " BREAK #d1010) "]")
  208.     (TEMPLATE:PARENTHESIS 200 "(" #d1010 ")")
  209.     (= 80 #d1080 " = " BREAK #d2080 #(REST " = " BREAK #d3080))
  210.     (- 100 #d1100 " - " BREAK #d2101 #(REST " - " BREAK #d3101))
  211.     (+ 100 #d1100 #(REST " + " BREAK #d2101))
  212.     (* 120 #d1120 #(REST " * " #d2121))
  213.     (NEGATE 90 "- " #d1090)
  214.     (/ 120 #d1120 "/" #d2121)
  215.     (OVER 120 #d1120 "/" #d2121)
  216.     (^ 140 #d1141 "^" #d2140)
  217.     (DIFFERENTIAL 170 #d1170 "'")
  218.     (SUCHTHAT 40 "{" #d1190 " | " #d2040 "}")
  219.     (RAPPLY 200 #d1200 "[" #d2030 #(REST "," #d3010) "]")
  220.     (BOX 200 ((-1 #\")
  221.           (0 (#\") #d1010 (#\"))
  222.           (1 #\")))
  223.     (DEFINE 200 #d1120 ": " #d2010)
  224.     (SET 20 "set " #d1120 " " #d2010)
  225.     (SHOW 20 "show " #d1120)
  226.     (FACTORIAL 160 #d1160 "!")
  227.     (HELP 100 "help;")
  228.     (QED 100 "qed;")
  229.     (% 200 "%")
  230.     (NCMULT 110 #d1109 " . " #d2109)
  231.     (^^ 210 #d1211 "^^" #d2210)
  232.     ))
  233. (define tps:tex
  234.   '(
  235.     (TEMPLATE:TOP 0 "$" #d1000 "$")
  236.     (TEMPLATE:DEFAULT 140 #d0140 "\\left(" #d1010
  237.               #(REST ", " #d2010) "\\right)")
  238.     (TEMPLATE:BUNCH 140 "\\left[" #d0010 #(REST ", " BREAK #d1010) "\\right]")
  239. ;;;    (TEMPLATE:MATRIX 140 "\\left({\matrix{" #d0010 #(REST "&" #d1010)
  240. ;;;             (#\\)(#\c)(#\r) "}}\\right)")
  241.     (TEMPLATE:PARENTHESIS 200 "\\left(" #d1010 "\\right)")
  242.     (= 80 #d1080 " = " BREAK #d2080 #(REST " = " BREAK #d3080))
  243.     (- 100 #d1100 " - " BREAK #d2101 #(REST " - " BREAK #d3101))
  244.     (+ 100 #d1100 #(REST " + " BREAK #d2101))
  245.     (* 120 #d1120 #(REST "\\," #d2121))
  246.     (NEGATE 90 "- " #d1100)
  247.     (/ 120 #d1120 "/{" BREAK #d2121 "}")
  248.     (OVER 120 "{" #d1040 "}\\over{" BREAK #d2041 "}")
  249.     (^ 140 #d1141 "^{" #d2100 "}")
  250.     (DIFFERENTIAL 170 "{" #d1170 "}'")
  251.     (SUCHTHAT 40 "\\left\\{ " #d1190 " | " BREAK #d2040 "\\right\\}")
  252.     (RAPPLY 200 #d1200 "\\left[" #d2030 #(REST "," BREAK #d3010) "\\right]")
  253.     (ABS 200 "\\left|" #d1010 "\\right|")
  254. ;;;    (BOX 200 ((-1 #\")
  255. ;;;          (0 (#\") #d1010 (#\"))
  256. ;;;          (1 #\")))
  257.     (DEFINE 200 #d1120 ": " #d2010)
  258.     (SET 20 "set " #d1120 " " #d2010)
  259.     (SHOW 20 "show " #d1120)
  260.     (FACTORIAL 160 #d1160 "!")
  261.     (HELP 100 "help;")
  262.     (QED 100 "qed;")
  263.     (% 200 "%")
  264.     ))
  265.  
  266. ;;;;The parse tables.
  267.  
  268. (set! *lex-defs* '())
  269. (set! *syn-defs* '())
  270. ;(set! *lex-defs* (make-hash-table 51))
  271. ;(set! *syn-defs* (make-hash-table 37))
  272.  
  273. ;;;Syntax definitions for STANDARD GRAMMAR
  274. (lex:def-class 70 '(#\^) #f)
  275. (lex:def-class 49 '(#\*) #f)
  276. (lex:def-class 50 '(#\/) #f)
  277. (lex:def-class 51 '(#\+ #\-) #f)
  278. (lex:def-class 20 '(#\|) #f)
  279. (lex:def-class 30 '(#\< #\> #\= #\: #\~) #f)
  280. (lex:def-class 40 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
  281.            (lambda (l) (string->number (list->string l))))
  282. (lex:def-class 41
  283.         '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
  284.           #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
  285.           #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
  286.           #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
  287.           #\@ #\% #\? #\_)
  288.         #f)
  289. (lex:def-class (lambda (chr) (or (eqv? #\" chr) (eof-object? chr)))
  290.         '(#\")
  291.         (lambda (l)
  292.           (lex:read-char) (string->symbol (list->string (cdr l)))))
  293. ;;; Ignore leading whitespace.  ^Z (26) needs to be ignored in order
  294. ;;; to avoid problem at end of MSDOS files.
  295. (define lex:whitespaces
  296.   (case (software-type)
  297.     ((MSDOS) (list (integer->char 26)))
  298.     (else '())))
  299. (do ((i (+ -1 (min 256 char-code-limit)) (+ -1 i))) ((negative? i))
  300.   (if (char-whitespace? (integer->char i))
  301.       (set! lex:whitespaces (cons (integer->char i) lex:whitespaces))))
  302.  
  303. (for-each (lambda (x) (lex:def-class 0 (list x) #f)) lex:whitespaces)
  304.  
  305. ;;; Delimiters and Separators
  306. (cgol:separator #\, 10)
  307. (cgol:delim #\; 0)
  308. (cgol:delim (integer->char 0) 0)        ;EOF
  309. ;(cgol:postfix #\$ (lambda (x) (write x)) 0)
  310.  
  311. ;;;prefix operators
  312. (cgol:prefix '+ #f 100)
  313. (cgol:prefix '- 'negate 100)
  314. (cgol:prefix "+/-" 'u+/- 100)
  315. (cgol:prefix "-/+" 'u-/+ 100)
  316. (cgol:prefix '(NOT ~) 'impl:not 70)
  317. (cgol:prefix ":" 'SetTemplate! 20)
  318.  
  319. ;;;postfix operators
  320. (cgol:postfix #\! 'factorial 160)
  321. (cgol:postfix #\' 'Differential 170)
  322.  
  323. ;;;infix operators
  324. ;(cgol:infix 'X 'crossproduct 111 110)
  325. (cgol:infix #\. 'ncmult 110 109)
  326. (cgol:infix '(^ **) '^ 140 139)
  327. (cgol:infix '^^ '^^ 210 210)
  328. (cgol:infix '(":=" ":") 'define 180 20)
  329. (cgol:infix '= '= 80 80)
  330. (cgol:infix '(~= <>) 'make-not-equal 80 80)
  331. (cgol:infix 'mod 'mod 70 70)
  332.  
  333. ;(cgol:infix "" '* 120 120)        ;null operator
  334.  
  335. ;;;nary operators
  336. (cgol:nary '* '* 120)
  337. (cgol:nary '+ '+ 100)
  338. (cgol:nary '- '- 100)
  339. (cgol:nary "+/-" 'b+/- 100)
  340. (cgol:nary "-/+" 'b-/+ 100)
  341. (cgol:nary '/ '/ 120)
  342. (cgol:nary '(AND #\&) '& 60)
  343. (cgol:nary 'OR 'or 50)
  344.  
  345. ;;;special operators
  346. (cgol:inmatchfix #\( #f #\) 200)
  347. (cgol:inmatchfix #\[ 'rapply #\] 200)
  348.  
  349. ;;;matchfix operators
  350. (cgol:matchfix #\( #f #\))
  351. (cgol:matchfix #\[ vector #\])
  352. (cgol:matchfix #\{ 'or #\})
  353. (cgol:matchfix #\\ 'lambda #\;)
  354.  
  355. (cgol:infix "|" 'suchthat 190 40)
  356. (cgol:prefix 'load 'load 50)
  357. (cgol:nofix '% '%)
  358. (cgol:nofix 'help 'help)
  359. (cgol:nofix '(QED bye exit) 'qed)
  360.  
  361. (cgol:commentfix
  362.  '/* (lambda ()
  363.        (define echoing (not (eq? (get-grammar 'null) *echo-grammar*)))
  364.        (do ((c (lex:read-char) (lex:read-char)))
  365.        ((or (eof-object? c)
  366.         (and (char=? #\* c)
  367.              (char=? #\/ (lex:peek-char))))
  368.         (lex:read-char))
  369.      (if echoing (display c)))))
  370.  
  371. ;;;rest operator reads expressions up to next delimiter.
  372. (cgol:rest 'set 'set 10)
  373. (cgol:rest 'show 'show 10)
  374.  
  375. (defgrammar 'standard
  376.   (make-grammar
  377.    'standard                ;name
  378.    (lambda (grm)            ;reader
  379.      (set! *lex-rules* (grammar-lex-tab grm))
  380.      (set! *syn-rules* (grammar-read-tab grm))
  381.      (cgol:top-parse #\, #\;))
  382.    *lex-defs*                ;lex-tab
  383.    *syn-defs*                ;read-tab
  384.    inprint                ;writer
  385.    tps:std))                ;write-tab
  386.  
  387. (defgrammar 'disp2d
  388.   (make-grammar
  389.    'disp2d                    ;name
  390.    (lambda (grm)            ;reader
  391.      (set! *lex-rules* (grammar-lex-tab grm))
  392.      (set! *syn-rules* (grammar-read-tab grm))
  393.      (cgol:top-parse #\, #\;))
  394.    *lex-defs*                ;lex-tab
  395.    *syn-defs*                ;read-tab
  396.    inprint                ;writer
  397.    tps:2d))                ;write-tab
  398.  
  399. (set! *input-grammar* (get-grammar 'standard))
  400. (set! *output-grammar* (get-grammar 'disp2d))
  401.  
  402. (set! *lex-defs* '())
  403. (set! *syn-defs* '())
  404. ;(set! *lex-defs* (make-hash-table 51))
  405. ;(set! *syn-defs* (make-hash-table 37))
  406.  
  407. ;;;Syntax definitions for TEX GRAMMAR
  408. (lex:def-class 40 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
  409.            (lambda (l) (string->number (list->string l))))
  410. (lex:def-class 41
  411.         '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
  412.           #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
  413.           #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
  414.           #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
  415.         #f)
  416. (let ((seen1 #f))
  417.   (lex:def-class
  418.    (lambda (chr)
  419.      (cond (seen1 (not (char-alphabetic? chr)))
  420.        ((not (char-alphabetic? chr))
  421.         (set! seen1 chr) #t)
  422.        (else (set! seen1 #t) #f)))
  423.    '(#\\)
  424.    (lambda (l)
  425.      (cond ((char? seen1) (lex:read-char)
  426.               (set! l (list #\\ seen1))))
  427.      (set! seen1 #f)
  428.      (list->string l))))
  429.  
  430. ;;; Ignore leading whitespace.
  431. (for-each (lambda (x) (lex:def-class 0 (list x) #f)) lex:whitespaces)
  432.  
  433. ;;; Ignore included text.  Better to do using CGOL:COMMENTFIX.
  434. ;(lex:def-class (lambda (chr) (or (eqv? #\$ chr) (eof-object? chr)))
  435. ;           '(#\$)
  436. ;           (lambda (l) (lex:read-char) (lex)))
  437. (cgol:commentfix
  438.  #\$ (lambda ()
  439.        (define echoing (not (eq? (get-grammar 'null) *echo-grammar*)))
  440.        (do ((c (lex:read-char) (lex:read-char)))
  441.        ((or (eof-object? c)
  442.         (char=? #\$ c)))
  443.      (if echoing (display c)))))
  444.  
  445. (cgol:separator #\, 10)
  446. (cgol:delim #\; 0)
  447. (cgol:delim (integer->char 0) 0)        ;EOF
  448. (cgol:prefix #\+ #f 100)
  449. (cgol:prefix #\- 'negate 100)
  450. (cgol:postfix #\! 'factorial 160)
  451. (cgol:postfix #\' 'Differential 170)
  452. (cgol:infix #\: 'define 180 20)
  453. (cgol:infix #\= '= 80 80)
  454. (cgol:nary '(#\* "\\,") '* 120)
  455. (cgol:nary #\+ '+ 100)
  456. (cgol:nary #\- '- 100)
  457. (cgol:nary #\/ '/ 120)
  458. (cgol:nary "\\over" '/ 120)
  459. (cgol:nary #\& vector 50)
  460. (cgol:nary "\\cr" vector 49)
  461.  
  462. (cgol:commentfix '("\\left" "\\right"
  463.                 "\\big" "\\bigm" "\\bigl" "\\bigr"
  464.                 "\\bigg" "\\biggm" "\\biggl" "\\biggr"
  465.                 "\\Big" "\\Bigm" "\\Bigl" "\\Bigr"
  466.                 "\\Bigg" "\\Biggm" "\\Biggl" "\\Biggr")
  467.          #f)
  468. (cgol:commentfix
  469.  #\% (lambda ()
  470.        (define echoing (not (eq? (get-grammar 'null) *echo-grammar*)))
  471.        (do ((c (lex:read-char) (lex:read-char)))
  472.        ((or (eof-object? c)
  473.         (char=? #\newline c)))
  474.      (if echoing (display c)))))
  475.  
  476. (cgol:inmatchfix #\( #f #\) 200)
  477. (cgol:matchfix #\( #f #\))
  478. (cgol:matchfix #\{ #f #\})
  479. (cgol:matchfix "\\lbrace" #f "\\rbrace")
  480. (cgol:inmatchfix #\[ 'rapply #\] 200)
  481. (cgol:inmatchfix "\\lbrack" 'rapply "\\rbrack" 200)
  482. (cgol:matchfix #\[ vector #\])
  483. (cgol:infix '(#\| "\\vert") 'suchthat 190 40)
  484. (cgol:infix #\^ '^ 140 139)
  485. (cgol:prefix "\\sqrt" (lambda (arg) `(^ ,arg (/ 1 2))) 100)
  486. (cgol:prefix2 "\\frac" '/ 100)
  487. ;(cgol:delim "\\of" 10)
  488. ;(cgol:prefix "\\root" (lambda (arg) `(^ ,arg (/ 1 2))) 100)
  489.  
  490. (cgol:prefix 'load 'load 50)
  491. (cgol:nofix '% '%)
  492. (cgol:nofix 'help 'help)
  493. (cgol:nofix '(QED bye exit) 'qed)
  494. (cgol:rest 'set 'set 10)
  495. (cgol:rest 'show 'show 10)
  496.  
  497. (defgrammar 'tex
  498.   (make-grammar
  499.    'tex                    ;name
  500.    (lambda (grm)            ;reader
  501.      (set! *lex-rules* (grammar-lex-tab grm))
  502.      (set! *syn-rules* (grammar-read-tab grm))
  503.      (cgol:top-parse #\, #\;))
  504.    *lex-defs*                ;lex-tab
  505.    *syn-defs*                ;read-tab
  506.    inprint                ;writer
  507.    tps:tex))                ;write-tab
  508.