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

Last change on this file since 39037 was 39037, checked in by Kon Lovett, 6 weeks ago

add shift ops, % -> mod, add rem

File size: 5.3 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 50))
98
99(prec:define-grammar (prec:nary '& 'bitwise-and 90))
100(prec:define-grammar (prec:nary "|" 'bitwise-ior 90))
101(prec:define-grammar (prec:nary '^ 'bitwise-xor 90))
102
103;;;infix operators
104(prec:define-grammar (prec:infix '** 'expt 140 139))
105
106(prec:define-grammar (prec:infix 'mod 'modulo 140 139))
107(prec:define-grammar (prec:infix 'rem 'remainder 140 139))
108
109(prec:define-grammar (prec:infix '<< 'arithmetic-shift-left 140 139))
110(prec:define-grammar (prec:infix '>> 'arithmetic-shift-left 139 140))
111(prec:define-grammar (prec:infix '<<< 'logical-shift-left 140 139))
112(prec:define-grammar (prec:infix '>>> 'logical-shift-left 139 140))
113
114(prec:define-grammar (prec:infix '= '= 80 80))
115(prec:define-grammar (prec:infix '< '< 80 80))
116(prec:define-grammar (prec:infix '> '> 80 80))
117(prec:define-grammar (prec:infix '<= '<= 80 80))
118(prec:define-grammar (prec:infix '>= '>= 80 80))
119
120(prec:define-grammar (prec:infix ':= 'define 180 20))
121
122;;;postfix operators
123
124;;;matchfix operators
125(prec:define-grammar (prec:matchfix #\( identity #f #\))) ;MUST NOT be procedure
126
127(prec:define-grammar (prec:matchfix #\{ 'list #\, #\}))
128(prec:define-grammar (prec:matchfix #\[ 'vector #\, #\]))
129
130(prec:define-grammar (prec:matchfix #\\ 'lambda #\, #\;))
131
132;;;special operators
133(prec:define-grammar (prec:inmatchfix #\( list #\, #\) 200)) ;MUST be procedure
134
135;;;rest operator reads expressions up to next delimiter.
136
137;;;miscellany
138
139(prec:define-grammar (prec:commentfix
140                      "/*"
141                      (lambda (str)
142                        (and str
143                             (not (eq? (get-grammar 'null) (active-echo-grammar)))
144                             (display str)))
145                      "*/"))
146
147(defgrammar 'standard
148  (make-grammar
149    'standard                             ;name
150    (make-delimited-parse-grammar-reader #\;) ;reader
151    (syntax-current)                        ;read-tab
152    print-using-grammar                               ;writer
153    tps:std))                                                 ;write-tab
154
155(syntax-end!)
156
157) ;slib-standard-grammar
Note: See TracBrowser for help on using the repository browser.