|
{
|
|
module Presyntax.Parser where
|
|
|
|
import qualified Data.Text as T
|
|
import Data.Text (Text)
|
|
|
|
import Presyntax.Presyntax
|
|
import Presyntax.Tokens
|
|
import Presyntax.Lexer
|
|
|
|
import Prelude hiding (span)
|
|
|
|
}
|
|
|
|
%name parseExp Exp
|
|
%name parseStmt Statement
|
|
%name parseProg Program
|
|
|
|
%tokentype { Token }
|
|
|
|
%monad { Alex }
|
|
%lexer { lexer } { Token TokEof _ _ }
|
|
|
|
%errorhandlertype explist
|
|
%error { parseError }
|
|
|
|
%token
|
|
var { $$@(Token (TokVar _) _ _) }
|
|
'(' { Token TokOParen _ _ }
|
|
')' { Token TokCParen _ _ }
|
|
|
|
'{' { Token TokOBrace _ _ }
|
|
'}' { Token TokCBrace _ _ }
|
|
|
|
'\\' { Token TokLambda _ _ }
|
|
|
|
'->' { Token TokArrow _ _ }
|
|
':' { Token TokColon _ _ }
|
|
';' { Token TokSemi _ _ }
|
|
'=' { Token TokEqual _ _ }
|
|
',' { Token TokComma _ _ }
|
|
'*' { Token TokStar _ _ }
|
|
|
|
'.1' { Token TokPi1 _ _ }
|
|
'.2' { Token TokPi2 _ _ }
|
|
|
|
%%
|
|
|
|
Exp :: { Expr }
|
|
Exp
|
|
: Exp ExpProj { span $1 $2 $ App Ex $1 $2 }
|
|
| Exp '{' Exp '}' { span $1 $4 $ App Im $1 $3 }
|
|
|
|
| '\\' LambdaList '->' Exp { span $1 $4 $ makeLams $2 $4 }
|
|
| '(' VarList ':' Exp ')' ProdTail { span $1 $6 $ makePis Ex $2 $4 $6 }
|
|
| '{' VarList ':' Exp '}' ProdTail { span $1 $6 $ makePis Im $2 $4 $6 }
|
|
| ExpProj '->' Exp { span $1 $3 $ Pi Ex (T.singleton '_') $1 $3 }
|
|
|
|
| '(' VarList ':' Exp ')' '*' Exp { span $1 $7 $ makeSigmas $2 $4 $7 }
|
|
| ExpProj '*' Exp { span $1 $3 $ Sigma (T.singleton '_') $1 $3 }
|
|
|
|
| ExpProj { $1 }
|
|
|
|
ProdTail :: { Expr }
|
|
: '(' VarList ':' Exp ')' ProdTail { span $1 $6 $ makePis Ex $2 $4 $6 }
|
|
| '{' VarList ':' Exp '}' ProdTail { span $1 $6 $ makePis Im $2 $4 $6 }
|
|
| '->' Exp { span $2 $2 $ $2 }
|
|
|
|
LambdaList :: { [(Plicity, Text)] }
|
|
: var { [(Ex, getVar $1)] }
|
|
| var LambdaList { (Ex, getVar $1):$2 }
|
|
|
|
| '{'var'}' { [(Im, getVar $2)] }
|
|
| '{'var'}' LambdaList { (Im, getVar $2):$4 }
|
|
|
|
LhsList :: { [(Plicity, Text)] }
|
|
: { [] }
|
|
| LambdaList { $1 }
|
|
|
|
VarList :: { [Text] }
|
|
: var { [getVar $1] }
|
|
| var VarList { getVar $1:$2 }
|
|
|
|
ExpProj :: { Expr }
|
|
: ExpProj '.1' { span $1 $2 $ Proj1 $1 }
|
|
| ExpProj '.2' { span $1 $2 $ Proj2 $1 }
|
|
| Atom { $1 }
|
|
|
|
Atom :: { Expr }
|
|
: var { span $1 $1 $ Var (getVar $1) }
|
|
| '(' Tuple ')' { span $1 $3 $ $2 }
|
|
|
|
Tuple :: { Expr }
|
|
: Exp { $1 }
|
|
| Exp ',' Tuple { span $1 $3 $ Pair $1 $3 }
|
|
|
|
Statement :: { Statement }
|
|
: var ':' Exp { Decl (getVar $1) $3 }
|
|
| var LhsList '=' Exp { Defn (getVar $1) (makeLams $2 $4) }
|
|
|
|
Program :: { [Statement] }
|
|
: Statement { [$1] }
|
|
| Statement ';' Program { $1:$3 }
|
|
|
|
{
|
|
lexer cont = alexMonadScan >>= cont
|
|
|
|
parseError x = alexError (show x)
|
|
|
|
makeLams xs b = foldr (uncurry Lam) b xs
|
|
makePis p xs t b = foldr (flip (Pi p) t) b xs
|
|
makeSigmas xs t b = foldr (flip Sigma t) b xs
|
|
|
|
class HasPosn a where
|
|
startPosn :: a -> Posn
|
|
endPosn :: a -> Posn
|
|
|
|
instance HasPosn Token where
|
|
startPosn (Token _ l c) = Posn l c
|
|
endPosn (Token t l c) = Posn l (c + tokSize t)
|
|
|
|
instance HasPosn Expr where
|
|
startPosn (Span _ s _) = s
|
|
startPosn _ = error "no start posn in parsed expression?"
|
|
|
|
endPosn (Span _ _ e) = e
|
|
endPosn _ = error "no end posn in parsed expression?"
|
|
|
|
span s e ex = Span ex (startPosn s) (endPosn e)
|
|
|
|
getVar (Token (TokVar s) _ _) = s
|
|
getVar _ = error "getVar non-var"
|
|
}
|