(srfi-9:define-record-type :attribute
  (make-attribute value position)
  attribute?
  (value attribute-value)
  (position attribute-position))

(define-record-type aux
  ()
  ((name (none))
   (type (lambda (x) x))
   (init (absyn-exp.nil))))

(define-record-discloser type/aux
  (lambda (p)
    `(aux ,(aux-name p) ,(aux-type p) ,(aux-init p))))

(define (pos-of obj)
  (cond ((attribute? obj) (attribute-position obj))

	((absyn-dec.var? obj) (absyn-dec.var->pos obj))
	((absyn-dec.type? obj) (absyn-dec.type->pos obj))
	((absyn-dec.typedef? obj) (absyn-dec.typedef->pos obj))

	((absyn-exp.nil? obj) (error "pos-of (absyn-exp.nil)"))
	((absyn-exp.asgn? obj) (absyn-exp.asgn->pos obj))
	((absyn-exp.pointerbin? obj) (absyn-exp.pointerbin->pos obj))
	((absyn-exp.arithbin? obj) (absyn-exp.arithbin->pos obj))
	((absyn-exp.arithun? obj) (absyn-exp.arithun->pos obj))
	((absyn-exp.boolbin? obj) (absyn-exp.boolbin->pos obj))
	((absyn-exp.boolun? obj) (absyn-exp.boolun->pos obj))
	((absyn-exp.cast? obj) (absyn-exp.cast->pos obj))
	((absyn-exp.var? obj) (absyn-exp.var->pos obj))
	((absyn-exp.const? obj) (absyn-exp.const->pos obj))
	((absyn-exp.seq? obj) (absyn-exp.seq->pos obj))
	((absyn-exp.cond? obj) (absyn-exp.cond->pos obj))
	((absyn-exp.deref? obj) (absyn-exp.deref->pos obj))
	((absyn-exp.addr? obj) (absyn-exp.addr->pos obj))
	((absyn-exp.call? obj) (absyn-exp.call->pos obj))
	((absyn-exp.struct-access? obj) (absyn-exp.struct-access->pos obj))
	((absyn-exp.post-inc? obj) (absyn-exp.post-inc->pos obj))
	((absyn-exp.post-dec? obj) (absyn-exp.post-dec->pos obj))
	((absyn-exp.sizeof? obj) (absyn-exp.sizeof->pos obj))

	((absyn-stm.nop? obj) (error "pos-of (absyn-stm.nop)"))
	((absyn-stm.exp? obj) (absyn-stm.exp->pos obj))
	((absyn-stm.if-then? obj) (absyn-stm.if-then->pos obj))
	((absyn-stm.if-then-else? obj) (absyn-stm.if-then-else->pos obj))
	((absyn-stm.switch? obj) (absyn-stm.switch->pos obj))
	((absyn-stm.case? obj) (absyn-stm.case->pos obj))
	((absyn-stm.default? obj) (absyn-stm.default->pos obj))
	((absyn-stm.block? obj) (absyn-stm.block->pos obj))
	((absyn-stm.returnval? obj) (absyn-stm.returnval->pos obj))
	((absyn-stm.return? obj) (absyn-stm.return->pos obj))
	((absyn-stm.break? obj) (absyn-stm.break->pos obj))
	((absyn-stm.continue? obj) (absyn-stm.continue->pos obj))
	((absyn-stm.while? obj) (absyn-stm.while->pos obj))
	((absyn-stm.do-while? obj) (absyn-stm.do-while->pos obj))
	((absyn-stm.for? obj) (absyn-stm.for->pos obj))
	((absyn-stm.sequence? obj) (absyn-stm.sequence->pos obj))
	((absyn-stm.label? obj) (absyn-stm.label->pos obj))
	((absyn-stm.goto? obj) (absyn-stm.goto->pos obj))

	((absyn-type.pointer? obj) (absyn-type.pointer->pos obj))
	((absyn-type.array? obj) (absyn-type.array->pos obj))
	((absyn-type.function? obj) (absyn-type.function->pos obj))
	((absyn-type.qual? obj) (absyn-type.qual->pos obj))
	((absyn-type.bitfield? obj) (absyn-type.bitfield->pos obj))
	((absyn-type.struct? obj) (absyn-type.struct->pos obj))
	((absyn-type.union? obj) (absyn-type.union->pos obj))
	((absyn-type.enum? obj) (absyn-type.enum->pos obj))
	((absyn-type.typedefed? obj) (absyn-type.typedefed->pos obj))
	((absyn-type.storage-class? obj) (absyn-type.storage-class->pos obj))
	((absyn-type.actual-type? obj) (absyn-type.actual-type->pos obj))
;	((absyn-type.type-adjective? obj) (absyn-type.type-adjective->pos obj))

	((symbol? obj) (error "pos-of 'symbol" obj))

	((list? obj) (pos-of (car obj)))
	 
	(else (error "pos-of: unknown obj type" obj))))

(define (maybe-attribute-value obj)
  (cond ((attribute? obj) (attribute-value obj))
	((list? obj) (map maybe-attribute-value obj))
	(else obj)))

(define define-trace-does-trace #t)
(define trace-indent-level 0)
(define-syntax define-trace
  (syntax-rules ()
	((define-trace (name) exp)
	 (begin
	   (define (name)
	     (if define-trace-does-trace
		 (begin
		   (display (make-string trace-indent-level #\space))
		   (set! trace-indent-level (+ trace-indent-level 1))
		   (display 'name)
		   (newline)
		   (let ((res exp))
		     (begin
		       (set! trace-indent-level (- trace-indent-level 1))
		       (display (make-string trace-indent-level #\space))
		       (display 'name)
		       (display " done")
		       (newline)
		       res)))
		 (begin
		   (let ((res exp))
		     (begin
		       res)))))))
	((define-trace (name arg ...) exp)
	 (begin
	   (define (name arg ...)
	     (if define-trace-does-trace
		 (begin
		   (display (make-string trace-indent-level #\space))
		   (set! trace-indent-level (+ trace-indent-level 1))
		   (display 'name)
		   (for-each (lambda (x) (begin (display " ") (display x)))
			     (list arg ...))
		   (newline)
		   (let ((res exp))
		     (begin
		       (set! trace-indent-level (- trace-indent-level 1))
		       (display (make-string trace-indent-level #\space))
		       (display 'name)
		       (display " done => ")
		       (display res)
		       (newline)
		       res)))
		 (begin
		   (let ((res exp))
		     (begin
		       res)))))))))

(define typename-table (make-string-table))

;;startnew
(define (typename-table-ref name)
  (table-ref typename-table name))

(define (typename-table-set! name type)
  (table-set! typename-table name type))
;;endnew

(define (typename? name)
  (if (typename-table-ref name)
      #t
      #f))

(define (clear-typename-table)
  (set! typename-table (make-string-table)))

; program -> translation-unit
;	     (absyn-dec.var)  -> absyn-prg.prog
(define (program-1 $1)
  (absyn-prg.prog $1))

; translation-unit -> external-declaration
;		      absyn-dec.var         -> (absyn-dec.var)
;		      (absyn-dec.var)       -> (absyn-dec.var)
(define (translation-unit-1 $1)
  (if (list? $1)
      $1
      (list $1)))

; translation-unit -> translation-unit external-declaration
;		      (absyn-dec.var)  absyn-dec.var        -> (absyn-dec.var)
;		      (absyn-dec.var)  (absyn-dec.var)      -> (absyn-dec.var)
(define (translation-unit-2 $1 $2)
  (if (list? $2)
      (append $1 $2)
      (append $1 (list $2))))

; external-declaration -> function-definition
;			  absyn-dec.var	      -> absyn-dec.var
(define (external-declaration-1 $1)
  $1)

; external-declaration -> declaration
;			  absyn-dec.var -> absyn-dec.var
(define (external-declaration-2 $1)
  $1)

; external-declaration untyped-declaration
; unreachable, will already barf in untyped-declaration-1
(define (external-declaration-3 $1)
  (error "external-declaration-3: not ansi-c"))

;function-definition -> function-declarator compound-statement-or-error
(define (function-definition-1 $1 $2)
  (error "function-definition-1: not ansi-c"))

; function-definition ->
;	function-declarator declaration-list compound-statement-or-error
(define (function-definition-2 $1 $2 $3)
  (error "function-definition-2: old-style"))

; function-definition ->
;	declaration-specifiers function-declarator compound-statement-or-error
;	(type)		       aux		   absyn-stm
;		-> absyn-dec.function
(define (function-definition-3 $1 $2 $3)
  (let ((funtype ((aux-type $2) (default-to-int $1))))
    (absyn-dec.function (pos-of $1)
			(aux-name $2)
			(absyn-type.function->maybe-from-types funtype)
			(absyn-type.function->to-type funtype)
			$3)))

; function-definition ->
;	declaration-specifiers function-declarator declaration-list
;	compound-statement-or-error
(define (function-definition-4 $1 $2 $3 $4)
  (error "function-definition-4: old-style"))

; declaration -> declaration-meat t-semicolon
(define (declaration-1 $1 $2)
  $1)

; declaration-meat -> $error
(define (declaration-meat-1 $1)
  (error "declaration-meat-1: syntax-error"))

; declaration-meat -> declaration-specifiers
;		       (type)		     -> (absyn-dec.type)
; struct foo;
; int;
(define (declaration-meat-2 $1)
  (let (($1 (default-to-int $1)))
    (list
     (if (absyn-dec.typedef? $1)
	 $1
	 (absyn-dec.type (pos-of $1) $1)))))
  
; declaration-meat -> declaration-specifiers init-declarator-list
;                     (type)                 (aux)
;		   -> absyn-dec.var
; int a;
; extern int a;
; typedef int a, b;
(define (declaration-meat-3 $1 $2)
  (map (lambda (p)
	 (let ((name (aux-name p))
	       (type ((aux-type p) (default-to-int $1)))
	       (init (aux-init p)))
	   (if (absyn-dec.typedef? type)
	       (begin
		 (typename-table-set! 
			     name
			     (absyn-dec.typedef->type type))
		 (absyn-dec.typedef (absyn-dec.typedef->pos type)
				    (absyn-dec.typedef->type type)
				    (some name)))
	       (absyn-dec.var (pos-of type)
			      (some name)
			      (maybe-attribute-value type)
			      init))))
       $2))

; untyped-declaration -> init-declarator-list t-semicolon
(define (untyped-declaration-1 $1 $2)
  (error "untyped-declaration-1: not ansi-c"))

; declaration-list -> declaration
(define (declaration-list-1 $1)
  $1)

; declaration-list -> declaration-list declaration
(define (declaration-list-2 $1 $2)
  (append $1 $2))

; declaration-specifiers -> storage-class-specifier
(define (declaration-specifiers-1 $1)
  (error "declaration-specifiers-1: not ansi-c"))

; declaration-specifiers -> storage-class-specifier declaration-specifiers
(define (declaration-specifiers-2 $1 $2)
  ($1 $2))

; declaration-specifiers -> type-specifier
(define (declaration-specifiers-3 $1)
  $1)

; declaration-specifiers -> type-specifier declaration-specifiers
; int const
(define (declaration-specifiers-4 $1 $2)
  (combine $1 $2))

; declaration-specifiers -> type-qualifier
; const;
; int const;
; FIXME
(define (declaration-specifiers-5 $1)
  $1)

; declaration-specifiers type-qualifier declaration-specifiers
; const unsigned;
; const int x;
(define (declaration-specifiers-6 $1 $2)
  (combine $1 $2))

; storage-class-specifier -> t-typedef
(define (storage-class-specifier-1 $1)
  (lambda (type)
    (absyn-dec.typedef (pos-of $1)
		       (default-to-int type)
		       (none))))

(define (make-storage-class pos tag)
  (lambda (type)
    (absyn-type.storage-class pos
			      tag
			      (default-to-int type))))

; storage-class-specifier -> t-extern
(define (storage-class-specifier-2 $1)
  (make-storage-class (attribute-position $1) 'extern))

; storage-class-specifier -> t-static
(define (storage-class-specifier-3 $1)
  (make-storage-class (attribute-position $1) 'static))

; storage-class-specifier -> t-auto
(define (storage-class-specifier-4 $1)
  (make-storage-class (attribute-position $1) 'auto))

; storage-class-specifier -> t-register
(define (storage-class-specifier-5 $1)
  (make-storage-class (attribute-position $1) 'register))

; type-specifier -> actual-type-specifier
(define (type-specifier-1 $1)
  $1)

; type-specifier -> type-adjective
(define (type-specifier-2 $1)
  $1)

; actual-type-specifier -> t-void
(define (actual-type-specifier-1 $1)
  (absyn-type.actual-type (attribute-position $1)
			  'void))

; actual-type-specifier -> t-char
(define (actual-type-specifier-2 $1)
  (absyn-type.actual-type (attribute-position $1)
			  'char))

; actual-type-specifier -> t-int
(define (actual-type-specifier-3 $1)
  (absyn-type.actual-type (attribute-position $1)
			  'int))

; actual-type-specifier -> t-float
(define (actual-type-specifier-4 $1)
  (absyn-type.actual-type (attribute-position $1)
			  'float))

; actual-type-specifier -> t-double
(define (actual-type-specifier-5 $1)
  (absyn-type.actual-type (attribute-position $1)
			  'double))

; actual-type-specifier -> struct-or-union-specifier
(define (actual-type-specifier-6 $1)
  $1)

; actual-type-specifier -> enum-specifier
(define (actual-type-specifier-7 $1)
  $1)

; actual-type-specifier -> t-typename
(define (actual-type-specifier-8 $1)
  (absyn-type.typedefed (attribute-position $1)
			(attribute-value $1)))

;; Helper for type-adjective and type-qualifier
(define (qual-adder pos qualifier)
  (lambda (type)
    (if (absyn-type.qual? type)
	(absyn-type.qual pos
			 ;; FIXME keep list in some canonical way?
			 (cons qualifier (absyn-type.qual->qualificators type))
			 (absyn-type.qual->type type))
	(if (absyn-type.actual-type? type)
	    (let ((type
		   (if (eq? (absyn-type.actual-type->pos type) 
			    'default-to-int-position)
		       ;; propagate position into default int type
		       (absyn-type.actual-type 
			pos
			(absyn-type.actual-type->tag type))
		       type)))
	      (absyn-type.qual pos (list qualifier) type))
	    (error "missing actual-type in qual-adder" type)))))

(define (combine $1 $2)
  (if (procedure? $1)
      (if (procedure? $2)
	  (lambda (t)
	    ($1 (combine t $2)))
	  ($1 $2))
      (if (procedure? $2)
	  ($2 $1)
	  (error "neither $1 nor $2 is a procedure" $1 $2))))

(define (default-to-int $1)
  (if (procedure? $1)
      (default-to-int ($1 (absyn-type.actual-type 
			   'default-to-int-position ;will be fixed in qual-adder
			   'int)))
      $1))

; type-adjective -> t-short
(define (type-adjective-1 $1)
  (qual-adder (attribute-position $1) 'short))

; type-adjective -> t-long
(define (type-adjective-2 $1)
  (qual-adder (attribute-position $1) 'long))

; type-adjective -> t-signed
(define (type-adjective-3 $1)
  (qual-adder (attribute-position $1) 'signed))

; type-adjective -> t-unsigned
(define (type-adjective-4 $1)
  (qual-adder (attribute-position $1) 'unsigned))

; type-qualifier -> t-const
(define (type-qualifier-1 $1)
  (qual-adder (attribute-position $1) 'const))

; type-qualifier -> t-volatile
(define (type-qualifier-2 $1)
  (qual-adder (attribute-position $1) 'volatile))

; struct-or-union-specifier
;	-> struct-or-union t-openbrace struct-declaration-list t-closedbrace
; struct { int bla; }
; Useless statement, add warning?
(define (struct-or-union-specifier-1 $1 $2 $3 $4)
  ($1 (none) (some $3)))

; struct-or-union-specifier ->
;    struct-or-union t-identifier t-openbrace struct-declaration-list t-closedbrace
(define (struct-or-union-specifier-2 $1 $2 $3 $4 $5)
  ($1 (some (attribute-value $2)) (some $4)))

; struct-or-union-specifier -> struct-or-union t-identifier
(define (struct-or-union-specifier-3 $1 $2)
  ($1 (some (attribute-value $2)) (none)))

; struct-or-union -> t-struct
(define (struct-or-union-1 $1)
  (lambda (tag entries)
    (absyn-type.struct (pos-of $1) tag entries)))

; struct-or-union -> t-union
(define (struct-or-union-2 $1)
  (lambda (tag entries)
    (absyn-type.union (pos-of $1) tag entries)))

; struct-declaration-list -> struct-declaration
(define (struct-declaration-list-1 $1)
  $1)

; struct-declaration-list -> struct-declaration-list struct-declaration
(define (struct-declaration-list-2 $1 $2)
  (append $1 $2))

; init-declarator-list -> init-declarator
(define (init-declarator-list-1 $1)
  (list $1))

; init-declarator-list -> init-declarator-list t-comma init-declarator
(define (init-declarator-list-2 $1 $2 $3)
  (append $1 (list $3)))

; init-declarator -> declarator
(define (init-declarator-1 $1)
  (begin
    (set-aux-init! $1 (absyn-exp.nil))
    $1))

; init-declarator -> declarator t-assign initializer
(define (init-declarator-2 $1 $2 $3)
  (begin
    (set-aux-init! $1 $3)
    $1))

; struct-declaration -> specifier-qualifier-list struct-declarator-list t-semicolon
(define (struct-declaration-1 $1 $2 $3)
  (map (lambda (p)
	 (absyn-dec.var
	  (pos-of $1)
	  (if (none? (aux-name p))	; unnamed bitfield
	      (none)
	      (some (aux-name p)))
	  ((aux-type p) $1)
	  (aux-init p)))
       $2))

; specifier-qualifier-list -> type-specifier
; FIXME
(define (specifier-qualifier-list-1 $1)
  $1)
;  (list $1))

; specifier-qualifier-list -> type-specifier specifier-qualifier-list
; FIXME
(define (specifier-qualifier-list-2 $1 $2)
  (if (procedure? $2)
      (lambda (x)
	($1 ($2 x)))
      ($1 $2)))

; specifier-qualifier-list -> type-qualifier
(define (specifier-qualifier-list-3 $1)
  (error "specifier-qualifier-list-3: not ansi-c"))

; specifier-qualifier-list type-qualifier -> specifier-qualifier-list
; FIXME
(define (specifier-qualifier-list-4 $1 $2)
  (if (procedure? $2)
      (lambda (x)
	($1 ($2 x)))
      ($1 $2)))

; struct-declarator-list -> struct-declarator
(define (struct-declarator-list-1 $1)
  (list $1))

; struct-declarator-list -> struct-declarator-list t-comma struct-declarator
(define (struct-declarator-list-2 $1 $2 $3)
  (append $1 (list $3)))

; struct-declarator -> declarator
(define (struct-declarator-1 $1)
  $1)

; struct-declarator -> t-colon constant-expression
(define (struct-declarator-2 $1 $2)
  (let ((t (aux-maker)))
    (set-aux-type! t (lambda (ty)
		       (absyn-type.bitfield (pos-of $2) $2 ty)))
    t))

; struct-declarator -> declarator t-colon constant-expression
(define (struct-declarator-3 $1 $2 $3)
  (begin
    (set-aux-type! $1 (lambda (ty)
			(absyn-type.bitfield (pos-of $3) $3 ty)))
    $1))

; enum-specifier -> t-enum t-openbrace enumerator-list t-closedbrace
(define (enum-specifier-1 $1 $2 $3 $4)
  (absyn-type.enum (pos-of $1) (none) (some $3)))

; enum-specifier -> t-enum t-identifier t-openbrace enumerator-list t-closedbrace
(define (enum-specifier-2 $1 $2 $3 $4 $5)
  (absyn-type.enum (pos-of $1) (some (attribute-value $2)) (some $4)))

; enum-specifier -> t-enum t-identifier
(define (enum-specifier-3 $1 $2)
  (absyn-type.enum (pos-of $1) (some (attribute-value $2)) (none)))

; enumerator-list -> enumerator
(define (enumerator-list-1 $1)
  (list $1))

; enumerator-list -> enumerator-list t-comma enumerator
(define (enumerator-list-2 $1 $2 $3)
  (append $1 (list $3)))

; enumerator -> $error
(define (enumerator-1 $1)
  (error "enumerator-1: syntax-error"))

; enumerator -> t-identifier
(define (enumerator-2 $1)
  (absyn-dec.var
   (pos-of $1)
   (some (absyn-exp.var (pos-of $1) (attribute-value $1)))
   '(enum-elem)
   (absyn-exp.nil)))

; enumerator -> t-identifier t-assign constant-expression
(define (enumerator-3 $1 $2 $3)
  (absyn-dec.var
   (pos-of $1)
   (some (absyn-exp.var (pos-of $1) (attribute-value $1)))
   '(int)
   $3))

; declarator -> direct-declarator
; FIXME!
(define (declarator-1 $1)
  (if (procedure? $1)
      ($1)
      $1))

; declarator -> pointer direct-declarator
(define (declarator-2 $1 $2)
  (let ((make-type (aux-type $2)))
    (set-aux-type! $2 (lambda (ty)
			(make-type ($1 ty))))
    $2))

; direct-declarator -> t-identifier
(define (direct-declarator-1 $1)
  (let ((t (aux-maker)))
    (set-aux-name! t (attribute-value $1))
    t))

; direct-declarator -> t-openpar declarator t-closedpar
(define (direct-declarator-2 $1 $2 $3)
  $2)

; int x[1][2][3] means array(1, array(2, array(3, int))), but we parse
; the 3 last, so we need to shift the size down in the parse tree
(define (make-array pos size type)
  (letrec ((loop (lambda (t)
		   (if (absyn-type.array? t)
		       (absyn-type.array (absyn-type.array->pos t)
					 (absyn-type.array->maybe-size t)
					 (loop (absyn-type.array->type t)))
		       (absyn-type.array pos
					 size
					 t)))))
    (loop type)))

; direct-declarator -> direct-declarator t-openbracket t-closedbracket
(define (direct-declarator-3 $1 $2 $3)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(let ((type (make-type ty)))
			  (make-array (pos-of ty)
				      (none)
				      type)))))
  $1)

; direct-declarator
;	-> direct-declarator t-openbracket constant-expression t-closedbracket
(define (direct-declarator-4 $1 $2 $3 $4)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(let ((type (make-type ty)))
			  (make-array (pos-of ty)
				      (some $3)
				      type)))))
  $1)

; direct-declarator ->
;	direct-declarator t-openpar parameter-type-list t-closedpar
(define (direct-declarator-5 $1 $2 $3 $4)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(make-type (absyn-type.function
				    (pos-of ty)
				    (some (maybe-attribute-value $3))
				    (maybe-attribute-value ty)))))
    $1))

; direct-declarator -> direct-declarator t-openpar t-closedpar
(define (direct-declarator-6 $1 $2 $3)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(make-type (absyn-type.function
				    (pos-of ty)
				    (none)
				    (maybe-attribute-value ty)))))
    $1))

; direct-declarator -> direct-declarator t-openpar $error t-closedpar
(define (direct-declarator-7 $1 $2 $3 $4)
  (error "direct-declarator-7: syntax-error"))

; direct-declarator -> direct-declarator t-openpar identifier-list t-closedpar
(define (direct-declarator-8 $1 $2 $3 $4)
  (error "direct-declarator-8: not ansi-c"))

; function-declarator -> direct-function-declarator
;                                                   ->
(define (function-declarator-1 $1)
  $1)

; function-declarator -> pointer direct-function-declarator
(define (function-declarator-2 $1 $2)
  (let ((make-type (aux-type $2)))
    (set-aux-type! $2 (lambda (ty)
			(make-type ($1 ty))))
    $2))

; direct-function-declarator -> direct-declarator t-openpar $error t-closedpar
(define (direct-function-declarator-1 $1 $2 $3 $4)
  (error "direct-function-declarator-1: syntax-error"))

; direct-function-declarator ->
;	direct-declarator t-openpar parameter-type-list t-closedpar
(define (direct-function-declarator-2 $1 $2 $3 $4)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(absyn-type.function
			 (pos-of ty)
			 (some (maybe-attribute-value $3))
			 (maybe-attribute-value (make-type ty)))))
    $1))

; direct-function-declarator direct-declarator t-openpar t-closedpar
(define (direct-function-declarator-3 $1 $2 $3)
  (let ((make-type (aux-type $1)))
    (set-aux-type! $1 (lambda (ty)
			(absyn-type.function
			 (pos-of ty)
			 (none)
			 (maybe-attribute-value (make-type ty)))))
    $1))

; direct-function-declarator ->
;	direct-declarator t-openpar identifier-list t-closedpar
(define (direct-function-declarator-4 $1 $2 $3 $4)
  (error "direct-function-declarator-4: old-style"))

; pointer -> t-asterisk
(define (pointer-1 $1)
  (lambda (ty)
    (if (absyn-dec.typedef? ty)
	(absyn-dec.typedef (absyn-dec.typedef->pos ty)
			   (absyn-type.pointer (pos-of $1) (absyn-dec.typedef->type ty))
			   (absyn-dec.typedef->maybe-name ty))
	(absyn-type.pointer (pos-of ty)
			    (maybe-attribute-value ty)))))

; pointer -> t-asterisk type-qualifier-list
(define (pointer-2 $1 $2)
; FIXME how could we have a typedef here?
;  (lambda (ty)
;    (if (absyn-dec.typedef? ty)
;	(absyn-dec.typedef (absyn-dec.typedef->pos ty)
;			   (absyn-type.qual
;			    (pos-of $1)
;			    $2
;			    (absyn-type.pointer (pos-of $1) (absyn-dec.typedef->type ty)))
;			   (absyn-dec.typedef->maybe-name ty))
;	(absyn-type.qual (pos-of $1) $2 (absyn-type.pointer (pos-of $1) (maybe-attribute-value ty))))))
  (lambda (type)
    ($2 (absyn-type.pointer (pos-of $1) type))))

 
; pointer -> t-asterisk pointer
(define (pointer-3 $1 $2)
  (lambda (ty) ($2 (absyn-type.pointer (pos-of $1)
				       (maybe-attribute-value ty)))))

; pointer -> t-asterisk type-qualifier-list pointer
(define (pointer-4 $1 $2 $3)
;  (lambda (ty) ($3 (absyn-type.qual
;		    (pos-of $1)
;		    $2
;		    (absyn-type.pointer
;		     (pos-of $1)
;		     (maybe-attribute-value ty))))))
  (lambda(type)
    ($3 ($2 (absyn-type.pointer (pos-of $1)
				type)))))

; type-qualifier-list -> type-qualifier
; int *const x;
(define (type-qualifier-list-1 $1)
  $1)
;  (list $1))

; type-qualifier-list -> type-qualifier-list type-qualifier
(define (type-qualifier-list-2 $1 $2)
  ($2 $1))
  ;(append $1 (list $2)))

; parameter-type-list -> parameter-list
(define (parameter-type-list-1 $1)
  (if (equal? (absyn-dec.var->type (car $1)) '(void))
      '()
      $1))

; parameter-type-list -> parameter-list t-comma t-ellipsis
(define (parameter-type-list-2 $1 $2 $3)
  (append $1 (list (absyn-dec.var (pos-of $3)
				  (none)
				  (absyn-type.actual-type (pos-of $3) 'ellipsis)
				  (absyn-exp.nil)))))

; parameter-list -> parameter-declaration
(define (parameter-list-1 $1)
  (list $1))

; parameter-list -> parameter-list t-comma parameter-declaration
(define (parameter-list-2 $1 $2 $3)
  (append $1 (list $3)))

; parameter-declaration -> declaration-specifiers declarator
(define (parameter-declaration-1 $1 $2)
  (let (($1 (default-to-int $1)))
    (absyn-dec.var (pos-of $1)
		   (some (maybe-attribute-value (aux-name $2)))
		   (maybe-attribute-value ((aux-type $2) $1))
		   (aux-init $2))))

; parameter-declaration -> declaration-specifiers
(define (parameter-declaration-2 $1)
  (absyn-dec.var (pos-of $1) (none) (maybe-attribute-value $1) (absyn-exp.nil)))

; parameter-declaration -> declaration-specifiers abstract-declarator
(define (parameter-declaration-3 $1 $2)
  (absyn-dec.var (pos-of $1) (none) (maybe-attribute-value ($2 $1)) (absyn-exp.nil)))

(define (identifier-list-1 $1)
  (error "identifier-list-1: unimplemented, please submit a bug report"))

(define (identifier-list-2 $1 $2 $3)
  (error "identifier-list-2: unimplemented, please submit a bug report"))

(define (initializer-1 $1)
  (error "initializer-1: syntax-error"))

(define (initializer-2 $1)
  $1)

(define (initializer-3 $1 $2 $3)
  $2)

(define (initializer-4 $1 $2 $3 $4)
  $2)

(define (initializer-list-1 $1)
  (list $1))

(define (initializer-list-2 $1 $2 $3)
  (append $1 (list $3)))

(define (type-name-1 $1)
  $1)

(define (type-name-2 $1 $2)
  ($2 $1))

(define (abstract-declarator-1 $1)
  $1)

(define (abstract-declarator-2 $1)
  $1)

(define (abstract-declarator-3 $1 $2)
  (lambda (ty)
    ($2 ($1 ty))))

; direct-abstract-declarator -> t-openpar abstract-declarator t-closedpar
(define (direct-abstract-declarator-1 $1 $2 $3)
  $2)

; direct-abstract-declarator -> t-openbracket t-closedbracket
(define (direct-abstract-declarator-2 $1 $2)
  (lambda (ty)
    (absyn-type.array (pos-of ty) (none) (maybe-attribute-value ty))))

; direct-abstract-declarator -> t-openbracket constant-expression t-closedbracket
(define (direct-abstract-declarator-3 $1 $2 $3)
  (lambda (ty)
    (absyn-type.array (pos-of ty) (some $2) (maybe-attribute-value ty))))

; direct-abstract-declarator -> direct-abstract-declarator t-openbracket t-closedbracket
(define (direct-abstract-declarator-4 $1 $2 $3)
  (lambda (ty)
    (absyn-type.array (pos-of ty) (none) (maybe-attribute-value ($1 ty)))))

; direct-abstract-declarator -> direct-abstract-declarator t-openbracket constant-expression t-closedbracket
(define (direct-abstract-declarator-5 $1 $2 $3 $4)
  (lambda (ty)
    (absyn-type.array
     (pos-of ty)
     (some (maybe-attribute-value $3))
     (maybe-attribute-value ($1 ty)))))

; direct-abstract-declarator -> t-openpar t-closedpar
(define (direct-abstract-declarator-6 $1 $2)
  (error "testcase needed"))

; direct-abstract-declarator -> t-openpar parameter-type-list t-closedpar
(define (direct-abstract-declarator-7 $1 $2 $3)
  (error "testcase needed"))

; FIXME
; direct-abstract-declarator -> direct-abstract-declarator t-openpar t-closedpar
(define (direct-abstract-declarator-8 $1 $2 $3)
  (lambda (ty)
    ($1 (absyn-type.function (pos-of ty) (none) (maybe-attribute-value ty)))))

; direct-abstract-declarator -> direct-abstract-declarator t-openpar parameter-type-list t-closedpar
(define (direct-abstract-declarator-9 $1 $2 $3 $4)
  (lambda (ty)
    ($1 (absyn-type.function (pos-of ty) (some $3) (maybe-attribute-value ty)))))

(define (statement-1 $1)
  $1)

(define (statement-2 $1)
  $1)

(define (statement-3 $1)
  (if (absyn-exp.nil? $1)
      (absyn-stm.nop)
      (absyn-stm.exp (pos-of $1) $1)))

(define (statement-4 $1)
  $1)

(define (statement-5 $1)
  $1)

(define (statement-6 $1)
  $1)

(define (labeled-statement-1 $1 $2 $3)
  (absyn-stm.sequence (pos-of $1) (absyn-stm.label (pos-of $1) $1) $3))

(define (labeled-statement-2 $1 $2 $3 $4)
  (absyn-stm.case (pos-of $1) $2 $4))

(define (labeled-statement-3 $1 $2 $3)
  (absyn-stm.default (pos-of $1) $3))

(define (expression-statement-1 $1 $2)
  $1)

(define (compound-statement-or-error-1 $1)
  $1)

(define (compound-statement-or-error-2 $1 $2)
  (error "compound-statement-or-error-2: syntax-error"))

(define (compound-statement-1 $1 $2)
  (absyn-stm.nop))

(define (compound-statement-2 $1 $2 $3)
  $2)

; compound-statement -> t-openbrace declaration-list t-closedbrace
(define (compound-statement-3 $1 $2 $3)
  (absyn-stm.block (pos-of $1) $2 (absyn-stm.nop)))

; compound-statement -> t-openbrace declaration-list statement-list t-closedbrace
(define (compound-statement-4 $1 $2 $3 $4)
  (absyn-stm.block (pos-of $1) $2 $3))

(define (statement-list-1 $1)
  $1)

(define (statement-list-2 $1 $2)
  (if (absyn-stm.nop? $2)
      $1
      (absyn-stm.sequence (pos-of $1) $1 $2)))

(define (selection-statement-1 $1 $2 $3 $4 $5)
  (absyn-stm.if-then (pos-of $1) $3 $5))

(define (selection-statement-2 $1 $2 $3 $4 $5 $6 $7)
  (absyn-stm.if-then-else (pos-of $1) $3 $5 $7))

(define (selection-statement-3 $1 $2 $3 $4 $5)
  (absyn-stm.switch (pos-of $1) $3 $5))

(define (iteration-statement-1 $1 $2 $3 $4 $5)
  (absyn-stm.while (pos-of $1) $3 $5))

(define (iteration-statement-2 $1 $2 $3 $4 $5 $6 $7)
  (absyn-stm.do-while (pos-of $1) $2 $5))

(define (iteration-statement-3 $1 $2 $3 $4 $5 $6 $7 $8 $9)
  (absyn-stm.for (pos-of $1) $3 $5 $7 $9))

(define (jump-statement-1 $1 $2 $3)
  (absyn-stm.goto (pos-of $1) $2))

(define (jump-statement-2 $1 $2)
  (absyn-stm.continue (pos-of $1)))

(define (jump-statement-3 $1 $2)
  (absyn-stm.break (pos-of $1)))

(define (jump-statement-4 $1 $2 $3)
  (if (absyn-exp.nil? $2)
      (absyn-stm.return (pos-of $1))
      (absyn-stm.returnval (pos-of $1) $2)))

(define (opt-expression-1 $1)
  $1)

(define (opt-expression-2)
  (absyn-exp.nil))

(define (expression-1 $1)
  $1)

(define (expression-2 $1 $2 $3)
  (absyn-exp.seq (pos-of $1) $1 $3))
  
; assignment-expression -> conditional-expression fact-assignment-expr
;                        
(define (assignment-expression-1 $1 $2)
  ($2 $1))

(define (fact-assignment-expr-1 $1 $2)
  (lambda (lvalue-exp)
    ($1 lvalue-exp $2)))

(define (fact-assignment-expr-2)
  (lambda (x) x))

; assignment-operator -> t-assign
(define (assignment-operator-1 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.asgn (pos-of l-exp) l-exp r-exp)))

; assignment-operator -> t-assign-mult
(define (assignment-operator-2 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-mul r-exp)))

(define (assignment-operator-3 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-div r-exp)))

(define (assignment-operator-4 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-mod r-exp)))

(define (assignment-operator-5 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-add r-exp)))

(define (assignment-operator-6 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-sub r-exp)))

(define (assignment-operator-7 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-shift-left r-exp)))

(define (assignment-operator-8 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-shift-right r-exp)))

(define (assignment-operator-9 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-and r-exp)))

(define (assignment-operator-10 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-xor r-exp)))

(define (assignment-operator-11 $1)
  (lambda (l-exp r-exp)
    (absyn-exp.arithbin (pos-of l-exp) l-exp 'assign-or r-exp)))

; conditional-expression -> logical-or-expression
;
(define (conditional-expression-1 $1)
  $1)

; conditional-expression -> logical-or-expression t-question-mark expression t-colon conditional-expression
;
(define (conditional-expression-2 $1 $2 $3 $4 $5)
  (absyn-exp.cond (pos-of $1) $1 $3 $5))

(define (constant-expression-1 $1)
  $1)

; logical-or-expression -> logical-and-expression
;
(define (logical-or-expression-1 $1)
  $1)

; logical-or-expression -> logical-or-expression t-bool-or logical-and-expression
;                                                                                 -> absyn-exp.boolbin
(define (logical-or-expression-2 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'or $3))

; logical-and-expression -> inclusive-or-expression
;
(define (logical-and-expression-1 $1)
  $1)

; logical-and-expression -> logical-and-expression t-bool-and inclusive-or-expression
;                                                                                     -> absyn-exp.boolbin
(define (logical-and-expression-2 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'and $3))

; inclusive-or-expression -> exclusive-or-expression
;
(define (inclusive-or-expression-1 $1)
  $1)

; inclusive-or-expression -> inclusive-or-expression t-bit-or exclusive-or-expression
;                                                                                     -> absyn-exp.arithbin
(define (inclusive-or-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'or $3))

; exclusive-or-expression -> and-expression
;
(define (exclusive-or-expression-1 $1)
  $1)

; exclusive-or-expression -> exclusive-or-expression t-bit-xor and-expression
;                                                                             -> absyn-exp.arithbin
(define (exclusive-or-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'xor $3))

; and-expression -> equality-expression
;
(define (and-expression-1 $1)
  $1)

; and-expression -> and-expression t-bit-and equality-expression
;                                                                -> absyn-exp.arithbin
(define (and-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'and $3))

; equality-expression -> relational-expression
;
(define (equality-expression-1 $1)
  $1)

; equality-expression -> equality-expression t-equals relational-expression
;                                                                           -> absyn-exp.boolbin
(define (equality-expression-2 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'eq $3))

; equality-expression -> equality-expression t-not-equals relational-expression
;                                                                               -> absyn->exp.boolbin
(define (equality-expression-3 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'neq $3))

; relational-expression -> shift-expression
;
(define (relational-expression-1 $1)
  $1)

; relational-expression relational-expression t-less shift-expression
;                                                                     -> absyn->exp.boolbin
(define (relational-expression-2 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'less $3))

; relational-expression -> relational-expression t-greater shift-expression
;                                                                           -> absyn->exp.boolbin
(define (relational-expression-3 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'greater $3))

; relational-expression -> relational-expression t-less-equal shift-expression
;                                                                              -> absyn->exp.boolbin
(define (relational-expression-4 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'leq $3))

; relational-expression -> relational-expression t-greater-equal shift-expression
;                                                                                 -> absyn->exp.boolbin
(define (relational-expression-5 $1 $2 $3)
  (absyn-exp.boolbin (pos-of $1) $1 'geq $3))

; shift-expression -> additive-expression
;
(define (shift-expression-1 $1)
  $1)

; shift-expression -> shift-expression t-bit-shift-left additive-expression
;                                                                           -> absyn->exp.arithbin
(define (shift-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'shift-left $3))

; shift-expression -> shift-expression t-bit-shift-right additive-expression
;                                                                            -> absyn->exp.arithbin
(define (shift-expression-3 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'shift-right $3))

; additive-expression -> multiplicative-expression
;
(define (additive-expression-1 $1)
  $1)

; additive-expression -> additive-expression t-plus multiplicative-expression
;                                                                             -> absyn-exp.arithbin
(define (additive-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'add $3))

; additive-expression -> additive-expression t-minus multiplicative-expression
;                                                                              -> absyn-exp.arithbin
(define (additive-expression-3 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'sub $3))

; multiplicative-expression -> cast-expression
;
(define (multiplicative-expression-1 $1)
  $1)

; multiplicative-expression -> multiplicative-expression t-asterisk cast-expression
;                                                                                   -> absyn-exp.arithbin
(define (multiplicative-expression-2 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'mul $3))

; multiplicative-expression -> multiplicative-expression t-div cast-expression
;                                                                              -> absyn-exp.arithbin
(define (multiplicative-expression-3 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'div $3))

; multiplicative-expression -> multiplicative-expression t-mod cast-expression
;
(define (multiplicative-expression-4 $1 $2 $3)
  (absyn-exp.arithbin (pos-of $1) $1 'mod $3))

; cast-expression -> unary-expression
;
(define (cast-expression-1 $1)
  $1)

; cast-expression -> t-openpar type-name t-closedpar cast-expression
;                                                                    -> absyn-exp.cast
(define (cast-expression-2 $1 $2 $3 $4)
  (absyn-exp.cast (pos-of $1) $2 $4))

; unary-expression -> postfix-expression
;
(define (unary-expression-1 $1)
  $1)

; unary-expression -> t-increment unary-expression
;                                                  -> absyn-exp.seq
(define (unary-expression-2 $1 $2)
  (absyn-exp.arithbin (pos-of $1) (maybe-attribute-value $2) 'assign-add
		      (absyn-exp.const (pos-of $1)
				      (make-integral-literal "1" 1 #f #f))))

; unary-expression -> t-decrement unary-expression
;                                                  -> absyn-exp.seq
(define (unary-expression-3 $1 $2)
  (absyn-exp.arithbin (pos-of $1) (maybe-attribute-value $2) 'assign-sub
		      (absyn-exp.const (pos-of $1)
				      (make-integral-literal "1" 1 #f #f))))

; unary-expression -> unary-operator cast-expression
;
(define (unary-expression-4 $1 $2)
  ($1 $2))

; unary-expression -> t-sizeof unary-expression
;                                               -> absyn-exp.sizeof
(define (unary-expression-5 $1 $2)
  (absyn-exp.sizeof (pos-of $1) $2))

; unary-expression -> t-sizeof t-openpar type-name t-closedpar
;                                                              -> absyn-exp.sizeof
(define (unary-expression-6 $1 $2 $3 $4)
  (absyn-exp.sizeof (pos-of $1) $3))

; unary-operator -> t-bit-and
;                             -> absyn-exp.addr
(define (unary-operator-1 $1)
  (lambda (exp)
    (absyn-exp.addr (pos-of $1) exp)))

; unary-operator -> t-asterisk
;                              -> asyn-exp.deref
(define (unary-operator-2 $1)
  (lambda (exp)
    (absyn-exp.deref (pos-of $1) exp)))

; unary-operator -> t-plus
;                          -> (exp -> absyn-exp.arithun)
(define (unary-operator-3 $1)
  (lambda (exp)
    (absyn-exp.arithun (pos-of $1) 'plus exp)))

; unary-operator -> t-minus
;                           -> (exp -> absyn-exp.arithun)
(define (unary-operator-4 $1)
  (lambda (exp)
    (absyn-exp.arithun (pos-of $1) 'neg exp)))

; unary-operator -> t-bit-not
;                             -> (exp -> absyn-exp.arithun)
(define (unary-operator-5 $1)
  (lambda (exp)
    (absyn-exp.arithun (pos-of $1) 'complement exp)))

; unary-operator -> t-bool-not
;                              -> (exp -> absyn-exp.arithun)
(define (unary-operator-6 $1)
  (lambda (exp)
    (absyn-exp.boolun (pos-of $1) 'not exp)))

; postfix-expression -> primary-expression
;
(define (postfix-expression-1 $1)
  $1)

; postfix-expression -> postfix-expression t-openbracket expression t-closedbracket
;                                                                                   -> absyn-exp.deref
(define (postfix-expression-2 $1 $2 $3 $4)
  (absyn-exp.deref (pos-of $1) (absyn-exp.arithbin (pos-of $1) $1 'add $3)))

; postfix-expression -> postfix-expression t-openpar t-closedpar
;                                                                -> absyn-exp.call
(define (postfix-expression-3 $1 $2 $3)
  (absyn-exp.call (pos-of $1) $1 '()))

; postfix-expression -> postfix-expression t-openpar argument-expression-list t-closedpar
;                                                                                         -> absyn-exp.call
(define (postfix-expression-4 $1 $2 $3 $4)
  (absyn-exp.call (pos-of $1) $1 $3))

; postfix-expression -> postfix-expression t-point t-identifier
;                                                               -> absyn-exp.struct-access
(define (postfix-expression-5 $1 $2 $3)
  (absyn-exp.struct-access (pos-of $1) $1 (attribute-value $3)))

; postfix-expression -> postfix-expression t-pointer-struct-access t-identifier
;                                                                               -> absyn-exp.struct-access
(define (postfix-expression-6 $1 $2 $3)
  (absyn-exp.struct-access (pos-of $1)
			   (absyn-exp.deref (pos-of $2) $1)
			   (attribute-value $3)))

; postfix-expression -> postfix-expression t-increment
;                                                      -> absyn-exp.post-inc
(define (postfix-expression-7 $1 $2)
  (absyn-exp.post-inc (pos-of $1) (maybe-attribute-value $1)))

; postfix-expression -> postfix-expression t-decrement
;                                                      -> absyn-exp.post-dec
(define (postfix-expression-8 $1 $2)
  (absyn-exp.post-dec (pos-of $1) (maybe-attribute-value $1)))

; primary-expression -> t-identifier
;                                    -> absyn-exp.var
(define (primary-expression-1 $1)
  (absyn-exp.var (pos-of $1) (attribute-value $1)))

; primary-expression -> constant
;                                ->
(define (primary-expression-2 $1)
  $1)

; primary-expression -> t-literal-string
;                                        -> absyn-exp.const
(define (primary-expression-3 $1)
  (absyn-exp.const (pos-of $1) (attribute-value $1)))

; primary-expression -> t-openpar expression t-closedpar
;                                                        ->
(define (primary-expression-4 $1 $2 $3)
  $2)

; primary-expression -> t-openpar $error t-closedpar
(define (primary-expression-5 $1 $2 $3)
  (error "primary-expression-5: syntax-error"))

; argument-expression-list -> assignment-expression
;                                                   -> (???)
(define (argument-expression-list-1 $1)
  (list $1))

; argument-expression-list -> argument-expression-list t-comma assignment-expression
;                                                                                    -> (???)
(define (argument-expression-list-2 $1 $2 $3)
  (append $1 (list $3)))

; constant -> integral-constant
;             :integral-literal -> absyn-exp.const
(define (constant-1 $1)
  (absyn-exp.const (pos-of $1) (attribute-value $1)))

; constant -> t-character-constant
;              t-character-constant -> absyn-exp.const t-character-constant
;; FIXME: make own type for char consts to cope with '\a'
(define (constant-2 $1)
  (if (= (string-length (attribute-value $1)) 1)
      (absyn-exp.const
       (pos-of $1)
       (car (string->list (attribute-value $1))))
      (error "constant-2: multibyte character constant are not ANSI")))

; constant -> t-floating-constant
;              t-floating-constant -> absyn-exp.const floating-constant
(define (constant-3 $1)
  (absyn-exp.const (pos-of $1) (maybe-attribute-value $1)))