language-lua-0.9.0: src/Language/Lua/Annotated/Parser.y
{
module Language.Lua.Annotated.Parser
( parseText
, parseNamedText
, parseFile
, Parser
, chunk
, exp
, stat
) where
import Control.Monad (liftM,ap)
import Prelude hiding (LT,GT,EQ,exp)
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Language.Lua.Token (Token(..))
import Language.Lua.Annotated.Lexer (SourcePos(..), LexToken(..), llexNamed)
import Language.Lua.Annotated.Syntax
}
%tokentype { LexToken SourcePos }
%token
'+' { LexToken { ltokToken = TokPlus } }
'-' { LexToken { ltokToken = TokMinus } }
'*' { LexToken { ltokToken = TokStar } }
'/' { LexToken { ltokToken = TokSlash } }
'//' { LexToken { ltokToken = TokDSlash } }
'%' { LexToken { ltokToken = TokPercent } }
'^' { LexToken { ltokToken = TokExp } }
'#' { LexToken { ltokToken = TokSh } }
'==' { LexToken { ltokToken = TokEqual } }
'~=' { LexToken { ltokToken = TokNotequal } }
'<=' { LexToken { ltokToken = TokLEq } }
'>=' { LexToken { ltokToken = TokGEq } }
'<' { LexToken { ltokToken = TokLT } }
'>' { LexToken { ltokToken = TokGT } }
'&' { LexToken { ltokToken = TokAmpersand } }
'~' { LexToken { ltokToken = TokTilde } }
'|' { LexToken { ltokToken = TokPipe } }
'>>' { LexToken { ltokToken = TokDGT } }
'<<' { LexToken { ltokToken = TokDLT } }
'=' { LexToken { ltokToken = TokAssign } }
'(' { LexToken { ltokToken = TokLParen } }
')' { LexToken { ltokToken = TokRParen } }
'{' { LexToken { ltokToken = TokLBrace } }
'}' { LexToken { ltokToken = TokRBrace } }
'[' { LexToken { ltokToken = TokLBracket } }
']' { LexToken { ltokToken = TokRBracket } }
'::' { LexToken { ltokToken = TokDColon } }
';' { LexToken { ltokToken = TokSemic } }
':' { LexToken { ltokToken = TokColon } }
',' { LexToken { ltokToken = TokComma } }
'.' { LexToken { ltokToken = TokDot } }
'..' { LexToken { ltokToken = TokDDot } }
'...' { LexToken { ltokToken = TokEllipsis } }
'and' { LexToken { ltokToken = TokAnd } }
'break' { LexToken { ltokToken = TokBreak } }
'do' { LexToken { ltokToken = TokDo } }
'else' { LexToken { ltokToken = TokElse } }
'elseif' { LexToken { ltokToken = TokElseIf } }
'end' { LexToken { ltokToken = TokEnd } }
'false' { LexToken { ltokToken = TokFalse } }
'for' { LexToken { ltokToken = TokFor } }
'function' { LexToken { ltokToken = TokFunction } }
'goto' { LexToken { ltokToken = TokGoto } }
'if' { LexToken { ltokToken = TokIf } }
'in' { LexToken { ltokToken = TokIn } }
'local' { LexToken { ltokToken = TokLocal } }
'nil' { LexToken { ltokToken = TokNil } }
'not' { LexToken { ltokToken = TokNot } }
'or' { LexToken { ltokToken = TokOr } }
'repeat' { LexToken { ltokToken = TokRepeat } }
'return' { LexToken { ltokToken = TokReturn } }
'then' { LexToken { ltokToken = TokThen } }
'true' { LexToken { ltokToken = TokTrue } }
'until' { LexToken { ltokToken = TokUntil } }
'while' { LexToken { ltokToken = TokWhile } }
numeral { LexToken { ltokToken = TokNum } }
literalString { LexToken { ltokToken = TokSLit } }
ident { LexToken { ltokToken = TokIdent } }
%monad { Either (SourcePos, String) }
%error { errorP }
-- local a=b(nil)() is one statement
-- local a=b;(nil)() is two statements
-- therefore EXP '('
-- f()(nil)() is one statement
-- f();(nil)() is two statements
-- therefore STAT PREFIX
%nonassoc STAT EXP
%nonassoc PREFIX '('
%left 'or'
%left 'and'
%left '<' '<=' '>' '>=' '==' '~='
%left '|'
%left '~'
%left '&'
%left '<<' '>>'
%right '..'
%left '+' '-'
%left '*' '/' '//' '%'
%nonassoc 'not' '#' NEG COMPLEMENT
%right '^'
%name chunk_ block
%name exp_ exp
%name stat_ stat
%%
opt(p)
: p { Just $1 }
| { Nothing }
many (p) : revMany(p) { reverse $1 }
revMany(p) : revMany(p) p { $2 : $1 }
| { [] }
sepBy (p,sep) : sepBy1(p,sep) { $1 }
| { [] }
sepBy1 (p,sep) : revSepBy1(p,sep) { reverse $1 }
revSepBy1(p,sep) : p { [$1] }
| revSepBy1(p,sep) sep p { $3 : $1 }
block :: { Block SourcePos }
: many(stat) opt(retstat) { Block (blockAnn $1 $2) $1 $2 }
retstat :: { [Exp SourcePos] }
: 'return' sepBy(exp,',') opt(';') { $2 }
stat :: { Stat SourcePos }
: ';' { sp $1 EmptyStat }
| varlist '=' explist { sp (head $1) Assign $1 $3 }
| functioncall %prec STAT { sp $1 FunCall $1 }
| '::' name '::' { sp $1 Label $2 }
| 'break' { sp $1 Break }
| 'goto' name { sp $1 Goto $2 }
| 'local' namelist opt(assign) { sp $1 LocalAssign $2 $3 }
------- block structures -------------------------------
| 'function' funcname funcbody 'end' { sp $1 FunAssign $2 $3 }
| 'local' 'function' name funcbody 'end' { sp $1 LocalFunAssign $3 $4 }
| 'repeat' block 'until' exp { sp $1 Repeat $2 $4 }
| 'do' block 'end' { sp $1 Do $2 }
| 'while' exp 'do' block 'end' { sp $1 While $2 $4 }
| 'if' exp 'then' block many(elseif) opt(else) 'end' { sp $1 If (($2,$4):$5) $6 }
| 'for' name '=' exp ',' exp opt(step) 'do' block 'end' { sp $1 ForRange $2 $4 $6 $7 $9 }
| 'for' namelist 'in' explist 'do' block 'end' { sp $1 ForIn $2 $4 $6 }
------- error cases for block structures ---------------
| 'function' funcname funcbody error {% noEndP $1 }
| 'local' 'function' name funcbody error {% noEndP $1 }
| 'repeat' block error {% noEndP $1 }
| 'do' block error {% noEndP $1 }
| 'while' exp 'do' block error {% noEndP $1 }
| 'if' exp 'then' block many(elseif) opt(else) error {% noEndP $1 }
| 'for' name '=' exp ',' exp opt(step) 'do' block error {% noEndP $1 }
| 'for' namelist 'in' explist 'do' block error {% noEndP $1 }
elseif : 'elseif' exp 'then' block { ($2,$4) }
else : 'else' block { $2 }
step : ',' exp { $2 }
assign : '=' explist { $2 }
varlist : sepBy1(var, ',') { $1 }
explist : sepBy1(exp, ',') { $1 }
namelist : sepBy1(name, ',') { $1 }
prefixexp :: { PrefixExp SourcePos }
: var { sp $1 PEVar $1 }
| functioncall %prec PREFIX { sp $1 PEFunCall $1 }
| '(' exp ')' { sp $1 Paren $2 }
functioncall :: { FunCall SourcePos }
: prefixexp args { sp $1 NormalFunCall $1 $2 }
| prefixexp methodname args { sp $1 MethodCall $1 $2 $3 }
funcname :: { FunName SourcePos }
: name many(dottedname) opt(methodname) { sp $1 FunName $1 $2 $3 }
dottedname : '.' name { $2 }
methodname : ':' name { $2 }
var :: { Var SourcePos }
: name { sp $1 VarName $1 }
| prefixexp '[' exp ']' { sp $1 Select $1 $3 }
| prefixexp '.' name { sp $1 SelectName $1 $3 }
exp :: { Exp SourcePos }
: 'nil' { sp $1 Nil }
| 'false' { sp $1 Bool False }
| 'true' { sp $1 Bool True }
| numeral { sp $1 Number (ltokLexeme $1) }
| literalString { sp $1 String (ltokLexeme $1) }
| '...' { sp $1 Vararg }
| functiondef { sp $1 EFunDef $1 }
| prefixexp %prec EXP { sp $1 PrefixExp $1 }
| tableconstructor { sp $1 TableConst $1 }
| exp '+' exp { sp $1 Binop (sp $2 Add ) $1 $3 }
| exp '-' exp { sp $1 Binop (sp $2 Sub ) $1 $3 }
| exp '*' exp { sp $1 Binop (sp $2 Mul ) $1 $3 }
| exp '/' exp { sp $1 Binop (sp $2 Div ) $1 $3 }
| exp '//' exp { sp $1 Binop (sp $2 IDiv ) $1 $3 }
| exp '^' exp { sp $1 Binop (sp $2 Exp ) $1 $3 }
| exp '%' exp { sp $1 Binop (sp $2 Mod ) $1 $3 }
| exp '..' exp { sp $1 Binop (sp $2 Concat) $1 $3 }
| exp '<' exp { sp $1 Binop (sp $2 LT ) $1 $3 }
| exp '<=' exp { sp $1 Binop (sp $2 LTE ) $1 $3 }
| exp '>' exp { sp $1 Binop (sp $2 GT ) $1 $3 }
| exp '>=' exp { sp $1 Binop (sp $2 GTE ) $1 $3 }
| exp '==' exp { sp $1 Binop (sp $2 EQ ) $1 $3 }
| exp '~=' exp { sp $1 Binop (sp $2 NEQ ) $1 $3 }
| exp 'and' exp { sp $1 Binop (sp $2 And ) $1 $3 }
| exp 'or' exp { sp $1 Binop (sp $2 Or ) $1 $3 }
| exp '&' exp { sp $1 Binop (sp $2 BAnd ) $1 $3 }
| exp '|' exp { sp $1 Binop (sp $2 BOr ) $1 $3 }
| exp '~' exp { sp $1 Binop (sp $2 BXor ) $1 $3 }
| exp '<<' exp { sp $1 Binop (sp $2 ShiftL) $1 $3 }
| exp '>>' exp { sp $1 Binop (sp $2 ShiftR) $1 $3 }
| '-' exp %prec NEG { sp $1 Unop (sp $1 Neg) $2 }
| '~' exp %prec COMPLEMENT { sp $1 Unop (sp $1 Complement) $2 }
| 'not' exp { sp $1 Unop (sp $1 Not) $2 }
| '#' exp { sp $1 Unop (sp $1 Len) $2 }
args :: { FunArg SourcePos }
: '(' sepBy(exp,',') ')' { sp $1 Args $2 }
| tableconstructor { sp $1 TableArg $1 }
| literalString { sp $1 StringArg (ltokLexeme $1) }
functiondef :: { FunDef SourcePos }
: 'function' funcbody 'end' { sp $1 FunDef $2 }
| 'function' funcbody error {% noEndP $1 }
funcbody :: { FunBody SourcePos }
: '(' parlist ')' block { sp $1 FunBody (fst $2) (snd $2) $4 }
parlist :: { ([Name SourcePos],Maybe SourcePos) }
: parnames1 ',' '...' { (reverse $1,Just (ltokPos $3) ) }
| parnames1 { (reverse $1,Nothing) }
| '...' { ([],Just (ltokPos $1)) }
| { ([],Nothing) }
parnames1 :: { [Name SourcePos] }
: name { [$1] }
| parnames1 ',' name { $3 : $1 }
tableconstructor :: { Table SourcePos }
: '{' '}' { sp $1 Table [] }
| '{' fieldlist opt(fieldsep) '}' { sp $1 Table (reverse $2) }
fieldlist :: { [TableField SourcePos] }
: fieldlist fieldsep field { $3 : $1 }
| field { [$1] }
fieldsep :: { () }
: ',' { () }
| ';' { () }
field :: { TableField SourcePos }
: '[' exp ']' '=' exp { sp $1 ExpField $2 $5 }
| name '=' exp { sp $1 NamedField $1 $3 }
| exp { sp $1 Field $1 }
name :: { Name SourcePos }
: ident { sp $1 Name (ltokLexeme $1) }
{
newtype Parser a = Parser { runParser :: [LexToken SourcePos] -> Either (SourcePos,String) a }
chunk :: Parser (Block SourcePos)
chunk = Parser chunk_
stat :: Parser (Stat SourcePos)
stat = Parser stat_
exp :: Parser (Exp SourcePos)
exp = Parser exp_
instance Functor Parser where
fmap f (Parser p) = Parser (fmap (fmap f) p)
errorP :: [LexToken SourcePos] -> Either (SourcePos,String) a
errorP ts =
case ts of
[] -> Left (SourcePos "" (-1)(-1)(-1), "unexpected end of file")
LexToken { ltokPos = pos, ltokToken = t }:_ ->
Left (pos, "unexpected " ++ show t)
noEndP :: LexToken SourcePos -> Either (SourcePos,String) a
noEndP LexToken { ltokPos = pos, ltokToken = t } =
Left (pos, "unterminated " ++ show t)
sp :: Annotated p => p SourcePos -> (SourcePos -> a) -> a
sp x f = f (ann x)
blockAnn :: [Stat SourcePos] -> Maybe [Exp SourcePos] -> SourcePos
blockAnn xs mbys =
case map ann xs ++ maybe [] (map ann) mbys of
a : _ -> a
_ -> SourcePos "" 0 1 1
showPos :: SourcePos -> String
showPos p = "line: " ++ show (sourcePosLine p) ++
" column: " ++ show (sourcePosColumn p)
-- | Runs Lua lexer before parsing. Use @parseNamedText stat "name"@ to parse
-- statements, and @parseText exp "name"@ to parse expressions.
parseNamedText ::
Parser a ->
String {- ^ name -} ->
Text {- ^ chunk -} ->
Either (SourcePos, String) a
parseNamedText p n xs = runParser p (llexNamed n xs)
-- | Runs Lua lexer before parsing. Use @parseText stat@ to parse
-- statements, and @parseText exp@ to parse expressions.
parseText ::
Parser a ->
Text {- ^ chunk -} ->
Either (SourcePos, String) a
parseText p = parseNamedText p "=<string>"
-- | Parse a Lua file. You can use @parseText chunk@ to parse a file from a string.
parseFile :: FilePath -> IO (Either (SourcePos, String) (Block SourcePos))
parseFile fp = fmap (parseNamedText chunk fp) (Text.readFile fp)
}