; -*- Hen -*-

(require-extension lalr)

(define expr-parser
  (lalr-parser

   (output:    expr-parser "expr.grm.scm")

   ;; --- token definitions
   ( NUM ID LET IF THEN ELSE LPAREN RPAREN 
         (left: + -)
         (left: * /)
         (right: QUESTION COLON ) 
         (left: < > = <= >= ==)
         (left: uminus)
         (right: ^) 
         (left: COMMA)
         )


   (expr     (NUM)                    : (exact->inexact $1)
             (ID)                     : $1
	     (ID LPAREN RPAREN)       : `(,$1)
	     (ID LPAREN arglist RPAREN)  : `(,$1 . ,(reverse $3))
	     (expr + expr)            : `(+ ,$1 ,$3)
             (expr - expr)            : `(- ,$1 ,$3)
             (expr * expr)            : `(* ,$1 ,$3)
             (expr / expr)            : `(/ ,$1 ,$3)
             (- expr (prec: uminus))  : `(neg ,$2)
             (expr ^ expr)            : `(pow ,$1 ,$3)
	     (LPAREN expr RPAREN)     : $2 
	     (expr > expr)            : `(> ,$1 ,$3)
	     (expr < expr)            : `(< ,$1 ,$3)
	     (expr < = expr)          : `(<= ,$1 ,$4)
	     (expr > = expr)          : `(>= ,$1 ,$4)
	     (expr <= expr)           : `(<= ,$1 ,$3)
	     (expr >= expr)           : `(>= ,$1 ,$3)
	     (expr == expr)           : `(== ,$1 ,$3)
	     (expr = = expr)          : `(== ,$1 ,$3)
	     (LET LPAREN bnds RPAREN expr)   :  `(let ,(reverse $3) ,$5)
	     (IF  expr THEN expr ELSE expr)  :  `(if ,$2 ,$4 ,$6) 
	     )

   (arglist  (expr)                   : (list $1)
             (arglist COMMA expr)     : (cons $3 $1))

   (bnds     (binding)                : (list $1)
             (bnds binding)           : (cons $2 $1))

   (binding  (LPAREN ID = expr RPAREN)  : (list $2 $3))

  ))