;;; erlang.by -- LL grammar for Erlang language specification
;;
;; Copyright (C) 2002, 2003 Vladimir G. Sekissov
;; Copyright (C) 2003 David Ponce
;;
;; Author: Vladimir G. Sekissov <svg@surnet.ru>
;;         David Ponce <david@dponce.com>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; $Id: erlang.by,v 1.1 2007-11-26 15:11:52 michaels Exp $
;;

%package semantic-erlang-by

%start         module-decl
%languagemode  erlang-mode

;;; Keywords
;;
%token BEGIN       "begin"
%token END         "end"
%token CASE        "case"
%token OF          "of"
%token IF          "if"
%token WHEN        "when"
%token TRUE        "true"
%token RECEIVE     "receive"
%token AFTER       "after"
%token OR          "or"
%token ORELSE      "orelse"
%token XOR         "xor"
%token BOR         "bor"
%token BXOR        "bxor"
%token BSL         "bsl"
%token BSR         "bsr"
%token DIV         "div"
%token REM         "rem"
%token BAND        "band"
%token AND         "and"
%token ANDALSO     "andalso"
%token BNOT        "bnot"
%token NOT         "not"
%token CATCH       "catch"
%token FUN         "fun"
%token QUERY       "query"
%token LET         "let"
%token MODULE      "module"
%token INCLUDE     "include"
%token INCLUDE_LIB "include_lib"
%token BEHAVIOUR   "behaviour"
%token DEFINE      "define"
%token UNDEF       "undef"
%token IFDEF       "ifdef"
%token IFNDEF      "ifndef"
%token ELSE        "else"
%token ENDIF       "endif"
%token EXPORT      "export"
%token IMPORT      "import"
%token RECORD      "record"
%token SIGNED      "signed"
%token UNSIGNED    "unsigned"


;;; Punctuations
;;
%token <punctuation> HASH      "\\`[#]\\'"
%token <punctuation> PERIOD    "\\`[.]\\'"
%token <punctuation> COLON     "\\`[:]\\'"
%token <punctuation> SEMICOLON "\\`[;]\\'"
%token <punctuation> STAR      "\\`[*]\\'"
%token <punctuation> AMPERSAND "\\`[&]\\'"
%token <punctuation> DIVIDE    "\\`[/]\\'"
%token <punctuation> PLUS      "\\`[+]\\'"
%token <punctuation> MINUS     "\\`[-]\\'"
%token <punctuation> BANG      "\\`[!]\\'"
%token <punctuation> WHY       "\\`[?]\\'"
%token <punctuation> EQUAL     "\\`[=]\\'"
%token <punctuation> LESS      "\\`[<]\\'"
%token <punctuation> GREATER   "\\`[>]\\'"
%token <punctuation> COMA      "\\`[,]\\'"
%token <punctuation> VDEL      "\\`[|]\\'"
%token <punctuation> SIGN      "[-+]"
;; %token <charquote>   DOLLAR    "$"

;;; Symbol literals
;;
%token <symbol> ATOM1    "[a-z][a-zA-Z0-9_@]*"
%token <symbol> ATOM2    "'.+'"
%token <symbol> DIGITS   "[0-9]+"
%token <symbol> EE       "[eE]"
%token <symbol> INT1     "[0-9a-eA-E]+"
%token <symbol> INT2     "[0-9]\\{1,2\\}"
%token <symbol> VAR1     "^_[a-zA-Z0-9]+"
%token <symbol> VAR2     "^[A-Z][_a-zA-Z0-9]*"
%token <symbol> USCORE   "_"
;; binary tokens
%token <symbol> FILE     "file"
%token <symbol> INTEGER  "integer"
%token <symbol> FLOAT    "float"
%token <symbol> BINARY   "binary"
%token <symbol> BIG      "big"
%token <symbol> LITTLE   "little"
%token <symbol> NATIVE   "native"
%token <symbol> UNIT     "unit"


