nyacc: misc updates; see ChangeLog
authorMatt Wette <matt.wette@gmail.com>
Mon, 26 Dec 2016 03:31:09 +0000 (19:31 -0800)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 26 Dec 2016 03:31:09 +0000 (19:31 -0800)
module/nyacc/ChangeLog
module/nyacc/lang/c99/body.scm
module/nyacc/lang/c99/cpp.scm
module/nyacc/lang/c99/mach.d/c99act.scm
module/nyacc/lang/c99/mach.d/c99xact.scm
module/nyacc/lang/c99/mach.scm
module/nyacc/lang/c99/pprint.scm
module/nyacc/lang/c99/util2.scm
module/nyacc/lang/util.scm

index 482df167c2daa6627db9a35f6b770f03881a7950..e92c836046f69de680c9f2d4446e9c553963aa44 100644 (file)
@@ -1,3 +1,11 @@
+2016-11-25  Matt Wette  <mwette@nautilus>
+
+       * added support for ellipsis to lang/c99/cpp.scm
+
+2016-11-24  Matt Wette  <mwette@nautilus>
+
+       * added (ellipsis) to lang/c99/pprint.scm
+
 2016-04-09  Matt Wette  <mwette@nautilus>
 
        * bison.scm: new file providing make-lalr-machin/bison.  It is
index c3571e38d63539472be0c31e2607350427443bc4..b3e78437176aa1ca1ba40ef6554172998f5c4202 100644 (file)
   )
 
 (define std-dict
-  '(("time.h" "time_t" "clock_t" "size_t")
-    ("stdio.h" "FILE" "size_t")
-    ("string.h" "size_t")
-    ("stddef.h" "ptrdiff_t" "size_t" "wchar_t")
+  '(
+    ("alloca.h")
+    ("complex.h" "complex" "imaginary")
+    ("ctype.h")
+    ("fenv.h" "fenv_t" "fexcept_t")
+    ("float.h" "float_t")
     ("inttypes.h"
      "int8_t" "uint8_t" "int16_t" "uint16_t" "int32_t" "uint32_t"
      "int64_t" "uint64_t" "uintptr_t" "intptr_t" "intmax_t" "uintmax_t"
      "int_least8_t" "uint_least8_t" "int_least16_t" "uint_least16_t"
      "int_least32_t" "uint_least32_t" "int_least64_t" "uint_least64_t"
      "imaxdiv_t")
+    ("limits.h")
+    ("math.h")
+    ("regex.h" "regex_t" "regmatch_t")
+    ("setjmp.h" "jmp_buf")
+    ("signal.h" "sig_atomic_t")
+    ("string.h" "size_t")
+    ("stdarg.h" "va_list")
+    ("stddef.h" "ptrdiff_t" "size_t" "wchar_t")
     ("stdint.h"
      "int8_t" "uint8_t" "int16_t" "uint16_t" "int32_t" "uint32_t"
      "int64_t" "uint64_t" "uintptr_t" "intptr_t" "intmax_t" "uintmax_t"
      "int_least8_t" "uint_least8_t" "int_least16_t" "uint_least16_t"
      "int_least32_t" "uint_least32_t" "int_least64_t" "uint_least64_t")
+    ("stdio.h" "FILE" "size_t")
     ("stdlib.h" "div_t" "ldiv_t" "lldiv_t" "wchar_t")
-    ("stdarg.h" "va_list")
-    ;;("unistd.h" "div_t" "ldiv_t")
-    ("signal.h" "sig_atomic_t")
-    ("setjmp.h" "jmp_buf")
-    ("float.h" "float_t")
-    ("fenv.h" "fenv_t" "fexcept_t")
-    ("complex.h" "complex" "imaginary")
+    ("time.h" "time_t" "clock_t" "size_t")
+    ("unistd.h" "size_t" "ssize_t" "div_t" "ldiv_t")
     ("wchar.h" "wchar_t" "wint_t" "mbstate_t" "size_t")
     ("wctype.h" "wctrans_t" "wctype_t" "wint_t")
-    ("math.h")
     ))
 
 (define (make-cpi debug defines incdirs tn-dict)
index fda8ecf2e32ce8bb65a5de901cfdb2debddcbe50..0555d7b232e9e5cd521392eb9e4e3a1bf300f92a 100644 (file)
@@ -57,6 +57,15 @@ todo:
       (if (char-set-contains? c:ws ch)
          (skip-ws (read-char))
          ch)))
