Import Nyacc 0.72.0.
[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
22             cpp-mach
23             dev-parse-cpp-expr dev-eval-cpp-expr
24             gen-cpp-files)
25   #:use-module (nyacc lalr)
26   #:use-module (nyacc parse)
27   #:use-module (nyacc lex)
28   #:use-module (nyacc lang util)
29   #:use-module ((srfi srfi-43) #:select (vector-map))
30   #:use-module (rnrs arithmetic bitwise)
31   )
32
33 (define cpp-spec
34   (lalr-spec
35    (notice lang-crn-lic)
36    (expect 0)
37    (start conditional-expression)
38    (grammar
39     (conditional-expression
40      (logical-or-expression)
41      (logical-or-expression "?" logical-or-expression ":" conditional-expression
42                             ($$ `(cond-expr ,$1 ,$3 ,$5))))
43     (logical-or-expression
44      (logical-and-expression)
45      (logical-or-expression "||" logical-and-expression ($$ `(or ,$1 ,$3))))
46     (logical-and-expression
47      (bitwise-or-expression)
48      (logical-and-expression "&&" bitwise-or-expression ($$ `(and ,$1 ,$3))))
49     (bitwise-or-expression
50      (bitwise-xor-expression)
51      (bitwise-or-expression "|" bitwise-xor-expression
52                             ($$ `(bitwise-or ,$1 ,$3))))
53     (bitwise-xor-expression
54      (bitwise-and-expression)
55      (bitwise-xor-expression "^" bitwise-and-expression
56                              ($$ `(bitwise-xor ,$1 ,$3))))
57     (bitwise-and-expression
58      (equality-expression)
59      (bitwise-and-expression "&" equality-expression
60                              ($$ `(bitwise-and ,$1 ,$3))))
61     (equality-expression
62      (relational-expression)
63      (equality-expression "==" relational-expression ($$ `(equal ,$1 ,$3)))
64      (equality-expression "!=" relational-expression ($$ `(noteq ,$1 ,$3))))
65     (relational-expression
66      (shift-expression)
67      (relational-expression "<" shift-expression ($$ `(lt ,$1 ,$3)))
68      (relational-expression "<=" shift-expression ($$ `(le ,$1 ,$3)))
69      (relational-expression ">" shift-expression ($$ `(gt ,$1 ,$3)))
70      (relational-expression ">=" shift-expression ($$ `(ge ,$1 ,$3))))
71     (shift-expression
72      (additive-expression)
73      (shift-expression "<<" additive-expression ($$ `(lshift ,$1 ,$3)))
74      (shift-expression ">>" additive-expression ($$ `(rshift ,$1 ,$3))))
75     (additive-expression
76      (multiplicative-expression)
77      (additive-expression "+" multiplicative-expression ($$ `(add ,$1 ,$3)))
78      (additive-expression "-" multiplicative-expression ($$ `(sub ,$1 ,$3))))
79     (multiplicative-expression
80      (unary-expression)
81      (multiplicative-expression "*" unary-expression ($$ `(mul ,$1 ,$3)))
82      (multiplicative-expression "/" unary-expression ($$ `(div ,$1 ,$3)))
83      (multiplicative-expression "%" unary-expression ($$ `(mod ,$1 ,$3))))
84     (unary-expression
85      (postfix-expression)
86      ("-" unary-expression ($$ `(neg ,$2)))
87      ("+" unary-expression ($$ `(pos ,$2)))
88      ("!" unary-expression ($$ `(not ,$2)))
89      ("~" unary-expression ($$ `(bitwise-not ,$2)))
90      ("++" unary-expression ($$ `(pre-inc ,$2)))
91      ("--" unary-expression ($$ `(pre-dec ,$2))))
92     (postfix-expression
93      (primary-expression)
94      (postfix-expression "++" ($$ `(post-inc ,$1)))
95      (postfix-expression "--" ($$ `(post-dec ,$1))))
96     (primary-expression
97      ;;($ident ($$ `(ident ,$1)))
98      ($fixed ($$ `(fixed ,$1))) ; integer-constant
99      ($chlit ($$ `(char ,$1)))          ; char-constant
100      ("defined" "(" $ident ")" ($$ `(defined ,$3)))
101      ("(" expression-list ")" ($$ $2)))
102     (expression-list
103      (conditional-expression)
104      (expression-list "," conditional-expression ($$ $3)))
105     )))
106
107 (define cpp-mach
108   (compact-machine
109    (hashify-machine
110     (make-lalr-machine cpp-spec))))
111
112 (define mtab (assq-ref cpp-mach 'mtab))
113 (define raw-parser (make-lalr-parser cpp-mach))
114
115 (include-from-path "nyacc/lang/c99/cppbody.scm")
116
117 (define dev-parse-cpp-expr parse-cpp-expr)
118 (define dev-eval-cpp-expr eval-cpp-expr)
119
120 ;;; =====================================
121
122 ;; @item gen-cpp-files [dir] => #t
123 ;; Update or generate the files @quot{cppact.scm} and @quot{cpptab.scm}.
124 ;; If there are no changes to existing files, no update occurs.
125 (define (gen-cpp-files . rest)
126   (define (lang-dir path)
127     (if (pair? rest) (string-append (car rest) "/" path) path))
128   (define (xtra-dir path)
129     (lang-dir (string-append "mach.d/" path)))
130
131   (write-lalr-actions cpp-mach (xtra-dir "cppact.scm.new"))
132   (write-lalr-tables cpp-mach (xtra-dir "cpptab.scm.new"))
133   (let ((a (move-if-changed (xtra-dir "cppact.scm.new")
134                             (xtra-dir "cppact.scm")))
135         (b (move-if-changed (xtra-dir "cpptab.scm.new")
136                             (xtra-dir "cpptab.scm"))))
137     (when (or a b) 
138       (system (string-append "touch " (lang-dir "cpp.scm")))
139       #;(compile-file (lang-dir "cpp.scm"))
140       )))
141
142 ;; --- last line ---