aefaf2721f7684f64326115838e88b1db82f8b25
[mes.git] / module / nyacc / lang / c99 / cpp.scm
1 ;;; lang/c/cpp.scm
2 ;;;
3 ;;; Copyright (C) 2015-2017 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.  This is not complete.
19
20 (define-module (nyacc lang c99 cpp)
21   #:export (parse-cpp-stmt
22             read-cpp-stmt
23             parse-cpp-expr
24             eval-cpp-expr
25             cpp-expand-text
26             expand-cpp-mref
27             )
28   #:use-module (nyacc parse)
29   #:use-module (nyacc lex)
30   #:use-module (nyacc lang util)
31   #:use-module (rnrs arithmetic bitwise)
32   )
33
34 (cond-expand
35  (guile-2)
36  (guile
37   (use-modules (ice-9 syncase)))
38  (mes))
39
40 #|
41   #define  #undef  #include  #if  #ifdef  #ifndef  #else  #endif  #elif
42   #line  defined  #-operator  ##-operator  #pragma  #error
43 todo:
44   pragma
45   #-op ##-op
46   provide dict of #defines
47   provide util to expand defines
48 |#
49
50 ;;.@deffn skip-ws ch
51 ;; Helper for 
52 (define (skip-ws ch)
53   (if (eof-object? ch) ch
54       (if (char-set-contains? c:ws ch)
55           (skip-ws (read-char))
56           ch)))
57
58 ;; @deffn read-ellipsis ch
59 ;; read ellipsis
60 (define (read-ellipsis ch)
61   (cond
62    ((eof-object? ch) #f)
63    ((char=? ch #\.) (read-char) (read-char) "...")
64    (else #f)))
65
66 ;; @deffn cpp-define => #f|???
67 (define (cpp-define)
68   ;; The (weak?) parse architecture is "unread la argument if no match"
69   (letrec
70       ((p-cppd ;; parse all
71         (lambda ()
72           (let* ((iden (read-c-ident (skip-ws (read-char))))
73                  ;;(args (or (p-args (skip-ws (read-char))) '()))
74                  ;; "define ABC(ARG)" not the same as "define ABC (ARG)"
75                  (args (or (p-args (read-char)) '()))
76                  (rest (or (p-rest (skip-ws (read-char))) " ")))
77             (if (pair? args)
78                 `(define (name ,iden) ,(cons 'args args) (repl ,rest))
79                 `(define (name ,iden) (repl ,rest))))))
80        (p-args ;; parse args
81         (lambda (la) ;; unread la if no match :(
82           (if (eq? la #\()
83               (let iter ((args '()) (la (skip-ws (read-char))))
84                 (cond
85                  ((eq? la #\)) (reverse args))
86                  ((read-c-ident la) =>
87                   (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
88                  ((read-ellipsis la) =>
89                   (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
90                  ((eq? la #\,)
91                   (iter args (skip-ws (read-char))))))
92               (begin (if (char? la) (unread-char la)) #f)))) ;; CLEANUP
93        (p-rest ;; parse rest
94         (lambda (la)
95           (cond ((char? la) (unread-char la) (drain-input (current-input-port)))
96                 (else #f)))))
97     (p-cppd)))
98
99 ;; @deffn cpp-include
100 ;; Parse CPP include statement.
101 (define (cpp-include)
102   (let* ((beg-ch (skip-ws (read-char)))
103          (end-ch (if (eq? beg-ch #\<) #\> #\"))
104          (path (let iter ((cl (list beg-ch)) (ch (read-char)))
105                  (if (eq? ch end-ch) (list->string (reverse (cons ch cl)))
106                      (iter (cons ch cl) (read-char))))))
107     `(include ,path)))
108
109 ;; @deffn read-cpp-stmt line defs => (stmt-type text)
110 ;; Parse a line from a CPP statement and return a parse tree.
111 ;; @example
112 ;; (parse-cpp-stmt "define X 123") => (define "X" "123")
113 ;; (parse-cpp-stmt "if defined(A) && defined(B) && defined(C)"
114 ;; => (if "defined(A) && defined(B) && defined(C)")
115 ;; @end example
116 ;; To evaluate the @code{if} statements use @code{parse-cpp-expr} and
117 ;; @code{eval-cpp-expr}.
118 (define (read-cpp-stmt line)
119   (define (rd-ident) (read-c-ident (skip-ws (read-char))))
120   (define (rd-num) (and=> (read-c-num (skip-ws (read-char))) cdr))
121   (define (rd-rest) (let ((ch (skip-ws (read-char))))
122                       (if (not (eof-object? ch)) (unread-char ch))
123                       (drain-input (current-input-port))))
124   (with-input-from-string line
125     (lambda ()
126       (let ((cmd (string->symbol (read-c-ident (skip-ws (read-char))))))
127          (case cmd
128            ((include) (cpp-include))
129            ((define) (cpp-define))
130            ((undef) `(undef ,(rd-ident)))
131            ((ifdef)
132             `(if ,(string-append "defined(" (rd-ident) ")" (rd-rest))))
133            ((ifndef)
134             `(if ,(string-append "!defined(" (rd-ident) ")" (rd-rest))))
135            ((if elif else endif line error pragma) (list cmd (rd-rest)))
136            (else '(unknown "")))))))
137     
138 (include-from-path "nyacc/lang/c99/mach.d/cpptab.scm")
139 (include-from-path "nyacc/lang/c99/mach.d/cppact.scm")
140
141 (define raw-parser
142   (make-lalr-parser
143    (list (cons 'len-v len-v) (cons 'pat-v pat-v) (cons 'rto-v rto-v)
144          (cons 'mtab mtab) (cons 'act-v act-v))))
145
146 ;; The included file "cppbody.scm" provides:
147 ;; gen-cpp-lexer
148 ;; parse-cpp-expr
149 ;; eval-cpp-expr
150 (include-from-path "nyacc/lang/c99/cppbody.scm")
151  
152 ;; --- last line ---