;;; Blocks
;;
%token <semantic-list> PAREN_BLCK "^("
%token <semantic-list> BRACK_BLCK "^\\["
%token <semantic-list> BRACE_BLCK "^{"

;;; Parenthesis
;;
%token <open-paren>    LPAREN "("
%token <close-paren>   RPAREN ")"
%token <open-paren>    LBRACE "{"
%token <close-paren>   RBRACE "}"

%%

add-op
  : PLUS
  | MINUS
  | BOR
  | BXOR
  | BSL
  | BSR
  ;

list-conc-op
  : PLUS PLUS
  | MINUS MINUS
  ;

comp-op
  : EQUAL EQUAL
    ( "==" )
  | EQUAL COLON EQUAL
    ( "=:=" )
  | EQUAL DIVIDE EQUAL
    ( "=/=" )
  | DIVIDE EQUAL
    ( "/=" )
  | EQUAL LESS
    ( "=<" )
  | GREATER EQUAL
    ( ">=" )
  | LESS
  | GREATER
  | OR
  | ORELSE
  | XOR
  | AND
  | ANDALSO
  ;

multi-op
  : STAR
  | DIVIDE
  | DIV
  | REM
  | BAND
  ;

prefix-op
  : PLUS
  | MINUS
  | BNOT
  | NOT
  ;

basic-type
  : float-literal
  | integer-literal
  | char-literal
  | atom
  | var
  | string
  | TRUE
  ;

atom
  : ATOM1
    ( $1 )
  | ATOM2
    ( $1 )
  ;

float-literal
  : DIGITS PERIOD DIGITS exp-part
  | PERIOD DIGITS exp-part
  ;

exp-part
  : EE SIGN DIGITS
  | EE DIGITS
  | ;;EMPTY
  ;

integer-literal
  : INT1
  | INT2 HASH INT1
  ;

char-literal
  : CHAR
  ;

var
  : VAR1
 ;;($1 variable nil nil nil nil)
    (VARIABLE-TAG $1 nil nil)
  | VAR2
 ;;($1 variable nil nil nil nil)
    (VARIABLE-TAG $1 nil nil)
  ;

uni-pattern
  : USCORE
  ;

binary
  : LESS LESS GREATER GREATER
 ;;( "<<>>" binary nil nil )
    (TAG "<<>>" 'binary)
  | LESS LESS binary-segments GREATER GREATER
 ;;( "<<Binary>>" binary nil nil)
    (TAG "<<Binary>>" 'binary)
  ;

binary-segments
  : binary-segment binary-segments-rest
  ;

binary-segments-rest
  : COMA binary-segments
    ( ,$2 )
  | ;;EMPTY
  ;

binary-segment
  : basic-type binary-segment-rest
  | clause-pattern binary-segment-rest
  ;

;; binary-segment-rest
;;   : COLON integer-literal DIVIDE basic-type
;;   | COLON basic-type
;;   | DIVIDE basic-type
;;   | ;;EMPTY
;;   ;

binary-segment-rest
  : COLON basic-type DIVIDE binary-type-spec-list
  | COLON basic-type
  | DIVIDE binary-type-spec-list
  | ;;EMPTY
  ;

;; addition by david wallin [david.wallin@ul.ie]

binary-type
  : INTEGER
  | FLOAT
  | BINARY
  ;

binary-signed
  : SIGNED
  | UNSIGNED
  ;

binary-endian
  : BIG
  | LITTLE
  | NATIVE
  ;

binary-unit
  : UNIT COLON basic-type
  ;

binary-type-spec
  : binary-type 
  | binary-signed 
  | binary-endian 
  | binary-unit
  ;

binary-type-spec-list
  : binary-type-spec MINUS binary-type-spec-list
  | binary-type-spec
  ;

;; end addition

module-decl
  : module-attr
  | function-decl
  | header-form
  | directive
  | file-attr
  ;

module-attr
  : MINUS MODULE PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 module-attr-name)) package nil nil )
    (PACKAGE-TAG (car (EXPAND $3 module-attr-name)) nil)
  ;

