gf-core/src/Transfer/Core/Par.y

-- This Happy file was machine-generated by the BNF converter
{
{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
module Transfer.Core.Par where
import Transfer.Core.Abs
import Transfer.Core.Lex
import Transfer.ErrM
}

%name pModule Module
%name pExp Exp

-- no lexer declaration
%monad { Err } { thenM } { returnM }
%tokentype { Token }

%token 
 ';' { PT _ (TS ";") }
 ':' { PT _ (TS ":") }
 '{' { PT _ (TS "{") }
 '}' { PT _ (TS "}") }
 '=' { PT _ (TS "=") }
 '(' { PT _ (TS "(") }
 ')' { PT _ (TS ")") }
 '_' { PT _ (TS "_") }
 '|' { PT _ (TS "|") }
 '->' { PT _ (TS "->") }
 '\\' { PT _ (TS "\\") }
 '.' { PT _ (TS ".") }
 'Type' { PT _ (TS "Type") }
 'case' { PT _ (TS "case") }
 'data' { PT _ (TS "data") }
 'in' { PT _ (TS "in") }
 'let' { PT _ (TS "let") }
 'of' { PT _ (TS "of") }
 'rec' { PT _ (TS "rec") }
 'sig' { PT _ (TS "sig") }
 'where' { PT _ (TS "where") }

L_quoted { PT _ (TL $$) }
L_integ  { PT _ (TI $$) }
L_doubl  { PT _ (TD $$) }
L_TMeta { PT _ (T_TMeta $$) }
L_CIdent { PT _ (T_CIdent $$) }
L_err    { _ }


%%

String  :: { String }  : L_quoted { $1 }
Integer :: { Integer } : L_integ  { (read $1) :: Integer }
Double  :: { Double }  : L_doubl  { (read $1) :: Double }
TMeta    :: { TMeta} : L_TMeta { TMeta ($1)}
CIdent    :: { CIdent} : L_CIdent { CIdent ($1)}

Module :: { Module }
Module : ListDecl { Module $1 } 


ListDecl :: { [Decl] }
ListDecl : {- empty -} { [] } 
  | Decl { (:[]) $1 }
  | Decl ';' ListDecl { (:) $1 $3 }


Decl :: { Decl }
Decl : 'data' CIdent ':' Exp 'where' '{' ListConsDecl '}' { DataDecl $2 $4 $7 } 
  | CIdent ':' Exp { TypeDecl $1 $3 }
  | CIdent '=' Exp { ValueDecl $1 $3 }


ConsDecl :: { ConsDecl }
ConsDecl : CIdent ':' Exp { ConsDecl $1 $3 } 


ListConsDecl :: { [ConsDecl] }
ListConsDecl : {- empty -} { [] } 
  | ConsDecl { (:[]) $1 }
  | ConsDecl ';' ListConsDecl { (:) $1 $3 }


ListPattern :: { [Pattern] }
ListPattern : {- empty -} { [] } 
  | ListPattern Pattern { flip (:) $1 $2 }


Pattern :: { Pattern }
Pattern : '(' CIdent ListPattern ')' { PCons $2 (reverse $3) } 
  | PatternVariable { PVar $1 }
  | 'rec' '{' ListFieldPattern '}' { PRec $3 }
  | String { PStr $1 }
  | Integer { PInt $1 }


FieldPattern :: { FieldPattern }
FieldPattern : CIdent '=' Pattern { FieldPattern $1 $3 } 


ListFieldPattern :: { [FieldPattern] }
ListFieldPattern : {- empty -} { [] } 
  | FieldPattern { (:[]) $1 }
  | FieldPattern ';' ListFieldPattern { (:) $1 $3 }


PatternVariable :: { PatternVariable }
PatternVariable : CIdent { PVVar $1 } 
  | '_' { PVWild }


Exp :: { Exp }
Exp : 'let' '{' ListLetDef '}' 'in' Exp { ELet $3 $6 } 
  | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
  | Exp1 { $1 }


LetDef :: { LetDef }
LetDef : CIdent '=' Exp { LetDef $1 $3 } 


ListLetDef :: { [LetDef] }
ListLetDef : {- empty -} { [] } 
  | LetDef { (:[]) $1 }
  | LetDef ';' ListLetDef { (:) $1 $3 }


Case :: { Case }
Case : Pattern '|' Exp '->' Exp { Case $1 $3 $5 } 


ListCase :: { [Case] }
ListCase : {- empty -} { [] } 
  | Case { (:[]) $1 }
  | Case ';' ListCase { (:) $1 $3 }


Exp1 :: { Exp }
Exp1 : '\\' PatternVariable '->' Exp { EAbs $2 $4 } 
  | '(' PatternVariable ':' Exp ')' '->' Exp { EPi $2 $4 $7 }
  | Exp2 { $1 }


Exp3 :: { Exp }
Exp3 : Exp3 Exp4 { EApp $1 $2 } 
  | Exp4 { $1 }


Exp4 :: { Exp }
Exp4 : Exp4 '.' CIdent { EProj $1 $3 } 
  | Exp5 { $1 }


Exp5 :: { Exp }
Exp5 : 'sig' '{' ListFieldType '}' { ERecType $3 } 
  | 'rec' '{' ListFieldValue '}' { ERec $3 }
  | CIdent { EVar $1 }
  | 'Type' { EType }
  | String { EStr $1 }
  | Integer { EInteger $1 }
  | Double { EDouble $1 }
  | TMeta { EMeta $1 }
  | '(' Exp ')' { $2 }


FieldType :: { FieldType }
FieldType : CIdent ':' Exp { FieldType $1 $3 } 


ListFieldType :: { [FieldType] }
ListFieldType : {- empty -} { [] } 
  | FieldType { (:[]) $1 }
  | FieldType ';' ListFieldType { (:) $1 $3 }


FieldValue :: { FieldValue }
FieldValue : CIdent '=' Exp { FieldValue $1 $3 } 


ListFieldValue :: { [FieldValue] }
ListFieldValue : {- empty -} { [] } 
  | FieldValue { (:[]) $1 }
  | FieldValue ';' ListFieldValue { (:) $1 $3 }


Exp2 :: { Exp }
Exp2 : Exp3 { $1 } 



{

returnM :: a -> Err a
returnM = return

thenM :: Err a -> (a -> Err b) -> Err b
thenM = (>>=)

happyError :: [Token] -> Err a
happyError ts =
  Bad $ "syntax error at " ++ tokenPos ts ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts)))

myLexer = tokens
}