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

Last change on this file since 38982 was 38982, checked in by Kon Lovett, 8 weeks ago

read-sexps port arg is after read-sexp args, group tests, add {,} list oper (like [,] vector)

File size: 5.0 KB
Line 
1;;;; slib-standard-grammar.scm  -*- Scheme -*-
2;;;; Kon Lovett, Apr '20
3
4;; JACAL: Symbolic Mathematics System.        -*-scheme-*-
5;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1995, 1997, 2007, 2009, 2010 Aubrey Jaffer.
6;;
7;; This program is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or (at
10;; your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;; General Public License for more details.
16;;
17;; You should have received a copy of the GNU General Public License
18;; along with this program; if not, write to the Free Software
19;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20
21;;;;The parse tables.
22;;; Definitions accumulate in top-level variable *SYN-DEFS*.
23
24(module slib-standard-grammar ()
25
26(import scheme)
27(import (chicken base))
28(import slib-prec-parse)
29(import slib-prec-grammar)
30
31;;;
32
33(include "slib-compat")
34(include "output-grammars")
35
36;;
37
38;;;Syntax definitions for STANDARD GRAMMAR
39
40(define (list2string dyn lst) (list->string lst))
41
42;;; Begin by Ignoring whitespace characters.
43(syntax-begin! (syntax-ignore-whitespace))
44
45;;; Character classes
46(prec:define-grammar (tok:char-group 49 #\* list2string))
47(prec:define-grammar (tok:char-group 50 #\/ list2string))
48(prec:define-grammar (tok:char-group 51 '(#\+ #\-) list2string))
49
50(prec:define-grammar (tok:char-group 30 '(#\< #\> #\= #\: #\~ #\! #\%) list2string))
51
52(prec:define-grammar (tok:char-group 39 #\| list2string))
53(prec:define-grammar (tok:char-group 40 #\& list2string))
54(prec:define-grammar (tok:char-group 41 #\^ list2string))
55
56;numbers, but not ratios!
57(define tok:number-chars (string-append "." tok:decimal-digits))
58(prec:define-grammar (tok:char-group 40
59                      tok:number-chars
60                      (lambda (dyn l)
61                        (if (equal? '(#\.) l)
62                            #\.
63                            (string->number (list->string l))))))
64
65(define tok:ident-chars (string-append tok:upper-case tok:lower-case "@%?_"))
66(prec:define-grammar (tok:char-group 41 tok:ident-chars list2string))
67
68(prec:define-grammar (tok:char-group
69                      (lambda (chr) (or (eqv? #\" chr) (eof-object? chr)))
70                      #\"
71                      (lambda (dyn l)
72                        (tok:read-char dyn)
73                        (list->string (cdr l)))))
74
75;;; Delimiters and Separators
76;;; Delimiters used to be defined here, but now are defined
77;;; dynamically by parse functions.
78;(prec:define-grammar (prec:delim #;#\[ #\])) ;4 editor
79;(prec:define-grammar (prec:delim #;#\{ #\})) ;4 editor
80
81;;;prefix operators
82(prec:define-grammar (prec:prefix '+ #f 150))
83(prec:define-grammar (prec:prefix '- '- 150))
84
85(prec:define-grammar (prec:prefix '~ 'bitwise-not 120))
86
87(prec:define-grammar (prec:prefix '! 'not 70))
88
89;;;nary operators
90(prec:define-grammar (prec:nary '* '* 120))
91(prec:define-grammar (prec:nary '/ '/ 120))
92(prec:define-grammar (prec:nary '+ '+ 100))
93(prec:define-grammar (prec:nary '- '- 100))
94
95(prec:define-grammar (prec:nary '&& 'and 60))
96(prec:define-grammar (prec:nary "||" 'or 50))
97;(prec:define-grammar (prec:nary "^^" 'xor 40))
98
99(prec:define-grammar (prec:nary '& 'bitwise-and 110))
100(prec:define-grammar (prec:nary "|" 'bitwise-ior 100))
101(prec:define-grammar (prec:nary '^ 'bitwise-xor 90))
102
103;;;infix operators
104(prec:define-grammar (prec:infix '** 'expt 140 139))
105(prec:define-grammar (prec:infix '% 'modulo 140 139))
106
107(prec:define-grammar (prec:infix '= '= 80 80))
108(prec:define-grammar (prec:infix '< '< 80 80))
109(prec:define-grammar (prec:infix '> '> 80 80))
110(prec:define-grammar (prec:infix '<= '<= 80 80))
111(prec:define-grammar (prec:infix '>= '>= 80 80))
112
113(prec:define-grammar (prec:infix ':= 'define 180 20))
114
115;;;postfix operators
116
117;;;matchfix operators
118(prec:define-grammar (prec:matchfix #\( identity #f #\))) ;MUST NOT be procedure
119
120(prec:define-grammar (prec:matchfix #\{ 'list #\, #\}))
121(prec:define-grammar (prec:matchfix #\[ 'vector #\, #\]))
122
123(prec:define-grammar (prec:matchfix #\\ 'lambda #\, #\;))
124
125;;;special operators
126(prec:define-grammar (prec:inmatchfix #\( list #\, #\) 200)) ;MUST be procedure
127
128;;;rest operator reads expressions up to next delimiter.
129
130;;;miscellany
131
132(prec:define-grammar (prec:commentfix
133                      "/*"
134                      (lambda (str)
135                        (and str
136                             (not (eq? (get-grammar 'null) (active-echo-grammar)))
137                             (display str)))
138                      "*/"))
139
140(defgrammar 'standard
141  (make-grammar
142    'standard                             ;name
143    (make-delimited-parse-grammar-reader #\;) ;reader
144    (syntax-current)                        ;read-tab
145    print-using-grammar                               ;writer
146    tps:std))                                                 ;write-tab
147
148(syntax-end!)
149
150) ;slib-standard-grammar
Note: See TracBrowser for help on using the repository browser.