module-attr-name
  : LPAREN module-name RPAREN
    ( (car $2) )
  ;

module-name
  : atom module-name-rest
    ( (concat (car $1) (car $2)) )
  | module-name-rest
    ( (car $1) )
  ;

module-name-rest
  : PERIOD atom module-name-rest
    ( (concat $1 (car $2) (car $3)) )
  | ;;EMPTY
    ( nil )
  ;

header-form
  : header-attr
  | anywhere-attr
  ;

header-attr
  : export-attr
  | import-attr
  | compile-attr
  | whild-attr
  ;

anywhere-attr
  : file-attr
  | macro-def
  | record-decl
  ;

export-attr
  : MINUS EXPORT PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 export-name-list)) export nil nil )
  ;

export-name-list
  : open-paren BRACK_BLCK close-paren
 ;; ( (car (EXPAND $2 function-name-list)) )
  ;

import-attr
  : MINUS IMPORT PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 import-name-list)) import nil nil )
    (TAG (car (EXPAND $3 import-name-list)) 'import)
  ;

import-name-list
  : open-paren module-name COMA BRACK_BLCK close-paren
    ( ,$2 (EXPAND $4 function-name-list))
  | open-paren module-name close-paren
    ( ,$2 )
  ;

function-name-list
  : open-paren close-paren
    ( nil )
  | open-paren function-names close-paren
    ( $2 )
  ;

function-names
  : function-arity COMA function-names
    ( $1  $3 )
  | function-arity
    ( $1 )
  ;

function-arity
  : atom DIVIDE integer-literal
    ( ,$1 $2 ,$3 )
  ;

compile-attr
  : MINUS COMPILE PAREN_BLCK full-stop
 ;;( $3 compile nil nil )
  ;

file-attr
  : MINUS FILE PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 file-attr-list)) file nil nil )
  ;

file-attr-list
  : open-paren string COMA integer-literal close-paren
    ( (cons (read $2) ,$4) )
  ;

whild-attr
  : MINUS atom PAREN_BLCK full-stop
 ;; ( $3 (read (car $2)) nil nil )
  ;

function-decl
  : function-clauses full-stop
    ( ,$1 )
  ;

function-clauses
  : function-clause function-clauses-rest
    ( ,$1 )
  ;

function-clauses-rest
  : SEMICOLON function-clauses
  | ;;EMPTY
  ;

function-clause
  : atom fun-clause
 ;;\( (concat (car $1) "/" (number-to-string (length (car $2))))
 ;;  function nil ,$2 nil nil)
    (FUNCTION-TAG
     (concat (car $1) "/" (number-to-string (length (car $2))))
     nil ,$2)
  ;

record-decl
  : MINUS RECORD PAREN_BLCK full-stop
    ( ,(car (EXPANDFULL $3 record-def)) )
  ;

record-def
  : open-paren atom COMA BRACE_BLCK close-paren
 ;;(,$2 type "record" (EXPANDFULL $4 record-field-decl) nil nil)
    (TYPE-TAG ,$2 "record" (EXPANDFULL $4 record-field-decl) nil)
  ;

record-decl-tuple
  : open-paren record-field-decls close-paren
    ( $2 )
  | open-paren close-paren
    ( nil )
  ;

record-field-decl
  : atom record-field-value
 ;;( ,$1 variable nil "" () nil)
    (VARIABLE-TAG ,$1 nil "")
  | atom
 ;;( ,$1 variable nil "" () nil)
    (VARIABLE-TAG ,$1 nil "")
  | LBRACE
    ( nil )
  | RBRACE
    ( nil )
  | COMA
    ( nil )
  ;

