mescc: Handle any const, by ignoring.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 2 Jun 2017 11:12:56 +0000 (13:12 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 2 Jun 2017 11:12:56 +0000 (13:12 +0200)
* module/language/c99/compiler.mes (ast-strip-const): New function.
  (c99-input->ast): Use it.
  (type->size, type->description, ast->info): Remove const handling.

module/language/c99/compiler.mes

index d40c7621f7de12243bd8856935943810ec0f6cd6..e6353464af6d3d8c3b62bd9ba7385195bfbb0d48 100644 (file)
                    (cons (ast-strip-comment h) (ast-strip-comment t))))
     (_  o)))
 
+(define (ast-strip-const o)
+  (pmatch o
+    ((type-qual ,qual) (if (equal? qual "const") #f o))
+    ((decl-spec-list (type-qual ,qual) . ,rest)
+     (if (equal? qual "const") `(decl-spec-list ,@rest)
+         `(decl-spec-list (type-qual ,qual) ,@(map ast-strip-const rest))))
+    ((,h . ,t) (if (list? o) (filter-map ast-strip-const o)
+                   (cons (ast-strip-const h) (ast-strip-const t))))
+    (_  o)))
+
 (define* (c99-input->ast #:key (defines '()) (includes '()))
-  (ast-strip-comment (c99-input->full-ast #:defines defines #:includes includes)))
+  ((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:defines defines #:includes includes)))
 
 (define (ast:function? o)
   (and (pair? o) (eq? (car o) 'fctn-defn)))
   (pmatch o
     ((decl-spec-list (type-spec (fixed-type ,type)))
      (type->size info type))
-    ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
-     (type->size info type))
     ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
      (type->size info type))
     ((struct-ref (ident ,type))
   (pmatch o
     ((decl-spec-list (type-spec (fixed-type ,type)))
      (type->description info type))
-    ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
-     (type->description info type))
     ((struct-ref (ident ,type))
      (type->description info `("struct" ,type)))
     (_ (let ((type (get-type (.types info) o)))
                               (initzer->data f g ta t d '(initzer (p-expr (string ,string))))
                               (list-tail data (+ here ,size)))))))))))
         
-        ;; char const *p;
-        ((decl (decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qualifier)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
-         (if (.function info)
-             (let* ((locals (add-local locals name type 1))
-                    (info (clone info #:locals locals)))
-               (append-text info (append (wrap-as (i386:value->accu 0))
-                                         ((accu->ident info) name))))
-             (let ((globals (append globals (list (ident->global name type 1 0)))))
-               (clone info #:globals globals))))
-
         ;; char *p;
         ((decl (decl-spec-list (type-spec (fixed-type ,type)) . _) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
          (if (.function info)
         ((decl (decl-spec-list (type-spec (void))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
          (declare name))
 
-        ;; char const* itoa ();
-        ((decl (decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual)) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
-         (declare name))
-
         ;; char *strcpy ();
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
          (declare name))
          info)
 
         ;; ST_DATA const int *macro_ptr;
-        ((decl (decl-spec-list (stor-spec (extern)) (type-qual ,qual) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
+        ((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
          info)
 
         ;; ST_DATA TokenSym **table_ident;
         ((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
          info)
 
-        ;; ST_DATA const int reg_classes[NB_REGS];
-        ((decl (decl-spec-list (stor-spec (extern)) (type-qual ,qual) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,size))))))
-         info)
-
         ;; int i = 0, j = 0;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) . ,initzer) . ,rest))
          (let loop ((inits `((init-declr (ident ,name) ,@initzer) ,@rest)) (info info))
                       `(decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list ,(car inits))))))))
 
 
-        ;; const char *target; silly notation, const always operates to the LEFT (except when there's no left)
-        ((decl (decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
-         ((ast->info info)
-          `(decl (decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))))
-
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident (,type))))) (init-declr-list (init-declr (ident ,name))))
          (clone info #:types (cons (cons name (or (get-type types type) `(typedef ("struct" ,type)))) types)))