+
+;; @deffn read-ellipsis ch
+;; read ellipsis
+(define (read-ellipsis ch)
+  (cond
+   ((eof-object? ch) #f)
+   ((char=? ch #\.) (read-char) (read-char) "...")
+   (else #f)))
+
 ;; @deffn cpp-define => #f|???
 (define (cpp-define)
   ;; The (weak?) parse architecture is "unread la argument if no match"
@@ -79,6 +88,8 @@ todo:
                 ((eq? la #\)) (reverse args))
                 ((read-c-ident la) =>
                  (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
+                ((read-ellipsis la) =>
+                 (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
                 ((eq? la #\,)
                  (iter args (skip-ws (read-char))))))
              (begin (if (char? la) (unread-char la)) #f)))) ;; CLEANUP
index 78b845ed374cc95facbfaaeb1995e57416081bc8..4894afbdce9508cfeac9811d28d9e930ab47882b 100644 (file)
    (lambda ($1 . $rest) $1)
    ;; conditional-expression => logical-or-expression "?" expression ":" co...
    (lambda ($5 $4 $3 $2 $1 . $rest)
-     `(cond-expr ,$1 ,$2 ,$3))
+     `(cond-expr ,$1 ,$3 ,$5))
    ;; assignment-expression => conditional-expression
    (lambda ($1 . $rest) $1)
    ;; assignment-expression => unary-expression assignment-operator assignm...
    (lambda ($1 . $rest) $1)
    ;; parameter-type-list => parameter-list "," "..."
    (lambda ($3 $2 $1 . $rest)
-     (tl-append $1 '(ellipis)))
+     (tl-append $1 '(ellipsis)))
    ;; parameter-list => parameter-declaration
    (lambda ($1 . $rest) (make-tl 'param-list $1))
    ;; parameter-list => parameter-list "," parameter-declaration
index 923858bad637d220626f94e7b30e725a0d479456..7959475446046e3863e635541d02e861f9994ac5 100644 (file)
    (lambda ($1 . $rest) $1)
    ;; conditional-expression => logical-or-expression "?" expression ":" co...
    (lambda ($5 $4 $3 $2 $1 . $rest)
-     `(cond-expr ,$1 ,$2 ,$3))
+     `(cond-expr ,$1 ,$3 ,$5))
    ;; assignment-expression => conditional-expression
    (lambda ($1 . $rest) $1)
    ;; assignment-expression => unary-expression assignment-operator assignm...
    (lambda ($1 . $rest) $1)
    ;; parameter-type-list => parameter-list "," "..."
    (lambda ($3 $2 $1 . $rest)
-     (tl-append $1 '(ellipis)))
+     (tl-append $1 '(ellipsis)))
    ;; parameter-list => parameter-declaration
    (lambda ($1 . $rest) (make-tl 'param-list $1))
    ;; parameter-list => parameter-list "," parameter-declaration
index e76be7da133858ecc18c9ab5c373143fc1755d3d..f143687f42fa08f7598a00480da1dcd19eef8893 100644 (file)
     (conditional-expression
      (logical-or-expression)
      (logical-or-expression "?" expression ":" conditional-expression
-                           ($$ `(cond-expr ,$1 ,$2 ,$3)))
+                           ($$ `(cond-expr ,$1 ,$3 ,$5)))
      )
 
     (assignment-expression             ; S 6.5.16
 
     (parameter-type-list
      (parameter-list ($$ $1))
-     (parameter-list "," "..." ($$ (tl-append $1 '(ellipis))))
+     (parameter-list "," "..." ($$ (tl-append $1 '(ellipsis))))
      )
 
     (parameter-list
index 44639d16373e80972431f1c4fa7420f844391913..f2f6a4f371e96261c4e06e149e650a60dbad4980 100644 (file)
@@ -94,7 +94,8 @@
       ((pragma ,text) (sf "#pragma ~A\n" text))
       (,otherwise
        (simple-format #t "\n*** pprint/cpp-ppx: NO MATCH: ~S\n" tree))
-      ))
+      )
+    (fmtr 'nlin))
 
   (define (unary/l op rep rval)
     (sf rep)
        (ppx rval)))
   
   (define (unary/r op rep lval)
-    (sf rep)
     (if (protect-expr? 'lt op lval)
        (ppx/p lval)
-       (ppx lval)))
+       (ppx lval))
+    (sf rep))
   
   (define (binary op rep lval rval)
     (if (protect-expr? 'lt op lval)
        (case (sx-tag iexpr)
          ((initzer-list)
           (sf "{")
-          (sf "initzer-list")  ; TODO
-          (sf " }"))
+          (for-each
+           (lambda (expr) (ppx (sx-ref expr 1)) (sf ", "))
+           (sx-tail iexpr 1))
+          (sf "}"))
          (else
           (ppx iexpr))))))
 
          (if (pair? (cdr pair)) (sf " ")))
        value-l))
 
-      ((comment ,text) (sf "/*~A */\n" text))
+      ((comment ,text) (sf "/*~A*/\n" text))
 
       ((scope ,expr) (sf "(") (ppx expr) (sf ")"))
       
       ((div ,lval ,rval) (binary 'div "/" lval rval))
       ((mod ,lval ,rval) (binary 'mod "%" lval rval))
 
+      ((lshift ,lval ,rval) (binary 'lshift "<<" lval rval))
+      ((rshift ,lval ,rval) (binary 'lshift "<<" lval rval))
+
       ((lt ,lval ,rval) (binary 'lt " < " lval rval))
       ((gt ,lval ,rval) (binary 'gt " > " lval rval))
 
       ((bitwise-or ,lval ,rval) (binary 'bitwise-and " | " lval rval))
       ((bitwise-xor ,lval ,rval) (binary 'bitwise-xor " ^ " lval rval))
 
+      ((and ,lval ,rval) (binary 'and " && " lval rval))
+      ((or ,lval ,rval) (binary 'and " || " lval rval))
+
+      ;; CHECK THIS
+      ((cond-expr ,cond ,tval ,fval)
+       (ppx cond) (sf "? ") (ppx tval) (sf ": ") (ppx fval))
+
       ((post-inc ,expr) (unary/r 'post-inc "++" expr))
       ((post-dec ,expr) (unary/r 'post-dec "--" expr))
 
        (let iter ((dsl dsl))
         (when (pair? dsl)
           (case (sx-tag (car dsl))
-            ((stor-spec) (sf "~A" (car (sx-ref (car dsl) 1))))
-            ((type-qual) (sf "qual=~A" (sx-ref (car dsl) 1)))
+            ((stor-spec) (sf "~A " (car (sx-ref (car dsl) 1))))
+            ((type-qual) (sf "~A " (sx-ref (car dsl) 1)))
             ((type-spec) (ppx (car dsl)))
             (else (sf "[?:~S] " (car dsl))))
-          (if (pair? (cdr dsl)) (sf " "))
+          ;;(if (pair? (cdr dsl)) (sf " "))
           (iter (cdr dsl)))))
 
       ((init-declr-list . ,rest)
        (sf "default:\n")
        (push-il) (ppx stmt) (pop-il))
 
+      ;; CHECK THIS
+      ((while ,expr ,stmt)
+       (sf "while (") (ppx expr) (sf ") ") (ppx stmt)
+       )
+
       ;; This does not meet the convention of "} while" on same line. 
       ((do-while ,stmt ,expr)
        (sf "do ")
        (lambda (pair) (ppx (car pair)) (if (pair? (cdr pair)) (sf ", ")))
        params))
 
+      ((ellipsis)      ;; should work
+       (sf "..."))
+
       ((param-decl ,decl-spec-list ,param-declr)
        (ppx decl-spec-list) (sf " ") (ppx param-declr))
       ((param-decl ,decl-spec-list)
index 43ab78bafd0fbf4542a39d5f8102c84aa03838aa..529b79bc53bd4bde736a4f19a2477e3d810934a4 100644 (file)
@@ -53,7 +53,7 @@
            fix-fields
            fixed-width-int-names
 
-           match-decl match-comp-decl
+           match-decl match-comp-decl match-param-decl
            declr->ident
            expand-decl-typerefs
            )
         (cond
          ((or (not tbd) (eqv? 'comment (sx-tag tbd)))
           (display "ISSUE: some decls have no init-declr-list\n")
-          ;; no init-declr-list => struct or union def
+          ;; no init-declr-list => struct or union def or param-decl
           ;;(display "spec:\n") (pretty-print spec)
           (sxml-match spec
             ((decl-spec-list
 ;; This will turn
 ;; @example
 ;; (comp-decl (decl-spec-list (type-spec "int"))
-;;            (comp-decl-list (comp-decl (ident "a")) (comp-decl (ident "b"))))
+;;            (comp-decl-list
+;;             (comp-declr (ident "a")) (comp-declr (ident "b"))))
 ;; @end example
 ;; @noindent
 ;; into
 ;; @example
-;; ("a" . (comp-decl (decl-spec-list ...) (comp-decl (ident "a"))))
-;; ("b" . (comp-decl (decl-spec-list ...) (comp-decl (ident "b"))))
+;; ("a" . (comp-decl (decl-spec-list ...) (comp-declr (ident "a"))))
+;; ("b" . (comp-decl (decl-spec-list ...) (comp-declr (ident "b"))))
 ;; @end example
 ;; @noindent
 ;; This is coded to be used with fold-right in order to preserve order
                           (cons* tag spec (car idl) tail))
                       (iter res (cdr idl)))))))))
 
+;; @deffn match-param-decl param-decl seed
+;; This will turn
+;; @example
+;; (param-decl (decl-spec-list (type-spec "int")) (param-declr (ident "a")))
+;; @end example
+;; @noindent
+;; into
+;; @example
+;; ("a" . (comp-decl (decl-spec-list ...) (comp-declr (ident "a"))))
+;; @end example
+;; @noindent
+;; This is coded to be used with fold-right in order to preserve order
+;; in @code{struct} and @code{union} field lists.
+(define (match-param-decl decl seed)
+  (if (not (eqv? 'param-decl (car decl))) seed
+      (let* ((tag (sx-ref decl 0))
+            (attr (sx-attr decl))
+            (spec (sx-ref decl 1))     ; (type-spec ...)
+            (declr (sx-ref decl 2))    ; (param-declr ...)
+            (ident (declr->ident declr))
+            (name (cadr ident)))
+       (acons name decl seed))))
+       
 ;; @deffn find-special udecl-alist seed => ..
 ;; NOT DONE
 ;; @example
index e22c0b21c2837ca73d06da41f94e857ac8b95ae6..859270195592a2341ba6243b0be37542c02d15d7 100644 (file)
@@ -342,6 +342,7 @@ sx)
 ;; @deffn make-pp-formatter/ugly => fmtr
 ;; Makes a @code{fmtr} like @code{make-pp-formatter} but no indentation
 ;; and just adds strings on ...
+;; This is specific to C/C++ because it will newline if #\# seen first.
 (define* (make-pp-formatter/ugly)
   (let*
       ((maxcol 78)
@@ -349,16 +350,25 @@ sx)
        (sf (lambda (fmt . args)
             (let* ((str (apply simple-format #f fmt args))
                    (len (string-length str)))
+              (if (and (positive? len)
+                       (char=? #\newline (string-ref str (1- len))))
+                  (string-set! str (1- len) #\space))
               (cond
-               ((zero? len) #t)
-               ((char=? #\# (string-ref str 0))
-                (display str))
+               ((zero? len) #t)        ; we reference str[0] next
+               ((and (equal? len 1) (char=? #\newline (string-ref str 0))) #t)
+               ((char=? #\# (string-ref str 0)) ; CPP-stmt: force newline
+                (when (positive? column) (newline))
+                (display str)          ; str always ends in \n
+                (set! column           ; if ends \n then col= 0 else len
+                      (if (char=? #\newline (string-ref str (1- len)))
+                          0 len)))
+               ((zero? column)
+                (display str)
+                (set! column len))
                (else
                 (when (> (+ column len) maxcol)
                   (newline)
                   (set! column 0))
-                (if (char=? #\newline (string-ref str (1- len)))
-                    (string-set! str (1- len) #\space))
                 (display str)
                 (set! column (+ column len))))))))