nyacc: fixed C99 CPP to deal with numbers correctly
[mes.git] / module / nyacc / lang / c99 / cppmach.scm
1 ;;; lang/c99/cppmach.scm
2 ;;;
3 ;;; Copyright (C) 2015,2016 Matthew R. Wette
4 ;;;
5 ;;; This program is free software: you can redistribute it and/or modify
6 ;;; it under the terms of the GNU General Public License as published by 
7 ;;; the Free Software Foundation, either version 3 of the License, or 
8 ;;; (at your option) any later version.
9 ;;;
10 ;;; This program is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;;; GNU General Public License for more details.
14 ;;;
15 ;;; You should have received a copy of the GNU General Public License
16 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18 ;; C preprocessor expression parser generator
19
20 (define-module (nyacc lang c99 cppmach)
21   #:export (cpp-spec cpp-mach gen-cpp-files)
22   #:use-module (nyacc lalr)
23   #:use-module (nyacc parse)
24   #:use-module (nyacc lex)
25   #:use-module (nyacc lang util)
26   #:use-module ((srfi srfi-43) #:select (vector-map))
27   #:use-module (rnrs arithmetic bitwise)
28   )
29
30 (define cpp-spec
31   (lalr-spec
32    (notice (string-append "Copyright (C) 2016,2017 Matthew R. Wette"
33                           lang-crn-lic))
34    (expect 0)
35    (start conditional-expression)
36    (grammar
37     (conditional-expression
38      (logical-or-expression)
39      (logical-or-expression "?" logical-or-expression ":" conditional-expression
40                             ($$ `(cond-expr ,$1 ,$3 ,$5))))
41     (logical-or-expression
42      (logical-and-expression)
43      (logical-or-expression "||" logical-and-expression ($$ `(or ,$1 ,$3))))
44     (logical-and-expression
45      (bitwise-or-expression)
46      (logical-and-expression "&&" bitwise-or-expression ($$ `(and ,$1 ,$3))))
47     (bitwise-or-expression
48      (bitwise-xor-expression)
49      (bitwise-or-expression "|" bitwise-xor-expression
50                             ($$ `(bitwise-or ,$1 ,$3))))
51     (bitwise-xor-expression
52      (bitwise-and-expression)
53      (bitwise-xor-expression "^" bitwise-and-expression
54                              ($$ `(bitwise-xor ,$1 ,$3))))
55     (bitwise-and-expression
56      (equality-expression)
57      (bitwise-and-expression "&" equality-expression
58                              ($$ `(bitwise-and ,$1 ,$3))))
59     (equality-expression
60      (relational-expression)
61      (equality-expression "==" relational-expression ($$ `(equal ,$1 ,$3)))
62      (equality-expression "!=" relational-expression ($$ `(noteq ,$1 ,$3))))
63     (relational-expression
64      (shift-expression)
65      (relational-expression "<" shift-expression ($$ `(lt ,$1 ,$3)))
66      (relational-expression "<=" shift-expression ($$ `(le ,$1 ,$3)))
67      (relational-expression ">" shift-expression ($$ `(gt ,$1 ,$3)))
68      (relational-expression ">=" shift-expression ($$ `(ge ,$1 ,$3))))
69     (shift-expression
70      (additive-expression)
71      (shift-expression "<<" additive-expression ($$ `(lshift ,$1 ,$3)))
72      (shift-expression ">>" additive-expression ($$ `(rshift ,$1 ,$3))))
73     (additive-expression
74      (multiplicative-expression)
75      (additive-expression "+" multiplicative-expression ($$ `(add ,$1 ,$3)))
76      (additive-expression "-" multiplicative-expression ($$ `(sub ,$1 ,$3))))
77     (multiplicative-expression
78      (unary-expression)
79      (multiplicative-expression "*" unary-expression ($$ `(mul ,$1 ,$3)))
80      (multiplicative-expression "/" unary-expression ($$ `(div ,$1 ,$3)))
81      (multiplicative-expression "%" unary-expression ($$ `(mod ,$1 ,$3))))
82     (unary-expression
83      (postfix-expression)
84      ("-" unary-expression ($$ `(neg ,$2)))
85      ("+" unary-expression ($$ `(pos ,$2)))
86      ("!" unary-expression ($$ `(not ,$2)))
87      ("~" unary-expression ($$ `(bitwise-not ,$2)))
88      ("++" unary-expression ($$ `(pre-inc ,$2)))
89      ("--" unary-expression ($$ `(pre-dec ,$2))))
90     (postfix-expression
91      (primary-expression)
92      (postfix-expression "++" ($$ `(post-inc ,$1)))
93      (postfix-expression "--" ($$ `(post-dec ,$1))))
94     (primary-expression
95      ($ident ($$ `(ident ,$1)))
96      ($fixed ($$ `(fixed ,$1))) ; integer-constant
97      ($chlit ($$ `(char ,$1)))  ; char-constant
98      ("defined" "(" $ident ")" ($$ `(defined ,$3)))
99      ("defined" $ident ($$ `(defined ,$2)))
100      ("(" expression-list ")" ($$ $2)))
101     (expression-list
102      (conditional-expression)
103      (expression-list "," conditional-expression ($$ $3)))
104     )))
105
106 (define cpp-mach
107   (compact-machine
108    (hashify-machine
109     (make-lalr-machine cpp-spec))))
110
111 ;;; =====================================
112
113 ;; @item gen-cpp-files [dir] => #t
114 ;; Update or generate the files @quot{cppact.scm} and @quot{cpptab.scm}.
115 ;; If there are no changes to existing files, no update occurs.
116 (define (gen-cpp-files . rest)
117   (define (lang-dir path)
118     (if (pair? rest) (string-append (car rest) "/" path) path))
119   (define (xtra-dir path)
120     (lang-dir (string-append "mach.d/" path)))
121
122   (write-lalr-actions cpp-mach (xtra-dir "cppact.scm.new"))
123   (write-lalr-tables cpp-mach (xtra-dir "cpptab.scm.new"))
124   (let ((a (move-if-changed (xtra-dir "cppact.scm.new")
125                             (xtra-dir "cppact.scm")))
126         (b (move-if-changed (xtra-dir "cpptab.scm.new")
127                             (xtra-dir "cpptab.scm"))))
128     (when (or a b) 
129       (system (string-append "touch " (lang-dir "cpp.scm"))))))
130
131 ;; --- last line ---