|
{
|
|
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
|
|
%name parseRepl ReplStatement
|
|
|
|
%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 TokOPragma _ _ }
|
|
'#-}' { Token TokCPragma _ _ }
|
|
|
|
'\\' { Token TokLambda _ _ }
|
|
|
|
'->' { Token TokArrow _ _ }
|
|
':' { Token TokColon _ _ }
|
|
';' { Token TokSemi _ _ }
|
|
'=' { Token TokEqual _ _ }
|
|
',' { Token TokComma _ _ }
|
|
'*' { Token TokStar _ _ }
|
|
|
|
'.1' { Token TokPi1 _ _ }
|
|
'.2' { Token TokPi2 _ _ }
|
|
|
|
'PRIMITIVE' { Token TokPrim _ _ }
|
|
|
|
':let' { Token TokReplLet _ _ }
|
|
':t' { Token (TokReplT _) _ _ }
|
|
|
|
%%
|
|
|
|
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 (thd $2) $4 $6 }
|
|
| '{' VarList ':' Exp '}' ProdTail { span $1 $6 $ makePis Im (thd $2) $4 $6 }
|
|
| ExpProj '->' Exp { span $1 $3 $ Pi Ex (T.singleton '_') $1 $3 }
|
|
|
|
| '(' VarList ':' Exp ')' '*' Exp { span $1 $7 $ makeSigmas (thd $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 (thd $2) $4 $6 }
|
|
| '{' VarList ':' Exp '}' ProdTail { span $1 $6 $ makePis Im (thd $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 :: { (Posn, Posn, [Text]) }
|
|
: var { (startPosn $1, endPosn $1, [getVar $1]) }
|
|
| var VarList { case $2 of (_, end, xs) -> (startPosn $1, end, getVar $1:xs) }
|
|
|
|
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 }
|
|
: VarList ':' Exp { spanSt $1 $3 $ Decl (thd $1) $3 }
|
|
| var LhsList '=' Exp { spanSt $1 $4 $ Defn (getVar $1) (makeLams $2 $4) }
|
|
| '{-#' Pragma '#-}' { spanSt $1 $3 $ $2 }
|
|
|
|
ReplStatement :: { Statement }
|
|
: Exp { spanSt $1 $1 $ ReplNf $1 }
|
|
| ':t' Exp { spanSt $1 $2 $ ReplTy $2 }
|
|
| ':let' VarList ':' Exp { spanSt $1 $4 $ Decl (thd $2) $4 }
|
|
| ':let' var LhsList '=' Exp { spanSt $1 $5 $ Defn (getVar $2) (makeLams $3 $5) }
|
|
| '{-#' Pragma '#-}' { spanSt $1 $3 $ $2 }
|
|
|
|
Program :: { [Statement] }
|
|
: Statement { [$1] }
|
|
| Statement ';' Program { $1:$3 }
|
|
|
|
Pragma :: { Statement }
|
|
: 'PRIMITIVE' var var { Builtin (getVar $2) (getVar $3) }
|
|
| 'PRIMITIVE' var { Builtin (getVar $2) (getVar $2) }
|
|
|
|
{
|
|
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?"
|
|
|
|
instance HasPosn (Posn, Posn, a) where
|
|
startPosn (s, _, _) = s
|
|
endPosn (_, e, _) = e
|
|
|
|
thd :: (a, b, c) -> c
|
|
thd (x, y, z) = z
|
|
|
|
|
|
span s e ex = Span ex (startPosn s) (endPosn e)
|
|
spanSt s e ex = SpanSt ex (startPosn s) (endPosn e)
|
|
|
|
getVar (Token (TokVar s) _ _) = s
|
|
getVar _ = error "getVar non-var"
|
|
}
|