pattern
  : pattern-expr
    ( ,$1 )
  | uni-pattern
  | binary
  | basic-type
  | BRACK_BLCK
 ;;( "List" list nil nil )
    (TAG "List" 'list)
 ;; ( (EXPAND $1 list-pattern ) )
  | BRACE_BLCK
 ;;( "Tuple" tuple nil nil )
    (TAG "Tuple" 'list)
 ;; ( (EXPAND $1 tuple-pattern) )
  | record-pattern
    ( ,$1 )
  ;

pattern-expr
  : pattern-conc-expr pattern-conc-expr-rest
    ( ,$1 )
  ;

pattern-conc-expr
  : string-literal
  | var
  ;

pattern-conc-expr-rest
  : list-conc-op pattern-expr
    ( )
  | ;;EMPTY
  ;

tuple-pattern
  : open-paren patterns close-paren
  | open-paren close-paren
    ( nil )
  ;

list-pattern
  : open-paren patterns list-pattern-tail close-paren
  | open-paren close-paren
    ( nil )
  ;

list-pattern-tail
  : VDEL pattern
  | ;;EMPTY
    ( nil )
  ;

patterns
  : pattern patterns-rest
    ((cons (car $1) (car $2)))
  ;

patterns-rest
  : COMA patterns
    ( ,$2 )
  | ;;EMPTY
  ;

record-pattern
  : HASH atom BRACE_BLCK
    ( (car $2) )
 ;; ( (cons $2 (EXPAND $3 record-pattern-tuple) ) )
  ;

record-pattern-tuple
  : open-paren record-field-patterns close-paren
    ( $2 )
  | open-paren close-paren
    ( nil )
  ;

record-field-patterns
  : record-field-patterns COMA record-field-pattern
  | record-field-pattern
  ;

record-field-pattern
  : atom EQUAL pattern
  ;

body
  : exprs
  ;

exprs
  : expr exprs-rest
  ;

exprs-rest
  : COMA exprs
  | ;;EMPTY
  ;

expr
  : CATCH expr
  | match-expr
  ;

match-expr
  : pattern EQUAL match-expr
  | send-expr
  ;

send-expr
  : compare-expr send-expr-rest
  ;

send-expr-rest
  : BANG send-expr
  | ;;EMPTY
  ;

compare-expr
  : list-conc-expr compare-expr-rest
  ;

compare-expr-rest
  : comp-op list-conc-expr
  | ;;EMPTY
  ;

list-conc-expr
  : add-expr list-conc-expr-rest
  ;

list-conc-expr-rest
  : list-conc-op list-conc-expr
  | ;;EMPTY
  ;

add-expr
  : multi-expr add-expr-rest
  ;

add-expr-rest
  : add-op add-expr
  | ;;EMPTY
  ;

multi-expr
  : prefix-expr multi-expr-rest
  ;

multi-expr-rest
  : multi-op multi-expr
  | ;;EMPTY
  ;

prefix-expr
  : prefix-op record-expr
  | record-expr
  ;

record-expr
  : HASH record-expr-field
  | application-expr record-expr-rest
  ;

record-expr-rest
  : HASH record-expr-field
  | ;;EMPTY
  ;

record-expr-field
  : atom PERIOD atom
  | atom BRACE_BLCK
 ;; ( $1 (EXPAND $3 record-update-tuple) )
  | record-expr
  ;

record-update-tuple
  : open-paren close-paren
  | open-paren record-field-updates close-paren
  ;

record-field-updates
  : record-field-update record-field-updates-rest
  ;

record-field-updates-rest
  : COMA record-field-updates
  | ;;EMPTY
  ;

record-field-update
  : atom record-field-value
  ;

record-field-value
  : EQUAL expr
  | ;;EMPTY
  ;

application-expr
  : module-name COLON primary-expr PAREN_BLCK
  | primary-expr application-expr-rest
  ;

application-expr-rest
  : PAREN_BLCK
 ;;( (EXPAND $1 application-expr-list) )
  | COLON primary-expr PAREN_BLCK
 ;;( $1 $2 (EXPAND $3 application-expr-list) )
  | ;;EMPTY
  ;

application-expr-list
  : open-paren close-paren
  | open-paren exprs close-paren
  ;

primary-expr
  : binary
  | string-literal
  | basic-type
 ;;| module-name
  | BRACE_BLCK
 ;;  ( (EXPAND $1 tuple-skel) )
  | BRACK_BLCK
 ;;  ( (EXPAND $1 list-skel) )
  | BRACK_BLCK
 ;;  ( (EXPAND $1 list-compr) )
  | block-expr
  | if-expr
  | case-expr
  | receive-expr
  | fun-expr
  | query-expr
  | paren-expr
  ;

string-literal
  : string
  | macro-app
  | string string-literal
  ;

tuple-skel
  : open-paren close-paren
  | open-paren exprs close-paren
  ;

list-skel
  : open-paren close-paren
  | open-paren exprs list-skel-tail close-paren
  ;

list-skel-tail
  : VDEL expr
  | ;;EMPTY
  ;

list-compr
  : open-paren expr VDEL VDEL list-compr-exprs close-paren
  ;

list-compr-exprs
  : list-compr-expr list-compr-exprs-rest
  ;

list-compr-exprs-rest
  : COMA list-compr-exprs
  | ;;EMPTY
  ;

list-compr-expr
  : generator
  | filter
  ;

generator
  : pattern LESS MINUS expr
  ;

filter
  : expr
  ;

block-expr
  : BEGIN body END
  ;

if-expr
  : IF if-clauses END
  ;

if-clauses
  : if-clause SEMICOLON if-clauses
  | if-clause
  ;

if-clause
  : guard clause-body
  | expr clause-body
  ;

clause-body
  : MINUS GREATER body
  ;

case-expr
  : CASE expr OF cr-clauses END
  ;

cr-clauses
  : cr-clause SEMICOLON cr-clauses
  | cr-clause
  ;

cr-clause
  : clause-pattern clause-guard clause-body
  ;

clause-guard
  : WHEN guard
  | ;;EMPTY
  ;

receive-expr
  : RECEIVE cr-clauses receive-after END
  | RECEIVE receive-after END
  | RECEIVE cr-clauses AFTER expr clause-body END
  ;

receive-after
  : AFTER expr clause-body
  | ;;EMPTY
  ;

fun-expr
  : FUN function-arity
  | FUN fun-clauses END
  ;

fun-clauses
  : fun-clause fun-clauses-rest
  ;

fun-clauses-rest
  : SEMICOLON fun-clauses
  | ;;EMPTY
  ;

fun-clause
  : PAREN_BLCK clause-guard clause-body
    ( ,(car (EXPAND $1 clause-pattern-list)) )
  ;

clause-pattern-list
  : open-paren clause-patterns close-paren
    ( $2 )
  ;

clause-patterns
  : clause-pattern clause-patterns-rest
    ((cons (car $1) (car $2)))
  ;

clause-patterns-rest
  : COMA clause-patterns
    ( ,$2 )
  | ;;EMPTY
  ;

clause-pattern
  : match-pattern
  | pattern
  ;

match-pattern
  : var EQUAL pattern
    ( ,$1 )
  | pattern EQUAL var
    ( ,$1 )
  ;

query-expr
  : QUERY BRACK_BLCK END
 ;; ( $1 (EXPAND $2 list-compr) $3)
  ;

paren-expr
  : PAREN_BLCK
 ;;  ( ,(EXPAND $1 paren-expr-list) )
  ;

paren-expr-list
  : open-paren expr close-paren
  ;

guard
  : guard-test guard-rest
  ;

guard-rest
  : COMA guard
  | SEMICOLON guard
  | ;;EMPTY
  ;

guard-test
  : TRUE
  | guard-record-test
  | guard-term-cmp
  | guard-recognizer
  | PAREN_BLCK
 ;;  ( (EXPAND $1 paren-guard-test) )
  ;

guard-record-test
  : RECORD PAREN_BLCK
 ;;  ( ,(EXPAND $2 guard-record-test) )
  | open-paren guard-expr COMA symbol close-paren
  ;

guard-recognizer
  : symbol PAREN_BLCK
 ;;  ( ,(cons $1 ,(EXPAND $2 guard-expr) ) )
  ;

guard-term-cmp
  : guard-expr guard-term-op guard-expr
  ;

guard-term-op
  : comp-op
  | EQUAL
  ;

paren-guard-test
  : open-paren guard-test close-paren
  ;

guard-expr
  : guard-add-expr
  ;

guard-add-expr
  : guard-multi-expr guard-add-expr-rest
  ;

guard-add-expr-rest
  : add-op guard-add-expr
  | ;;EMPTY
  ;

guard-multi-expr
  : guard-prefix-expr guard-multi-expr-rest
  ;

guard-multi-expr-rest
  : multi-op guard-multi-expr
  | ;;EMPTY
  ;

guard-prefix-expr
  : prefix-op guard-application-expr
  | guard-application-expr
  ;

guard-application-expr
  : atom PAREN_BLCK
 ;;  ( (cons $1 (EXPAND $2 guard-exprs-list) ) )
  | guard-record-expr
  | guard-primary-expr
  ;

guard-exprs-list
  : open-paren close-paren
  | open-paren guard-exprs close-paren
  ;

guard-exprs
  : guard-expr guard-exprs-rest
  ;

guard-exprs-rest
  : COMA guard-exprs
  | SEMICOLON guard-exprs
  | ;;EMPTY
  ;

guard-record-expr
  : HASH atom PERIOD atom
  | guard-primary-expr HASH atom PERIOD atom
  ;

guard-primary-expr
  : basic-type
  | macro-app
  | BRACE_BLCK
 ;;  ( ,(EXPAND $1 guard-tuple-skel) )
  | BRACK_BLCK
 ;;  ( ,(EXPAND $1 guard-list-skel) )
  | PAREN_BLCK
 ;;  ( ,(EXPAND $1 guard-paren-expr) )
  ;

guard-tuple-skel
  : open-paren close-paren
  | open-paren guard-exprs close-paren
  ;

guard-list-skel
  : open-paren close-paren
  | open-paren guard-exprs guard-list-skel-tail close-paren
  ;

guard-list-skel-tail
  : VDEL guard-expr
  | ;;EMPTY
  ;

guard-paren-expr
  : open-paren guard-expr close-paren
  ;

directive
  : macro-def
  | macro-undef
  | include-dir
  | include-lib-dir
  | ifdef-dir
  | ifndef-dir
  | else-dir
  | endif-dir
  ;

macro-def
  : MINUS DEFINE PAREN_BLCK full-stop
    ( ,(EXPAND $3 macro-def-list) )
  ;

macro-def-list
  : open-paren symbol macro-def-opt COMA macro-def-opt close-paren
 ;;( $2 variable nil $5 (ASSOC const t) nil)
    (VARIABLE-TAG $2 nil $5 :constant-flag t)
  ;

macro-def-opt
  : semantic-list
  | expr
  | ;;EMPTY
  ;

macro-undef
  : MINUS UNDEF PAREN_BLCK full-stop
  ;

macro-app
  : WHY symbol PAREN_BLCK
  | WHY symbol
  ;

include-dir
  : MINUS INCLUDE PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 include-file-name)) include nil nil )
    (INCLUDE-TAG (car (EXPAND $3 include-file-name)) nil)
  ;

include-lib-dir
  : MINUS INCLUDE_LIB PAREN_BLCK full-stop
 ;;( (car (EXPAND $3 include-file-name)) include nil nil )
    (INCLUDE-TAG (car (EXPAND $3 include-file-name)) nil)
  ;

include-file-name
  : open-paren string close-paren
    ( (read $2) )
  ;

ifdef-dir
  : MINUS IFDEF PAREN_BLCK full-stop
 ;;( ,(EXPAND $3 macro-name) )
  ;

ifndef-dir
  : MINUS IFNDEF PAREN_BLCK full-stop
 ;;( ,(EXPAND $3 macro-name) )
  ;

else-dir
  : MINUS ELSE full-stop
  ;

endif-dir
  : MINUS ENDIF full-stop
  ;

full-stop
  : PERIOD
  ;

;;; erlang.by ends here