mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
use new parser which supports the syntax in GF.Grammar.Grammar directly
This commit is contained in:
krasimir
5
GF.cabal
5
GF.cabal
@@ -617,9 +617,7 @@ executable gf
|
||||
extensions:
|
||||
main-is: GF.hs
|
||||
other-modules:
|
||||
GF.Grammar.ReservedWords
|
||||
GF.Data.BacktrackM
|
||||
GF.Source.LexGF
|
||||
GF.Source.AbsGF
|
||||
GF.Source.PrintGF
|
||||
GF.JavaScript.AbsJS
|
||||
@@ -632,7 +630,6 @@ executable gf
|
||||
GF.Data.Assoc
|
||||
GF.Compile.GenerateFCFG
|
||||
GF.Data.ErrM
|
||||
GF.Source.ParGF
|
||||
GF.Data.Operations
|
||||
GF.Infra.Ident
|
||||
GF.Grammar.Predef
|
||||
@@ -647,6 +644,8 @@ executable gf
|
||||
GF.Command.Parse
|
||||
GF.Command.Importing
|
||||
GF.Infra.Modules
|
||||
GF.Grammar.Lexer
|
||||
GF.Grammar.Parser
|
||||
GF.Grammar.Grammar
|
||||
GF.Source.GrammarToSource
|
||||
GF.Grammar.Values
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
--# -path=.:../abstract:../common:../../prelude
|
||||
|
||||
concrete StructuralRus of Structural = CatRus **
|
||||
open ResRus, MorphoRus, (P = ParadigmsRus), Prelude, NounRus, in {
|
||||
open ResRus, MorphoRus, (P = ParadigmsRus), Prelude, NounRus in {
|
||||
|
||||
flags optimize=all ; coding=utf8 ;
|
||||
|
||||
|
||||
@@ -12,7 +12,7 @@ concrete GrammarTha of Grammar =
|
||||
-- ConjunctionTha,
|
||||
PhraseTha,
|
||||
-- TextX,
|
||||
StructuralTha,
|
||||
StructuralTha
|
||||
-- IdiomTha
|
||||
** {
|
||||
|
||||
|
||||
@@ -30,12 +30,12 @@ import GF.Infra.Modules
|
||||
import GF.Compile.TypeCheck
|
||||
|
||||
import GF.Compile.Refresh
|
||||
import GF.Grammar.Lexer
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.PrGrammar
|
||||
import GF.Grammar.Lookup
|
||||
import GF.Grammar.Predef
|
||||
import GF.Grammar.Macros
|
||||
import GF.Grammar.ReservedWords
|
||||
import GF.Grammar.PatternMatch
|
||||
import GF.Grammar.AppPredefined
|
||||
import GF.Grammar.Lockfield (isLockLabel)
|
||||
@@ -403,10 +403,9 @@ checkPrintname _ _ = return ()
|
||||
|
||||
-- | for grammars obtained otherwise than by parsing ---- update!!
|
||||
checkReservedId :: Ident -> Check ()
|
||||
checkReservedId x = let c = prt x in
|
||||
if isResWord c
|
||||
then checkWarn ("Warning: reserved word used as identifier:" +++ c)
|
||||
else return ()
|
||||
checkReservedId x
|
||||
| isReservedWord (ident2bs x) = checkWarn ("Warning: reserved word used as identifier:" +++ prt x)
|
||||
| otherwise = return ()
|
||||
|
||||
-- to normalize records and record types
|
||||
labelIndex :: Type -> Label -> Int
|
||||
|
||||
@@ -18,15 +18,10 @@ import GF.Data.Operations
|
||||
|
||||
import GF.Infra.UseIO
|
||||
import GF.Infra.Modules
|
||||
import GF.Grammar.Grammar
|
||||
import qualified GF.Source.AbsGF as A
|
||||
import GF.Source.SourceToGrammar
|
||||
---- import Macros
|
||||
---- import Rename
|
||||
import GF.Infra.Option
|
||||
--- import Custom
|
||||
import GF.Source.ParGF
|
||||
import qualified GF.Source.LexGF as L
|
||||
import GF.Grammar.Lexer
|
||||
import GF.Grammar.Parser
|
||||
import GF.Grammar.Grammar
|
||||
|
||||
import GF.Compile.ReadFiles
|
||||
|
||||
@@ -37,22 +32,21 @@ import Control.Monad (foldM)
|
||||
import System.Cmd (system)
|
||||
|
||||
getSourceModule :: Options -> FilePath -> IOE SourceModule
|
||||
getSourceModule opts file0 = do
|
||||
file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
|
||||
string <- readFileIOE file
|
||||
let tokens = myLexer string
|
||||
mo1 <- ioeErr $ errIn file0 $ pModDef tokens
|
||||
mo2 <- ioeErr $ transModDef mo1
|
||||
return $ addOptionsToModule opts mo2
|
||||
getSourceModule opts file0 = ioe $
|
||||
catch (do file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
|
||||
content <- BS.readFile file
|
||||
case runP pModDef content of
|
||||
Left (Pn l c,msg) -> return (Bad (file++":"++show l++":"++show c++": "++msg))
|
||||
Right mo -> return (Ok (addOptionsToModule opts mo)))
|
||||
(\e -> return (Bad (show e)))
|
||||
|
||||
addOptionsToModule :: Options -> SourceModule -> SourceModule
|
||||
addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts })
|
||||
|
||||
-- FIXME: should use System.IO.openTempFile
|
||||
runPreprocessor :: FilePath -> String -> IOE FilePath
|
||||
runPreprocessor file0 p =
|
||||
do let tmp = "_gf_preproc.tmp"
|
||||
cmd = p +++ file0 ++ ">" ++ tmp
|
||||
ioeIO $ system cmd
|
||||
-- ioeIO $ putStrLn $ "preproc" +++ cmd
|
||||
return tmp
|
||||
runPreprocessor :: FilePath -> String -> IO FilePath
|
||||
runPreprocessor file0 p = do
|
||||
let tmp = "_gf_preproc.tmp"
|
||||
cmd = p +++ file0 ++ ">" ++ tmp
|
||||
system cmd
|
||||
return tmp
|
||||
|
||||
@@ -29,9 +29,8 @@ import GF.Infra.Ident
|
||||
import GF.Infra.Modules
|
||||
import GF.Data.Operations
|
||||
import qualified GF.Source.AbsGF as S
|
||||
import GF.Source.LexGF
|
||||
import GF.Source.ParGF
|
||||
import GF.Source.SourceToGrammar(transModDef)
|
||||
import GF.Grammar.Lexer
|
||||
import GF.Grammar.Parser
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Binary
|
||||
|
||||
@@ -109,29 +108,13 @@ getAllFiles opts ps env file = do
|
||||
CSEnv -> return (name, maybe [] snd mb_envmod)
|
||||
CSRead -> ioeIO $ fmap importsOfModule (decodeModHeader (replaceExtension file "gfo"))
|
||||
CSComp -> do s <- ioeIO $ BS.readFile file
|
||||
ioeErr ((liftM (importsOfModule . modHeaderToModDef) . pModHeader . myLexer) s)
|
||||
case runP pModHeader s of
|
||||
Left (Pn l c,msg) -> ioeBad (file ++ ":" ++ show l ++ ":" ++ show c ++ ": " ++ msg)
|
||||
Right mo -> return (importsOfModule mo)
|
||||
ioeErr $ testErr (mname == name)
|
||||
("module name" +++ mname +++ "differs from file name" +++ name)
|
||||
return (name,st,t,imps,dropFileName file)
|
||||
|
||||
-- FIXME: this is pretty ugly, it's just to get around the difference
|
||||
-- between ModHeader as returned when parsing just the module header
|
||||
-- when looking for imports, and ModDef, which includes the whole module.
|
||||
modHeaderToModDef :: S.ModHeader -> SourceModule
|
||||
modHeaderToModDef (S.MModule2 x y z) =
|
||||
errVal (error "error in modHeaderToModDef") $ transModDef $ S.MModule x y (modHeaderBodyToModBody z)
|
||||
where
|
||||
modHeaderBodyToModBody :: S.ModHeaderBody -> S.ModBody
|
||||
modHeaderBodyToModBody b = case b of
|
||||
S.MBody2 x y -> S.MBody x y []
|
||||
S.MNoBody2 x -> S.MNoBody x
|
||||
S.MWith2 x y -> S.MWith x y
|
||||
S.MWithBody2 x y z -> S.MWithBody x y z []
|
||||
S.MWithE2 x y z -> S.MWithE x y z
|
||||
S.MWithEBody2 x y z w -> S.MWithEBody x y z w []
|
||||
S.MReuse2 x -> S.MReuse x
|
||||
S.MUnion2 x -> S.MUnion x
|
||||
|
||||
isGFO :: FilePath -> Bool
|
||||
isGFO = (== ".gfo") . takeExtensions
|
||||
|
||||
|
||||
@@ -1,22 +1,19 @@
|
||||
module GF.Grammar.API (
|
||||
Grammar,
|
||||
emptyGrammar,
|
||||
pTerm,
|
||||
ppTerm,
|
||||
checkTerm,
|
||||
computeTerm,
|
||||
showTerm,
|
||||
TermPrintStyle(..), TermPrintQual(..),
|
||||
) where
|
||||
|
||||
import GF.Source.ParGF
|
||||
import GF.Source.SourceToGrammar (transExp)
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Modules (greatestResource)
|
||||
import GF.Compile.GetGrammar
|
||||
import GF.Grammar.Macros
|
||||
import GF.Grammar.Parser
|
||||
import GF.Grammar.Printer
|
||||
import GF.Grammar.Grammar
|
||||
|
||||
import GF.Compile.Rename (renameSourceTerm)
|
||||
import GF.Compile.CheckGrammar (justCheckLTerm)
|
||||
@@ -33,11 +30,6 @@ type Grammar = SourceGrammar
|
||||
emptyGrammar :: Grammar
|
||||
emptyGrammar = emptySourceGrammar
|
||||
|
||||
pTerm :: String -> Err Term
|
||||
pTerm s = do
|
||||
e <- pExp $ myLexer (BS.pack s)
|
||||
transExp e
|
||||
|
||||
checkTerm :: Grammar -> Term -> Err Term
|
||||
checkTerm gr t = do
|
||||
mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
|
||||
|
||||
272
src/GF/Grammar/Lexer.x
Normal file
272
src/GF/Grammar/Lexer.x
Normal file
@@ -0,0 +1,272 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
module GF.Grammar.Lexer
|
||||
( Token(..), Posn(..)
|
||||
, P, runP, lexer, getPosn, failLoc
|
||||
, isReservedWord
|
||||
) where
|
||||
|
||||
import GF.Infra.Ident
|
||||
import GF.Data.Operations
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.Map as Map
|
||||
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \\\\ | \= \> | \_ | \$ | \/
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (eitherResIdent (T_Ident . identC)) }
|
||||
\' ($u # \')* \' { tok (eitherResIdent (T_LString . BS.unpack)) }
|
||||
(\_ | $l)($l | $d | \_ | \')* { tok (eitherResIdent (T_Ident . identC)) }
|
||||
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \" { tok (T_String . unescapeInitTail . BS.unpack) }
|
||||
|
||||
$d+ { tok (T_Integer . read . BS.unpack) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (T_Double . read . BS.unpack) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f s
|
||||
|
||||
data Token
|
||||
= T_exclmark
|
||||
| T_patt
|
||||
| T_int_label
|
||||
| T_oparen
|
||||
| T_cparen
|
||||
| T_star
|
||||
| T_starstar
|
||||
| T_plus
|
||||
| T_plusplus
|
||||
| T_comma
|
||||
| T_minus
|
||||
| T_rarrow
|
||||
| T_dot
|
||||
| T_alt
|
||||
| T_colon
|
||||
| T_semicolon
|
||||
| T_less
|
||||
| T_equal
|
||||
| T_big_rarrow
|
||||
| T_great
|
||||
| T_questmark
|
||||
| T_obrack
|
||||
| T_lam
|
||||
| T_lamlam
|
||||
| T_cbrack
|
||||
| T_ocurly
|
||||
| T_bar
|
||||
| T_ccurly
|
||||
| T_underscore
|
||||
| T_at
|
||||
| T_PType
|
||||
| T_Str
|
||||
| T_Strs
|
||||
| T_Tok
|
||||
| T_Type
|
||||
| T_abstract
|
||||
| T_case
|
||||
| T_cat
|
||||
| T_concrete
|
||||
| T_data
|
||||
| T_def
|
||||
| T_flags
|
||||
| T_fn
|
||||
| T_fun
|
||||
| T_in
|
||||
| T_incomplete
|
||||
| T_instance
|
||||
| T_interface
|
||||
| T_let
|
||||
| T_lin
|
||||
| T_lincat
|
||||
| T_lindef
|
||||
| T_of
|
||||
| T_open
|
||||
| T_oper
|
||||
| T_param
|
||||
| T_pattern
|
||||
| T_pre
|
||||
| T_printname
|
||||
| T_resource
|
||||
| T_strs
|
||||
| T_table
|
||||
| T_transfer
|
||||
| T_variants
|
||||
| T_where
|
||||
| T_with
|
||||
| T_String String -- string literals
|
||||
| T_Integer Integer -- integer literals
|
||||
| T_Double Double -- double precision float literals
|
||||
| T_LString String
|
||||
| T_Ident Ident
|
||||
| T_EOF
|
||||
|
||||
eitherResIdent :: (BS.ByteString -> Token) -> BS.ByteString -> Token
|
||||
eitherResIdent tv s =
|
||||
case Map.lookup s resWords of
|
||||
Just t -> t
|
||||
Nothing -> tv s
|
||||
|
||||
isReservedWord :: BS.ByteString -> Bool
|
||||
isReservedWord s = Map.member s resWords
|
||||
|
||||
resWords = Map.fromList
|
||||
[ b "!" T_exclmark
|
||||
, b "#" T_patt
|
||||
, b "$" T_int_label
|
||||
, b "(" T_oparen
|
||||
, b ")" T_cparen
|
||||
, b "*" T_star
|
||||
, b "**" T_starstar
|
||||
, b "+" T_plus
|
||||
, b "++" T_plusplus
|
||||
, b "," T_comma
|
||||
, b "-" T_minus
|
||||
, b "->" T_rarrow
|
||||
, b "." T_dot
|
||||
, b "/" T_alt
|
||||
, b ":" T_colon
|
||||
, b ";" T_semicolon
|
||||
, b "<" T_less
|
||||
, b "=" T_equal
|
||||
, b "=>" T_big_rarrow
|
||||
, b ">" T_great
|
||||
, b "?" T_questmark
|
||||
, b "[" T_obrack
|
||||
, b "]" T_cbrack
|
||||
, b "\\" T_lam
|
||||
, b "\\\\" T_lamlam
|
||||
, b "{" T_ocurly
|
||||
, b "}" T_ccurly
|
||||
, b "|" T_bar
|
||||
, b "_" T_underscore
|
||||
, b "@" T_at
|
||||
, b "PType" T_PType
|
||||
, b "Str" T_Str
|
||||
, b "Strs" T_Strs
|
||||
, b "Tok" T_Tok
|
||||
, b "Type" T_Type
|
||||
, b "abstract" T_abstract
|
||||
, b "case" T_case
|
||||
, b "cat" T_cat
|
||||
, b "concrete" T_concrete
|
||||
, b "data" T_data
|
||||
, b "def" T_def
|
||||
, b "flags" T_flags
|
||||
, b "fn" T_fn
|
||||
, b "fun" T_fun
|
||||
, b "in" T_in
|
||||
, b "incomplete" T_incomplete
|
||||
, b "instance" T_instance
|
||||
, b "interface" T_interface
|
||||
, b "let" T_let
|
||||
, b "lin" T_lin
|
||||
, b "lincat" T_lincat
|
||||
, b "lindef" T_lindef
|
||||
, b "of" T_of
|
||||
, b "open" T_open
|
||||
, b "oper" T_oper
|
||||
, b "param" T_param
|
||||
, b "pattern" T_pattern
|
||||
, b "pre" T_pre
|
||||
, b "printname" T_printname
|
||||
, b "resource" T_resource
|
||||
, b "strs" T_strs
|
||||
, b "table" T_table
|
||||
, b "transfer" T_transfer
|
||||
, b "variants" T_variants
|
||||
, b "where" T_where
|
||||
, b "with" T_with
|
||||
]
|
||||
where b s t = (BS.pack s, t)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn {-# UNPACK #-} !Int
|
||||
{-# UNPACK #-} !Int
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn l c) '\n' = Pn (l+1) 1
|
||||
alexMove (Pn l c) _ = Pn l (c+1)
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (AI p _ s) =
|
||||
case BS.uncons s of
|
||||
Nothing -> Nothing
|
||||
Just (c,s) ->
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (AI p' c s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (AI p c s) = c
|
||||
|
||||
data AlexInput = AI {-# UNPACK #-} !Posn -- current position,
|
||||
{-# UNPACK #-} !Char -- previous char
|
||||
{-# UNPACK #-} !BS.ByteString -- current input string
|
||||
|
||||
data ParseResult a
|
||||
= POk AlexInput a
|
||||
| PFailed Posn -- The position of the error
|
||||
String -- The error message
|
||||
|
||||
newtype P a = P { unP :: AlexInput -> ParseResult a }
|
||||
|
||||
instance Monad P where
|
||||
return a = a `seq` (P $ \s -> POk s a)
|
||||
(P m) >>= k = P $ \ s -> case m s of
|
||||
POk s1 a -> unP (k a) s1
|
||||
PFailed posn err -> PFailed posn err
|
||||
fail msg = P $ \(AI posn _ _) -> PFailed posn msg
|
||||
|
||||
runP :: P a -> BS.ByteString -> Either (Posn,String) a
|
||||
runP (P f) txt =
|
||||
case f (AI (Pn 1 0) ' ' txt) of
|
||||
POk _ x -> Right x
|
||||
PFailed pos msg -> Left (pos,msg)
|
||||
|
||||
failLoc :: Posn -> String -> P a
|
||||
failLoc pos msg = P $ \_ -> PFailed pos msg
|
||||
|
||||
lexer :: (Token -> P a) -> P a
|
||||
lexer cont = P go
|
||||
where
|
||||
go inp@(AI pos _ str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> unP (cont T_EOF) inp
|
||||
AlexError (AI pos _ _) -> PFailed pos "lexical error"
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> unP (cont (act pos (BS.take len str))) inp'
|
||||
|
||||
getPosn :: P Posn
|
||||
getPosn = P $ \inp@(AI pos _ _) -> POk inp pos
|
||||
|
||||
}
|
||||
719
src/GF/Grammar/Parser.y
Normal file
719
src/GF/Grammar/Parser.y
Normal file
@@ -0,0 +1,719 @@
|
||||
{
|
||||
{-# OPTIONS -fno-warn-overlapping-patterns #-}
|
||||
module GF.Grammar.Parser
|
||||
( P, runP
|
||||
, pModDef
|
||||
, pModHeader
|
||||
, pExp
|
||||
) where
|
||||
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Modules
|
||||
import GF.Infra.Option
|
||||
import GF.Data.Operations
|
||||
import GF.Grammar.Predef
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Macros
|
||||
import GF.Grammar.Lexer
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import GF.Compile.Update (buildAnyTree)
|
||||
}
|
||||
|
||||
%name pModDef ModDef
|
||||
%partial pModHeader ModHeader
|
||||
%name pExp Exp
|
||||
|
||||
-- no lexer declaration
|
||||
%monad { P } { >>= } { return }
|
||||
%lexer { lexer } { T_EOF }
|
||||
%tokentype { Token }
|
||||
|
||||
|
||||
%token
|
||||
'!' { T_exclmark }
|
||||
'#' { T_patt }
|
||||
'$' { T_int_label }
|
||||
'(' { T_oparen }
|
||||
')' { T_cparen }
|
||||
'*' { T_star }
|
||||
'**' { T_starstar }
|
||||
'+' { T_plus }
|
||||
'++' { T_plusplus }
|
||||
',' { T_comma }
|
||||
'-' { T_minus }
|
||||
'->' { T_rarrow }
|
||||
'.' { T_dot }
|
||||
'/' { T_alt }
|
||||
':' { T_colon }
|
||||
';' { T_semicolon }
|
||||
'<' { T_less }
|
||||
'=' { T_equal }
|
||||
'=>' { T_big_rarrow}
|
||||
'>' { T_great }
|
||||
'?' { T_questmark }
|
||||
'@' { T_at }
|
||||
'[' { T_obrack }
|
||||
']' { T_cbrack }
|
||||
'{' { T_ocurly }
|
||||
'}' { T_ccurly }
|
||||
'\\' { T_lam }
|
||||
'\\\\' { T_lamlam }
|
||||
'_' { T_underscore}
|
||||
'|' { T_bar }
|
||||
'PType' { T_PType }
|
||||
'Str' { T_Str }
|
||||
'Strs' { T_Strs }
|
||||
'Tok' { T_Tok }
|
||||
'Type' { T_Type }
|
||||
'abstract' { T_abstract }
|
||||
'case' { T_case }
|
||||
'cat' { T_cat }
|
||||
'concrete' { T_concrete }
|
||||
'data' { T_data }
|
||||
'def' { T_def }
|
||||
'flags' { T_flags }
|
||||
'fn' { T_fn }
|
||||
'fun' { T_fun }
|
||||
'in' { T_in }
|
||||
'incomplete' { T_incomplete}
|
||||
'instance' { T_instance }
|
||||
'interface' { T_interface }
|
||||
'let' { T_let }
|
||||
'lin' { T_lin }
|
||||
'lincat' { T_lincat }
|
||||
'lindef' { T_lindef }
|
||||
'of' { T_of }
|
||||
'open' { T_open }
|
||||
'oper' { T_oper }
|
||||
'param' { T_param }
|
||||
'pattern' { T_pattern }
|
||||
'pre' { T_pre }
|
||||
'printname' { T_printname }
|
||||
'resource' { T_resource }
|
||||
'strs' { T_strs }
|
||||
'table' { T_table }
|
||||
'transfer' { T_transfer }
|
||||
'variants' { T_variants }
|
||||
'where' { T_where }
|
||||
'with' { T_with }
|
||||
|
||||
Integer { (T_Integer $$) }
|
||||
Double { (T_Double $$) }
|
||||
String { (T_String $$) }
|
||||
LString { (T_LString $$) }
|
||||
Ident { (T_Ident $$) }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
ModDef :: { SourceModule }
|
||||
ModDef
|
||||
: ComplMod ModType '=' ModBody {%
|
||||
do let mstat = $1
|
||||
(mtype,id) = $2
|
||||
(extends,with,content) = $4
|
||||
(opens,jments,opts) = case content of { Just c -> c; Nothing -> ([],[],noOptions) }
|
||||
mapM_ (checkInfoType mtype) jments
|
||||
defs <- case buildAnyTree id [(i,d) | (i,_,d) <- jments] of
|
||||
Ok x -> return x
|
||||
Bad msg -> fail msg
|
||||
let poss = buildTree [(i,(fname,mkSrcSpan p)) | (i,p,_) <- jments]
|
||||
fname = prIdent id ++ ".gf"
|
||||
|
||||
mkSrcSpan :: (Posn, Posn) -> (Int,Int)
|
||||
mkSrcSpan (Pn l1 _, Pn l2 _) = (l1,l2)
|
||||
|
||||
return (id, ModInfo mtype mstat opts extends with opens [] defs poss) }
|
||||
|
||||
ModHeader :: { SourceModule }
|
||||
ModHeader
|
||||
: ComplMod ModType '=' ModHeaderBody { let { mstat = $1 ;
|
||||
(mtype,id) = $2 ;
|
||||
(extends,with,opens) = $4 }
|
||||
in (id, ModInfo mtype mstat noOptions extends with opens [] emptyBinTree emptyBinTree) }
|
||||
|
||||
ComplMod :: { ModuleStatus }
|
||||
ComplMod
|
||||
: {- empty -} { MSComplete }
|
||||
| 'incomplete' { MSIncomplete }
|
||||
|
||||
ModType :: { (ModuleType Ident,Ident) }
|
||||
ModType
|
||||
: 'abstract' Ident { (MTAbstract, $2) }
|
||||
| 'resource' Ident { (MTResource, $2) }
|
||||
| 'interface' Ident { (MTInterface, $2) }
|
||||
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
|
||||
| 'instance' Ident 'of' Ident { (MTInstance $4, $2) }
|
||||
| 'transfer' Ident ':' Open '->' Open { (MTTransfer $4 $6,$2) }
|
||||
|
||||
ModHeaderBody :: { ( [(Ident,MInclude Ident)]
|
||||
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
|
||||
, [OpenSpec Ident]
|
||||
) }
|
||||
ModHeaderBody
|
||||
: ListIncluded '**' Included 'with' ListInst '**' ModOpen { ($1, Just (fst $3,snd $3,$5), $7) }
|
||||
| ListIncluded '**' Included 'with' ListInst { ($1, Just (fst $3,snd $3,$5), []) }
|
||||
| ListIncluded '**' ModOpen { ($1, Nothing, $3) }
|
||||
| ListIncluded { ($1, Nothing, []) }
|
||||
| Included 'with' ListInst '**' ModOpen { ([], Just (fst $1,snd $1,$3), $5) }
|
||||
| Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), []) }
|
||||
| ModOpen { ([], Nothing, $1) }
|
||||
|
||||
ModOpen :: { [OpenSpec Ident] }
|
||||
ModOpen
|
||||
: { [] }
|
||||
| 'open' ListOpen { $2 }
|
||||
|
||||
ModBody :: { ( [(Ident,MInclude Ident)]
|
||||
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
|
||||
, Maybe ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options)
|
||||
) }
|
||||
ModBody
|
||||
: ListIncluded '**' Included 'with' ListInst '**' ModContent { ($1, Just (fst $3,snd $3,$5), Just $7) }
|
||||
| ListIncluded '**' Included 'with' ListInst { ($1, Just (fst $3,snd $3,$5), Nothing) }
|
||||
| ListIncluded '**' ModContent { ($1, Nothing, Just $3) }
|
||||
| ListIncluded { ($1, Nothing, Nothing) }
|
||||
| Included 'with' ListInst '**' ModContent { ([], Just (fst $1,snd $1,$3), Just $5) }
|
||||
| Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), Nothing) }
|
||||
| ModContent { ([], Nothing, Just $1) }
|
||||
| ModBody ';' { $1 }
|
||||
|
||||
ModContent :: { ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options) }
|
||||
ModContent
|
||||
: '{' ListTopDef '}' { ([],[d | Left ds <- $2, d <- ds],concatOptions [o | Right o <- $2]) }
|
||||
| 'open' ListOpen 'in' '{' ListTopDef '}' { ($2,[d | Left ds <- $5, d <- ds],concatOptions [o | Right o <- $5]) }
|
||||
|
||||
ListTopDef :: { [Either [(Ident,SrcSpan,Info)] Options] }
|
||||
ListTopDef
|
||||
: {- empty -} { [] }
|
||||
| TopDef ListTopDef { $1 : $2 }
|
||||
|
||||
ListOpen :: { [OpenSpec Ident] }
|
||||
ListOpen
|
||||
: Open { [$1] }
|
||||
| Open ',' ListOpen { $1 : $3 }
|
||||
|
||||
Open :: { OpenSpec Ident }
|
||||
Open
|
||||
: Ident { OSimple $1 }
|
||||
| '(' Ident '=' Ident ')' { OQualif $2 $4 }
|
||||
|
||||
ListInst :: { [(Ident,Ident)] }
|
||||
ListInst
|
||||
: Inst { [$1] }
|
||||
| Inst ',' ListInst { $1 : $3 }
|
||||
|
||||
Inst :: { (Ident,Ident) }
|
||||
Inst
|
||||
: '(' Ident '=' Ident ')' { ($2,$4) }
|
||||
|
||||
ListIncluded :: { [(Ident,MInclude Ident)] }
|
||||
ListIncluded
|
||||
: Included { [$1] }
|
||||
| Included ',' ListIncluded { $1 : $3 }
|
||||
|
||||
Included :: { (Ident,MInclude Ident) }
|
||||
Included
|
||||
: Ident { ($1,MIAll ) }
|
||||
| Ident '[' ListIdent ']' { ($1,MIOnly $3) }
|
||||
| Ident '-' '[' ListIdent ']' { ($1,MIExcept $4) }
|
||||
|
||||
TopDef :: { Either [(Ident,SrcSpan,Info)] Options }
|
||||
TopDef
|
||||
: 'cat' ListCatDef { Left $2 }
|
||||
| 'fun' ListFunDef { Left $2 }
|
||||
| 'def' ListDefDef { Left $2 }
|
||||
| 'data' ListDataDef { Left $2 }
|
||||
| 'param' ListParamDef { Left $2 }
|
||||
| 'oper' ListOperDef { Left $2 }
|
||||
| 'lincat' ListTermDef { Left [(f, pos, CncCat (Just e) Nothing Nothing ) | (f,pos,e) <- $2] }
|
||||
| 'lindef' ListTermDef { Left [(f, pos, CncCat Nothing (Just e) Nothing ) | (f,pos,e) <- $2] }
|
||||
| 'lin' ListLinDef { Left $2 }
|
||||
| 'printname' 'cat' ListTermDef { Left [(f, pos, CncCat Nothing Nothing (Just e)) | (f,pos,e) <- $3] }
|
||||
| 'printname' 'fun' ListTermDef { Left [(f, pos, CncFun Nothing Nothing (Just e)) | (f,pos,e) <- $3] }
|
||||
| 'flags' ListFlagDef { Right $2 }
|
||||
|
||||
CatDef :: { [(Ident,SrcSpan,Info)] }
|
||||
CatDef
|
||||
: Posn Ident ListDDecl Posn { [($2, ($1,$4), AbsCat (Just $3) Nothing)] }
|
||||
| Posn '[' Ident ListDDecl ']' Posn { listCatDef $3 ($1,$6) $4 0 }
|
||||
| Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef $3 ($1,$9) $4 (fromIntegral $7) }
|
||||
|
||||
FunDef :: { [(Ident,SrcSpan,Info)] }
|
||||
FunDef
|
||||
: Posn ListIdent ':' Exp Posn { [(fun, ($1,$5), AbsFun (Just $4) Nothing) | fun <- $2] }
|
||||
|
||||
DefDef :: { [(Ident,SrcSpan,Info)] }
|
||||
DefDef
|
||||
: Posn ListName '=' Exp Posn { [(f, ($1,$5),AbsFun Nothing (Just $4)) | f <- $2] }
|
||||
| Posn Name ListPatt '=' Exp Posn { [($2,($1,$6),AbsFun Nothing (Just (Eqs [($3,$5)])))] }
|
||||
|
||||
DataDef :: { [(Ident,SrcSpan,Info)] }
|
||||
DataDef
|
||||
: Posn Ident '=' ListDataConstr Posn { ($2, ($1,$5), AbsCat Nothing (Just (map Cn $4))) :
|
||||
[(fun, ($1,$5), AbsFun Nothing (Just EData)) | fun <- $4] }
|
||||
| Posn ListIdent ':' Exp Posn { [(cat, ($1,$5), AbsCat Nothing (Just (map Cn $2))) | Ok (_,cat) <- [valCat $4]] ++
|
||||
[(fun, ($1,$5), AbsFun (Just $4) (Just EData)) | fun <- $2] }
|
||||
|
||||
ParamDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ParamDef
|
||||
: Posn Ident '=' ListParConstr Posn { ($2, ($1,$5), ResParam (Just ($4,Nothing))) :
|
||||
[(f, ($1,$5), ResValue (Just (mkProdSimple co (Cn $2),Nothing))) | (f,co) <- $4] }
|
||||
| Posn Ident Posn { [($2, ($1,$3), ResParam Nothing)] }
|
||||
|
||||
OperDef :: { [(Ident,SrcSpan,Info)] }
|
||||
OperDef
|
||||
: Posn ListName ':' Exp Posn { [(i, ($1,$5), info) | i <- $2, info <- mkOverload (Just $4) Nothing ] }
|
||||
| Posn ListName '=' Exp Posn { [(i, ($1,$5), info) | i <- $2, info <- mkOverload Nothing (Just $4)] }
|
||||
| Posn Name ListArg '=' Exp Posn { [(i, ($1,$6), info) | i <- [$2], info <- mkOverload Nothing (Just (mkAbs $3 $5))] }
|
||||
| Posn ListName ':' Exp '=' Exp Posn { [(i, ($1,$7), info) | i <- $2, info <- mkOverload (Just $4) (Just $6)] }
|
||||
|
||||
LinDef :: { [(Ident,SrcSpan,Info)] }
|
||||
LinDef
|
||||
: Posn ListName '=' Exp Posn { [(f, ($1,$5), CncFun Nothing (Just $4) Nothing) | f <- $2] }
|
||||
| Posn Name ListArg '=' Exp Posn { [($2, ($1,$6), CncFun Nothing (Just (mkAbs $3 $5)) Nothing)] }
|
||||
|
||||
TermDef :: { [(Ident,SrcSpan,Term)] }
|
||||
TermDef
|
||||
: Posn ListName '=' Exp Posn { [(i,($1,$5),$4) | i <- $2] }
|
||||
|
||||
FlagDef :: { Options }
|
||||
FlagDef
|
||||
: Posn Ident '=' Ident Posn {% case parseModuleOptions ["--" ++ prIdent $2 ++ "=" ++ prIdent $4] of
|
||||
Ok x -> return x
|
||||
Bad msg -> failLoc $1 msg }
|
||||
|
||||
ListDataConstr :: { [Ident] }
|
||||
ListDataConstr
|
||||
: Ident { [$1] }
|
||||
| Ident '|' ListDataConstr { $1 : $3 }
|
||||
|
||||
ParConstr :: { Param }
|
||||
ParConstr
|
||||
: Ident ListDDecl { ($1,$2) }
|
||||
|
||||
ListLinDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListLinDef
|
||||
: LinDef ';' { $1 }
|
||||
| LinDef ';' ListLinDef { $1 ++ $3 }
|
||||
|
||||
ListDefDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListDefDef
|
||||
: DefDef ';' { $1 }
|
||||
| DefDef ';' ListDefDef { $1 ++ $3 }
|
||||
|
||||
ListOperDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListOperDef
|
||||
: OperDef ';' { $1 }
|
||||
| OperDef ';' ListOperDef { $1 ++ $3 }
|
||||
|
||||
ListCatDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListCatDef
|
||||
: CatDef ';' { $1 }
|
||||
| CatDef ';' ListCatDef { $1 ++ $3 }
|
||||
|
||||
ListFunDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListFunDef
|
||||
: FunDef ';' { $1 }
|
||||
| FunDef ';' ListFunDef { $1 ++ $3 }
|
||||
|
||||
ListDataDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListDataDef
|
||||
: DataDef ';' { $1 }
|
||||
| DataDef ';' ListDataDef { $1 ++ $3 }
|
||||
|
||||
ListParamDef :: { [(Ident,SrcSpan,Info)] }
|
||||
ListParamDef
|
||||
: ParamDef ';' { $1 }
|
||||
| ParamDef ';' ListParamDef { $1 ++ $3 }
|
||||
|
||||
ListTermDef :: { [(Ident,SrcSpan,Term)] }
|
||||
ListTermDef
|
||||
: TermDef ';' { $1 }
|
||||
| TermDef ';' ListTermDef { $1 ++ $3 }
|
||||
|
||||
ListFlagDef :: { Options }
|
||||
ListFlagDef
|
||||
: FlagDef ';' { $1 }
|
||||
| FlagDef ';' ListFlagDef { addOptions $1 $3 }
|
||||
|
||||
ListParConstr :: { [Param] }
|
||||
ListParConstr
|
||||
: ParConstr { [$1] }
|
||||
| ParConstr '|' ListParConstr { $1 : $3 }
|
||||
|
||||
ListIdent :: { [Ident] }
|
||||
ListIdent
|
||||
: Ident { [$1] }
|
||||
| Ident ',' ListIdent { $1 : $3 }
|
||||
|
||||
Name :: { Ident }
|
||||
Name
|
||||
: Ident { $1 }
|
||||
| '[' Ident ']' { mkListId $2 }
|
||||
|
||||
ListName :: { [Ident] }
|
||||
ListName
|
||||
: Name { [$1] }
|
||||
| Name ',' ListName { $1 : $3 }
|
||||
|
||||
LocDef :: { [(Ident, Maybe Type, Maybe Term)] }
|
||||
LocDef
|
||||
: ListIdent ':' Exp { [(lab,Just $3,Nothing) | lab <- $1] }
|
||||
| ListIdent '=' Exp { [(lab,Nothing,Just $3) | lab <- $1] }
|
||||
| ListIdent ':' Exp '=' Exp { [(lab,Just $3,Just $5) | lab <- $1] }
|
||||
|
||||
ListLocDef :: { [(Ident, Maybe Type, Maybe Term)] }
|
||||
ListLocDef
|
||||
: {- empty -} { [] }
|
||||
| LocDef { $1 }
|
||||
| LocDef ';' ListLocDef { $1 ++ $3 }
|
||||
|
||||
Exp :: { Term }
|
||||
Exp
|
||||
: Exp1 '|' Exp { FV [$1,$3] }
|
||||
| '\\' ListBind '->' Exp { mkAbs $2 $4 }
|
||||
| '\\\\' ListBind '=>' Exp { mkCTable $2 $4 }
|
||||
| Decl '->' Exp { mkProdSimple $1 $3 }
|
||||
| Exp3 '=>' Exp { Table $1 $3 }
|
||||
| 'let' '{' ListLocDef '}' 'in' Exp {%
|
||||
do defs <- mapM tryLoc $3
|
||||
return $ mkLet defs $6 }
|
||||
| 'let' ListLocDef 'in' Exp {%
|
||||
do defs <- mapM tryLoc $2
|
||||
return $ mkLet defs $4 }
|
||||
| Exp3 'where' '{' ListLocDef '}' {%
|
||||
do defs <- mapM tryLoc $4
|
||||
return $ mkLet defs $1 }
|
||||
| 'fn' '{' ListEquation '}' { Eqs $3 }
|
||||
| 'in' Exp5 String { Example $2 $3 }
|
||||
| Exp1 { $1 }
|
||||
|
||||
Exp1 :: { Term }
|
||||
Exp1
|
||||
: Exp2 '++' Exp1 { C $1 $3 }
|
||||
| Exp2 { $1 }
|
||||
|
||||
Exp2 :: { Term }
|
||||
Exp2
|
||||
: Exp3 '+' Exp2 { Glue $1 $3 }
|
||||
| Exp3 { $1 }
|
||||
|
||||
Exp3 :: { Term }
|
||||
Exp3
|
||||
: Exp3 '!' Exp4 { S $1 $3 }
|
||||
| 'table' '{' ListCase '}' { T TRaw $3 }
|
||||
| 'table' Exp6 '{' ListCase '}' { T (TTyped $2) $4 }
|
||||
| 'table' Exp6 '[' ListExp ']' { V $2 $4 }
|
||||
| Exp3 '*' Exp4 { case $1 of
|
||||
RecType xs -> RecType (xs ++ [(tupleLabel (length xs+1),$3)])
|
||||
t -> RecType [(tupleLabel 1,$1), (tupleLabel 2,$3)] }
|
||||
| Exp3 '**' Exp4 { ExtR $1 $3 }
|
||||
| Exp4 { $1 }
|
||||
|
||||
Exp4 :: { Term }
|
||||
Exp4
|
||||
: Exp4 Exp5 { App $1 $2 }
|
||||
| 'case' Exp 'of' '{' ListCase '}' { let annot = case $2 of
|
||||
Typed _ t -> TTyped t
|
||||
_ -> TRaw
|
||||
in S (T annot $5) $2 }
|
||||
| 'variants' '{' ListExp '}' { FV $3 }
|
||||
| 'pre' '{' Exp ';' ListAltern '}' { Alts ($3, $5) }
|
||||
| 'strs' '{' ListExp '}' { Strs $3 }
|
||||
| '#' Patt2 { EPatt $2 }
|
||||
| 'pattern' Exp5 { EPattType $2 }
|
||||
| Exp5 { $1 }
|
||||
|
||||
Exp5 :: { Term }
|
||||
Exp5
|
||||
: Exp5 '.' Label { P $1 $3 }
|
||||
| Exp6 { $1 }
|
||||
|
||||
Exp6 :: { Term }
|
||||
Exp6
|
||||
: Ident { Vr $1 }
|
||||
| Sort { Sort $1 }
|
||||
| String { K $1 }
|
||||
| Integer { EInt $1 }
|
||||
| Double { EFloat $1 }
|
||||
| '?' { Meta (int2meta 0) }
|
||||
| '[' ']' { Empty }
|
||||
| 'data' { EData }
|
||||
| '[' Ident Exps ']' { foldl App (Vr (mkListId $2)) $3 }
|
||||
| '[' String ']' { case $2 of
|
||||
[] -> Empty
|
||||
str -> foldr1 C (map K (words str)) }
|
||||
| '{' ListLocDef '}' {% mkR $2 }
|
||||
| '<' ListTupleComp '>' { R (tuple2record $2) }
|
||||
| '<' Exp ':' Exp '>' { Typed $2 $4 }
|
||||
| LString { K $1 }
|
||||
| '(' Exp ')' { $2 }
|
||||
|
||||
ListExp :: { [Term] }
|
||||
ListExp
|
||||
: {- empty -} { [] }
|
||||
| Exp { [$1] }
|
||||
| Exp ';' ListExp { $1 : $3 }
|
||||
|
||||
Exps :: { [Term] }
|
||||
Exps
|
||||
: {- empty -} { [] }
|
||||
| Exp6 Exps { $1 : $2 }
|
||||
|
||||
Patt :: { Patt }
|
||||
Patt
|
||||
: Patt '|' Patt1 { PAlt $1 $3 }
|
||||
| Patt '+' Patt1 { PSeq $1 $3 }
|
||||
| Patt1 { $1 }
|
||||
|
||||
Patt1 :: { Patt }
|
||||
Patt1
|
||||
: Ident ListPatt { PC $1 $2 }
|
||||
| Ident '.' Ident ListPatt { PP $1 $3 $4 }
|
||||
| Patt2 '*' { PRep $1 }
|
||||
| Ident '@' Patt2 { PAs $1 $3 }
|
||||
| '-' Patt2 { PNeg $2 }
|
||||
| Patt2 { $1 }
|
||||
|
||||
Patt2 :: { Patt }
|
||||
Patt2
|
||||
: '?' { PChar }
|
||||
| '[' String ']' { PChars $2 }
|
||||
| '#' Ident { PMacro $2 }
|
||||
| '#' Ident '.' Ident { PM $2 $4 }
|
||||
| '_' { wildPatt }
|
||||
| Ident { PV $1 }
|
||||
| '{' Ident '}' { PC $2 [] }
|
||||
| Ident '.' Ident { PP $1 $3 [] }
|
||||
| Integer { PInt $1 }
|
||||
| Double { PFloat $1 }
|
||||
| String { PString $1 }
|
||||
| '{' ListPattAss '}' { PR $2 }
|
||||
| '<' ListPattTupleComp '>' { (PR . tuple2recordPatt) $2 }
|
||||
| '(' Patt ')' { $2 }
|
||||
|
||||
Arg :: { Ident }
|
||||
Arg
|
||||
: '_' { identW }
|
||||
| Ident { $1 }
|
||||
|
||||
PattAss :: { [(Label,Patt)] }
|
||||
PattAss
|
||||
: ListIdent '=' Patt { [(LIdent (ident2bs i),$3) | i <- $1] }
|
||||
|
||||
Label :: { Label }
|
||||
Label
|
||||
: Ident { LIdent (ident2bs $1) }
|
||||
| '$' Integer { LVar (fromIntegral $2) }
|
||||
|
||||
Sort :: { Ident }
|
||||
Sort
|
||||
: 'Type' { cType }
|
||||
| 'PType' { cPType }
|
||||
| 'Tok' { cTok }
|
||||
| 'Str' { cStr }
|
||||
| 'Strs' { cStrs }
|
||||
|
||||
ListPattAss :: { [(Label,Patt)] }
|
||||
ListPattAss
|
||||
: {- empty -} { [] }
|
||||
| PattAss { $1 }
|
||||
| PattAss ';' ListPattAss { $1 ++ $3 }
|
||||
|
||||
ListPatt :: { [Patt] }
|
||||
ListPatt
|
||||
: Patt2 { [$1] }
|
||||
| Patt2 ListPatt { $1 : $2 }
|
||||
|
||||
ListArg :: { [Ident] }
|
||||
ListArg
|
||||
: Arg { [$1] }
|
||||
| Arg ListArg { $1 : $2 }
|
||||
|
||||
Bind :: { Ident }
|
||||
Bind
|
||||
: Ident { $1 }
|
||||
| '_' { identW }
|
||||
|
||||
ListBind :: { [Ident] }
|
||||
ListBind
|
||||
: Bind { [$1] }
|
||||
| Bind ',' ListBind { $1 : $3 }
|
||||
|
||||
Decl :: { [Decl] }
|
||||
Decl
|
||||
: '(' ListBind ':' Exp ')' { [(x,$4) | x <- $2] }
|
||||
| Exp4 { [mkDecl $1] }
|
||||
|
||||
ListTupleComp :: { [Term] }
|
||||
ListTupleComp
|
||||
: {- empty -} { [] }
|
||||
| Exp { [$1] }
|
||||
| Exp ',' ListTupleComp { $1 : $3 }
|
||||
|
||||
ListPattTupleComp :: { [Patt] }
|
||||
ListPattTupleComp
|
||||
: {- empty -} { [] }
|
||||
| Patt { [$1] }
|
||||
| Patt ',' ListPattTupleComp { $1 : $3 }
|
||||
|
||||
Case :: { Case }
|
||||
Case
|
||||
: Patt '=>' Exp { ($1,$3) }
|
||||
|
||||
ListCase :: { [Case] }
|
||||
ListCase
|
||||
: Case { [$1] }
|
||||
| Case ';' ListCase { $1 : $3 }
|
||||
|
||||
Equation :: { Equation }
|
||||
Equation
|
||||
: ListPatt '->' Exp { ($1,$3) }
|
||||
|
||||
ListEquation :: { [Equation] }
|
||||
ListEquation
|
||||
: Equation { (:[]) $1 }
|
||||
| Equation ';' ListEquation { (:) $1 $3 }
|
||||
|
||||
Altern :: { (Term,Term) }
|
||||
Altern
|
||||
: Exp '/' Exp { ($1,$3) }
|
||||
|
||||
ListAltern :: { [(Term,Term)] }
|
||||
ListAltern
|
||||
: Altern { [$1] }
|
||||
| Altern ';' ListAltern { $1 : $3 }
|
||||
|
||||
DDecl :: { [Decl] }
|
||||
DDecl
|
||||
: '(' ListBind ':' Exp ')' { [(x,$4) | x <- $2] }
|
||||
| Exp6 { [mkDecl $1] }
|
||||
|
||||
ListDDecl :: { [Decl] }
|
||||
ListDDecl
|
||||
: {- empty -} { [] }
|
||||
| DDecl ListDDecl { $1 ++ $2 }
|
||||
|
||||
Posn :: { Posn }
|
||||
Posn
|
||||
: {- empty -} {% getPosn }
|
||||
|
||||
|
||||
{
|
||||
|
||||
happyError :: P a
|
||||
happyError = fail "parse error"
|
||||
|
||||
mkListId,mkConsId,mkBaseId :: Ident -> Ident
|
||||
mkListId = prefixId (BS.pack "List")
|
||||
mkConsId = prefixId (BS.pack "Cons")
|
||||
mkBaseId = prefixId (BS.pack "Base")
|
||||
|
||||
prefixId :: BS.ByteString -> Ident -> Ident
|
||||
prefixId pref id = identC (BS.append pref (ident2bs id))
|
||||
|
||||
listCatDef id pos cont size = [catd,nilfund,consfund]
|
||||
where
|
||||
listId = mkListId id
|
||||
baseId = mkBaseId id
|
||||
consId = mkConsId id
|
||||
|
||||
catd = (listId, pos, AbsCat (Just cont') (Just [Cn baseId,Cn consId]))
|
||||
nilfund = (baseId, pos, AbsFun (Just niltyp) (Just EData))
|
||||
consfund = (consId, pos, AbsFun (Just constyp) (Just EData))
|
||||
|
||||
cont' = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont]
|
||||
xs = map (Vr . fst) cont'
|
||||
cd = mkDecl (mkApp (Vr id) xs)
|
||||
lc = mkApp (Vr listId) xs
|
||||
|
||||
niltyp = mkProdSimple (cont' ++ replicate size cd) lc
|
||||
constyp = mkProdSimple (cont' ++ [cd, mkDecl lc]) lc
|
||||
|
||||
mkId x i = if isWildIdent x then (varX i) else x
|
||||
|
||||
tryLoc (c,mty,Just e) = return (c,(mty,e))
|
||||
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ prIdent c +++ "without value")
|
||||
|
||||
mkR [] = return $ RecType [] --- empty record always interpreted as record type
|
||||
mkR fs@(f:_) =
|
||||
case f of
|
||||
(lab,Just ty,Nothing) -> mapM tryRT fs >>= return . RecType
|
||||
_ -> mapM tryR fs >>= return . R
|
||||
where
|
||||
tryRT (lab,Just ty,Nothing) = return (ident2label lab,ty)
|
||||
tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ prIdent lab --- manifest fields ?!
|
||||
|
||||
tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))
|
||||
tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ prIdent lab
|
||||
|
||||
mkOverload pdt pdf@(Just df) =
|
||||
case appForm df of
|
||||
(keyw, ts@(_:_)) | isOverloading keyw ->
|
||||
case last ts of
|
||||
R fs -> [ResOverload [m | Vr m <- ts] [(ty,fu) | (_,(Just ty,fu)) <- fs]]
|
||||
_ -> [ResOper pdt pdf]
|
||||
_ -> [ResOper pdt pdf]
|
||||
|
||||
-- to enable separare type signature --- not type-checked
|
||||
mkOverload pdt@(Just df) pdf =
|
||||
case appForm df of
|
||||
(keyw, ts@(_:_)) | isOverloading keyw ->
|
||||
case last ts of
|
||||
RecType _ -> []
|
||||
_ -> [ResOper pdt pdf]
|
||||
_ -> [ResOper pdt pdf]
|
||||
mkOverload pdt pdf = [ResOper pdt pdf]
|
||||
|
||||
isOverloading t =
|
||||
case t of
|
||||
Vr keyw | prIdent keyw == "overload" -> True -- overload is a "soft keyword"
|
||||
_ -> False
|
||||
|
||||
|
||||
type SrcSpan = (Posn,Posn)
|
||||
|
||||
|
||||
checkInfoType MTAbstract (id,pos,info) =
|
||||
case info of
|
||||
AbsCat _ _ -> return ()
|
||||
AbsFun _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in abstract module"
|
||||
checkInfoType MTResource (id,pos,info) =
|
||||
case info of
|
||||
ResParam _ -> return ()
|
||||
ResValue _ -> return ()
|
||||
ResOper _ _ -> return ()
|
||||
ResOverload _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in resource module"
|
||||
checkInfoType MTInterface (id,pos,info) =
|
||||
case info of
|
||||
ResParam _ -> return ()
|
||||
ResValue _ -> return ()
|
||||
ResOper _ _ -> return ()
|
||||
ResOverload _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in interface module"
|
||||
checkInfoType (MTConcrete _) (id,pos,info) =
|
||||
case info of
|
||||
CncCat _ _ _ -> return ()
|
||||
CncFun _ _ _ -> return ()
|
||||
ResParam _ -> return ()
|
||||
ResValue _ -> return ()
|
||||
ResOper _ _ -> return ()
|
||||
ResOverload _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in concrete module"
|
||||
checkInfoType (MTInstance _) (id,pos,info) =
|
||||
case info of
|
||||
ResParam _ -> return ()
|
||||
ResValue _ -> return ()
|
||||
ResOper _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in instance module"
|
||||
checkInfoType (MTTransfer _ _) (id,pos,info) =
|
||||
case info of
|
||||
AbsCat _ _ -> return ()
|
||||
AbsFun _ _ -> return ()
|
||||
_ -> failLoc (fst pos) "illegal definition in transfer module"
|
||||
|
||||
}
|
||||
|
||||
@@ -1,44 +0,0 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : ReservedWords
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:28 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- reserved words of GF. (c) Aarne Ranta 19\/3\/2002 under Gnu GPL.
|
||||
-- modified by Markus Forsberg 9\/4.
|
||||
-- modified by AR 12\/6\/2003 for GF2 and GFC
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Grammar.ReservedWords (isResWord, isResWordGFC) where
|
||||
|
||||
import Data.List
|
||||
|
||||
|
||||
isResWord :: String -> Bool
|
||||
isResWord s = isInTree s resWordTree
|
||||
|
||||
resWordTree :: BTree
|
||||
resWordTree =
|
||||
-- mapTree fst $ sorted2tree $ flip zip (repeat ()) $ sort allReservedWords
|
||||
-- nowadays obtained from LexGF.hs
|
||||
B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N))))
|
||||
|
||||
isResWordGFC :: String -> Bool
|
||||
isResWordGFC s = isInTree s $
|
||||
B "of" (B "fun" (B "concrete" (B "cat" (B "abstract" N N) N) (B "flags" N N)) (B "lin" (B "in" N N) (B "lincat" N N))) (B "resource" (B "param" (B "oper" (B "open" N N) N) (B "pre" N N)) (B "table" (B "strs" N N) (B "variants" N N)))
|
||||
|
||||
data BTree = N | B String BTree BTree deriving (Show)
|
||||
|
||||
isInTree :: String -> BTree -> Bool
|
||||
isInTree x tree = case tree of
|
||||
N -> False
|
||||
B a left right
|
||||
| x < a -> isInTree x left
|
||||
| x > a -> isInTree x right
|
||||
| x == a -> True
|
||||
|
||||
@@ -175,9 +175,3 @@ putPointE v opts msg act = do
|
||||
else when (verbAtLeast opts v) $ putStrLnE ""
|
||||
|
||||
return a
|
||||
|
||||
|
||||
-- ((do {s <- readFile f; return (return s)}) )
|
||||
readFileIOE :: FilePath -> IOE BS.ByteString
|
||||
readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
|
||||
(\e -> return (Bad (show e)))
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1,144 +0,0 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.Source.LexGF where
|
||||
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
|
||||
(\_ | $l)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: BS.ByteString -> BS.ByteString
|
||||
share = id
|
||||
|
||||
data Tok =
|
||||
TS !BS.ByteString !Int -- reserved words and symbols
|
||||
| TL !BS.ByteString -- string literals
|
||||
| TI !BS.ByteString -- integer literals
|
||||
| TV !BS.ByteString -- identifiers
|
||||
| TD !BS.ByteString -- double precision float literals
|
||||
| TC !BS.ByteString -- character literals
|
||||
| T_LString !BS.ByteString
|
||||
| T_PIdent !BS.ByteString
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s _) -> s
|
||||
PT _ (TL s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
PT _ (T_LString s) -> s
|
||||
PT _ (T_PIdent s) -> s
|
||||
|
||||
|
||||
data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "def" 39 (b "=>" 20 (b "++" 10 (b "(" 5 (b "$" 3 (b "#" 2 (b "!" 1 N N) N) (b "%" 4 N N)) (b "**" 8 (b "*" 7 (b ")" 6 N N) N) (b "+" 9 N N))) (b "/" 15 (b "->" 13 (b "-" 12 (b "," 11 N N) N) (b "." 14 N N)) (b "<" 18 (b ";" 17 (b ":" 16 N N) N) (b "=" 19 N N)))) (b "[" 30 (b "PType" 25 (b "@" 23 (b "?" 22 (b ">" 21 N N) N) (b "Lin" 24 N N)) (b "Tok" 28 (b "Strs" 27 (b "Str" 26 N N) N) (b "Type" 29 N N))) (b "case" 35 (b "_" 33 (b "]" 32 (b "\\" 31 N N) N) (b "abstract" 34 N N)) (b "concrete" 37 (b "cat" 36 N N) (b "data" 38 N N))))) (b "package" 58 (b "let" 49 (b "in" 44 (b "fun" 42 (b "fn" 41 (b "flags" 40 N N) N) (b "grammar" 43 N N)) (b "instance" 47 (b "incomplete" 46 (b "include" 45 N N) N) (b "interface" 48 N N))) (b "of" 54 (b "lindef" 52 (b "lincat" 51 (b "lin" 50 N N) N) (b "lintype" 53 N N)) (b "oper" 56 (b "open" 55 N N) (b "out" 57 N N)))) (b "transfer" 68 (b "resource" 63 (b "pre" 61 (b "pattern" 60 (b "param" 59 N N) N) (b "printname" 62 N N)) (b "table" 66 (b "strs" 65 (b "reuse" 64 N N) N) (b "tokenizer" 67 N N))) (b "with" 73 (b "variants" 71 (b "var" 70 (b "union" 69 N N) N) (b "where" 72 N N)) (b "|" 75 (b "{" 74 N N) (b "}" 76 N N)))))
|
||||
where b s n = let bs = BS.pack s
|
||||
in B bs (TS bs n)
|
||||
|
||||
unescapeInitTail :: BS.ByteString -> BS.ByteString
|
||||
unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
BS.ByteString) -- current input string
|
||||
|
||||
tokens :: BS.ByteString -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: AlexInput -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> [Err pos]
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, _, s) =
|
||||
case BS.uncons s of
|
||||
Nothing -> Nothing
|
||||
Just (c,s) ->
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
File diff suppressed because one or more lines are too long
@@ -1,643 +0,0 @@
|
||||
-- This Happy file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
|
||||
module GF.Source.ParGF where
|
||||
import GF.Source.AbsGF
|
||||
import GF.Source.LexGF
|
||||
import GF.Data.ErrM
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
}
|
||||
|
||||
%name pGrammar Grammar
|
||||
%name pModDef ModDef
|
||||
%name pOldGrammar OldGrammar
|
||||
%partial pModHeader ModHeader
|
||||
%name pExp Exp
|
||||
|
||||
-- no lexer declaration
|
||||
%monad { Err } { thenM } { returnM }
|
||||
%tokentype { Token }
|
||||
|
||||
%token
|
||||
'!' { PT _ (TS _ 1) }
|
||||
'#' { PT _ (TS _ 2) }
|
||||
'$' { PT _ (TS _ 3) }
|
||||
'%' { PT _ (TS _ 4) }
|
||||
'(' { PT _ (TS _ 5) }
|
||||
')' { PT _ (TS _ 6) }
|
||||
'*' { PT _ (TS _ 7) }
|
||||
'**' { PT _ (TS _ 8) }
|
||||
'+' { PT _ (TS _ 9) }
|
||||
'++' { PT _ (TS _ 10) }
|
||||
',' { PT _ (TS _ 11) }
|
||||
'-' { PT _ (TS _ 12) }
|
||||
'->' { PT _ (TS _ 13) }
|
||||
'.' { PT _ (TS _ 14) }
|
||||
'/' { PT _ (TS _ 15) }
|
||||
':' { PT _ (TS _ 16) }
|
||||
';' { PT _ (TS _ 17) }
|
||||
'<' { PT _ (TS _ 18) }
|
||||
'=' { PT _ (TS _ 19) }
|
||||
'=>' { PT _ (TS _ 20) }
|
||||
'>' { PT _ (TS _ 21) }
|
||||
'?' { PT _ (TS _ 22) }
|
||||
'@' { PT _ (TS _ 23) }
|
||||
'Lin' { PT _ (TS _ 24) }
|
||||
'PType' { PT _ (TS _ 25) }
|
||||
'Str' { PT _ (TS _ 26) }
|
||||
'Strs' { PT _ (TS _ 27) }
|
||||
'Tok' { PT _ (TS _ 28) }
|
||||
'Type' { PT _ (TS _ 29) }
|
||||
'[' { PT _ (TS _ 30) }
|
||||
'\\' { PT _ (TS _ 31) }
|
||||
']' { PT _ (TS _ 32) }
|
||||
'_' { PT _ (TS _ 33) }
|
||||
'abstract' { PT _ (TS _ 34) }
|
||||
'case' { PT _ (TS _ 35) }
|
||||
'cat' { PT _ (TS _ 36) }
|
||||
'concrete' { PT _ (TS _ 37) }
|
||||
'data' { PT _ (TS _ 38) }
|
||||
'def' { PT _ (TS _ 39) }
|
||||
'flags' { PT _ (TS _ 40) }
|
||||
'fn' { PT _ (TS _ 41) }
|
||||
'fun' { PT _ (TS _ 42) }
|
||||
'grammar' { PT _ (TS _ 43) }
|
||||
'in' { PT _ (TS _ 44) }
|
||||
'include' { PT _ (TS _ 45) }
|
||||
'incomplete' { PT _ (TS _ 46) }
|
||||
'instance' { PT _ (TS _ 47) }
|
||||
'interface' { PT _ (TS _ 48) }
|
||||
'let' { PT _ (TS _ 49) }
|
||||
'lin' { PT _ (TS _ 50) }
|
||||
'lincat' { PT _ (TS _ 51) }
|
||||
'lindef' { PT _ (TS _ 52) }
|
||||
'lintype' { PT _ (TS _ 53) }
|
||||
'of' { PT _ (TS _ 54) }
|
||||
'open' { PT _ (TS _ 55) }
|
||||
'oper' { PT _ (TS _ 56) }
|
||||
'out' { PT _ (TS _ 57) }
|
||||
'package' { PT _ (TS _ 58) }
|
||||
'param' { PT _ (TS _ 59) }
|
||||
'pattern' { PT _ (TS _ 60) }
|
||||
'pre' { PT _ (TS _ 61) }
|
||||
'printname' { PT _ (TS _ 62) }
|
||||
'resource' { PT _ (TS _ 63) }
|
||||
'reuse' { PT _ (TS _ 64) }
|
||||
'strs' { PT _ (TS _ 65) }
|
||||
'table' { PT _ (TS _ 66) }
|
||||
'tokenizer' { PT _ (TS _ 67) }
|
||||
'transfer' { PT _ (TS _ 68) }
|
||||
'union' { PT _ (TS _ 69) }
|
||||
'var' { PT _ (TS _ 70) }
|
||||
'variants' { PT _ (TS _ 71) }
|
||||
'where' { PT _ (TS _ 72) }
|
||||
'with' { PT _ (TS _ 73) }
|
||||
'{' { PT _ (TS _ 74) }
|
||||
'|' { PT _ (TS _ 75) }
|
||||
'}' { PT _ (TS _ 76) }
|
||||
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_doubl { PT _ (TD $$) }
|
||||
L_LString { PT _ (T_LString $$) }
|
||||
L_PIdent { PT _ (T_PIdent _) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
Integer :: { Integer } : L_integ { (read (BS.unpack $1)) :: Integer }
|
||||
String :: { String } : L_quoted { BS.unpack $1 }
|
||||
Double :: { Double } : L_doubl { (read (BS.unpack $1)) :: Double }
|
||||
LString :: { LString} : L_LString { LString ($1)}
|
||||
PIdent :: { PIdent} : L_PIdent { PIdent (mkPosToken $1)}
|
||||
|
||||
Grammar :: { Grammar }
|
||||
Grammar : ListModDef { Gr (reverse $1) }
|
||||
|
||||
|
||||
ListModDef :: { [ModDef] }
|
||||
ListModDef : {- empty -} { [] }
|
||||
| ListModDef ModDef { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ModDef :: { ModDef }
|
||||
ModDef : ModDef ';' { $1 }
|
||||
| 'grammar' PIdent '=' '{' 'abstract' '=' PIdent ';' ListConcSpec '}' { MMain $2 $7 $9 }
|
||||
| ComplMod ModType '=' ModBody { MModule $1 $2 $4 }
|
||||
|
||||
|
||||
ConcSpec :: { ConcSpec }
|
||||
ConcSpec : PIdent '=' ConcExp { ConcSpec $1 $3 }
|
||||
|
||||
|
||||
ListConcSpec :: { [ConcSpec] }
|
||||
ListConcSpec : {- empty -} { [] }
|
||||
| ConcSpec { (:[]) $1 }
|
||||
| ConcSpec ';' ListConcSpec { (:) $1 $3 }
|
||||
|
||||
|
||||
ConcExp :: { ConcExp }
|
||||
ConcExp : PIdent ListTransfer { ConcExp $1 (reverse $2) }
|
||||
|
||||
|
||||
ListTransfer :: { [Transfer] }
|
||||
ListTransfer : {- empty -} { [] }
|
||||
| ListTransfer Transfer { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Transfer :: { Transfer }
|
||||
Transfer : '(' 'transfer' 'in' Open ')' { TransferIn $4 }
|
||||
| '(' 'transfer' 'out' Open ')' { TransferOut $4 }
|
||||
|
||||
|
||||
ModHeader :: { ModHeader }
|
||||
ModHeader : ComplMod ModType '=' ModHeaderBody { MModule2 $1 $2 $4 }
|
||||
|
||||
|
||||
ModHeaderBody :: { ModHeaderBody }
|
||||
ModHeaderBody : Extend Opens { MBody2 $1 $2 }
|
||||
| ListIncluded { MNoBody2 $1 }
|
||||
| Included 'with' ListOpen { MWith2 $1 $3 }
|
||||
| Included 'with' ListOpen '**' Opens { MWithBody2 $1 $3 $5 }
|
||||
| ListIncluded '**' Included 'with' ListOpen { MWithE2 $1 $3 $5 }
|
||||
| ListIncluded '**' Included 'with' ListOpen '**' Opens { MWithEBody2 $1 $3 $5 $7 }
|
||||
| 'reuse' PIdent { MReuse2 $2 }
|
||||
| 'union' ListIncluded { MUnion2 $2 }
|
||||
|
||||
|
||||
ModType :: { ModType }
|
||||
ModType : 'abstract' PIdent { MTAbstract $2 }
|
||||
| 'resource' PIdent { MTResource $2 }
|
||||
| 'interface' PIdent { MTInterface $2 }
|
||||
| 'concrete' PIdent 'of' PIdent { MTConcrete $2 $4 }
|
||||
| 'instance' PIdent 'of' PIdent { MTInstance $2 $4 }
|
||||
| 'transfer' PIdent ':' Open '->' Open { MTTransfer $2 $4 $6 }
|
||||
|
||||
|
||||
ModBody :: { ModBody }
|
||||
ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) }
|
||||
| ListIncluded { MNoBody $1 }
|
||||
| Included 'with' ListOpen { MWith $1 $3 }
|
||||
| Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithBody $1 $3 $5 (reverse $7) }
|
||||
| ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
|
||||
| ListIncluded '**' Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithEBody $1 $3 $5 $7 (reverse $9) }
|
||||
| 'reuse' PIdent { MReuse $2 }
|
||||
| 'union' ListIncluded { MUnion $2 }
|
||||
|
||||
|
||||
ListTopDef :: { [TopDef] }
|
||||
ListTopDef : {- empty -} { [] }
|
||||
| ListTopDef TopDef { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Extend :: { Extend }
|
||||
Extend : ListIncluded '**' { Ext $1 }
|
||||
| {- empty -} { NoExt }
|
||||
|
||||
|
||||
ListOpen :: { [Open] }
|
||||
ListOpen : {- empty -} { [] }
|
||||
| Open { (:[]) $1 }
|
||||
| Open ',' ListOpen { (:) $1 $3 }
|
||||
|
||||
|
||||
Opens :: { Opens }
|
||||
Opens : {- empty -} { NoOpens }
|
||||
| 'open' ListOpen 'in' { OpenIn $2 }
|
||||
|
||||
|
||||
Open :: { Open }
|
||||
Open : PIdent { OName $1 }
|
||||
| '(' QualOpen PIdent ')' { OQualQO $2 $3 }
|
||||
| '(' QualOpen PIdent '=' PIdent ')' { OQual $2 $3 $5 }
|
||||
|
||||
|
||||
ComplMod :: { ComplMod }
|
||||
ComplMod : {- empty -} { CMCompl }
|
||||
| 'incomplete' { CMIncompl }
|
||||
|
||||
|
||||
QualOpen :: { QualOpen }
|
||||
QualOpen : {- empty -} { QOCompl }
|
||||
| 'incomplete' { QOIncompl }
|
||||
| 'interface' { QOInterface }
|
||||
|
||||
|
||||
ListIncluded :: { [Included] }
|
||||
ListIncluded : {- empty -} { [] }
|
||||
| Included { (:[]) $1 }
|
||||
| Included ',' ListIncluded { (:) $1 $3 }
|
||||
|
||||
|
||||
Included :: { Included }
|
||||
Included : PIdent { IAll $1 }
|
||||
| PIdent '[' ListPIdent ']' { ISome $1 $3 }
|
||||
| PIdent '-' '[' ListPIdent ']' { IMinus $1 $4 }
|
||||
|
||||
|
||||
Def :: { Def }
|
||||
Def : ListName ':' Exp { DDecl $1 $3 }
|
||||
| ListName '=' Exp { DDef $1 $3 }
|
||||
| Name ListPatt '=' Exp { DPatt $1 $2 $4 }
|
||||
| ListName ':' Exp '=' Exp { DFull $1 $3 $5 }
|
||||
|
||||
|
||||
TopDef :: { TopDef }
|
||||
TopDef : 'cat' ListCatDef { DefCat $2 }
|
||||
| 'fun' ListFunDef { DefFun $2 }
|
||||
| 'data' ListFunDef { DefFunData $2 }
|
||||
| 'def' ListDef { DefDef $2 }
|
||||
| 'data' ListDataDef { DefData $2 }
|
||||
| 'transfer' ListDef { DefTrans $2 }
|
||||
| 'param' ListParDef { DefPar $2 }
|
||||
| 'oper' ListDef { DefOper $2 }
|
||||
| 'lincat' ListPrintDef { DefLincat $2 }
|
||||
| 'lindef' ListDef { DefLindef $2 }
|
||||
| 'lin' ListDef { DefLin $2 }
|
||||
| 'printname' 'cat' ListPrintDef { DefPrintCat $3 }
|
||||
| 'printname' 'fun' ListPrintDef { DefPrintFun $3 }
|
||||
| 'flags' ListFlagDef { DefFlag $2 }
|
||||
| 'printname' ListPrintDef { DefPrintOld $2 }
|
||||
| 'lintype' ListDef { DefLintype $2 }
|
||||
| 'pattern' ListDef { DefPattern $2 }
|
||||
| 'package' PIdent '=' '{' ListTopDef '}' ';' { DefPackage $2 (reverse $5) }
|
||||
| 'var' ListDef { DefVars $2 }
|
||||
| 'tokenizer' PIdent ';' { DefTokenizer $2 }
|
||||
|
||||
|
||||
CatDef :: { CatDef }
|
||||
CatDef : PIdent ListDDecl { SimpleCatDef $1 (reverse $2) }
|
||||
| '[' PIdent ListDDecl ']' { ListCatDef $2 (reverse $3) }
|
||||
| '[' PIdent ListDDecl ']' '{' Integer '}' { ListSizeCatDef $2 (reverse $3) $6 }
|
||||
|
||||
|
||||
FunDef :: { FunDef }
|
||||
FunDef : ListPIdent ':' Exp { FunDef $1 $3 }
|
||||
|
||||
|
||||
DataDef :: { DataDef }
|
||||
DataDef : PIdent '=' ListDataConstr { DataDef $1 $3 }
|
||||
|
||||
|
||||
DataConstr :: { DataConstr }
|
||||
DataConstr : PIdent { DataId $1 }
|
||||
| PIdent '.' PIdent { DataQId $1 $3 }
|
||||
|
||||
|
||||
ListDataConstr :: { [DataConstr] }
|
||||
ListDataConstr : {- empty -} { [] }
|
||||
| DataConstr { (:[]) $1 }
|
||||
| DataConstr '|' ListDataConstr { (:) $1 $3 }
|
||||
|
||||
|
||||
ParDef :: { ParDef }
|
||||
ParDef : PIdent '=' ListParConstr { ParDefDir $1 $3 }
|
||||
| PIdent '=' '(' 'in' PIdent ')' { ParDefIndir $1 $5 }
|
||||
| PIdent { ParDefAbs $1 }
|
||||
|
||||
|
||||
ParConstr :: { ParConstr }
|
||||
ParConstr : PIdent ListDDecl { ParConstr $1 (reverse $2) }
|
||||
|
||||
|
||||
PrintDef :: { PrintDef }
|
||||
PrintDef : ListName '=' Exp { PrintDef $1 $3 }
|
||||
|
||||
|
||||
FlagDef :: { FlagDef }
|
||||
FlagDef : PIdent '=' PIdent { FlagDef $1 $3 }
|
||||
|
||||
|
||||
ListDef :: { [Def] }
|
||||
ListDef : Def ';' { (:[]) $1 }
|
||||
| Def ';' ListDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListCatDef :: { [CatDef] }
|
||||
ListCatDef : CatDef ';' { (:[]) $1 }
|
||||
| CatDef ';' ListCatDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListFunDef :: { [FunDef] }
|
||||
ListFunDef : FunDef ';' { (:[]) $1 }
|
||||
| FunDef ';' ListFunDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListDataDef :: { [DataDef] }
|
||||
ListDataDef : DataDef ';' { (:[]) $1 }
|
||||
| DataDef ';' ListDataDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListParDef :: { [ParDef] }
|
||||
ListParDef : ParDef ';' { (:[]) $1 }
|
||||
| ParDef ';' ListParDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPrintDef :: { [PrintDef] }
|
||||
ListPrintDef : PrintDef ';' { (:[]) $1 }
|
||||
| PrintDef ';' ListPrintDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListFlagDef :: { [FlagDef] }
|
||||
ListFlagDef : FlagDef ';' { (:[]) $1 }
|
||||
| FlagDef ';' ListFlagDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListParConstr :: { [ParConstr] }
|
||||
ListParConstr : {- empty -} { [] }
|
||||
| ParConstr { (:[]) $1 }
|
||||
| ParConstr '|' ListParConstr { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPIdent :: { [PIdent] }
|
||||
ListPIdent : PIdent { (:[]) $1 }
|
||||
| PIdent ',' ListPIdent { (:) $1 $3 }
|
||||
|
||||
|
||||
Name :: { Name }
|
||||
Name : PIdent { IdentName $1 }
|
||||
| '[' PIdent ']' { ListName $2 }
|
||||
|
||||
|
||||
ListName :: { [Name] }
|
||||
ListName : Name { (:[]) $1 }
|
||||
| Name ',' ListName { (:) $1 $3 }
|
||||
|
||||
|
||||
LocDef :: { LocDef }
|
||||
LocDef : ListPIdent ':' Exp { LDDecl $1 $3 }
|
||||
| ListPIdent '=' Exp { LDDef $1 $3 }
|
||||
| ListPIdent ':' Exp '=' Exp { LDFull $1 $3 $5 }
|
||||
|
||||
|
||||
ListLocDef :: { [LocDef] }
|
||||
ListLocDef : {- empty -} { [] }
|
||||
| LocDef { (:[]) $1 }
|
||||
| LocDef ';' ListLocDef { (:) $1 $3 }
|
||||
|
||||
|
||||
Exp6 :: { Exp }
|
||||
Exp6 : PIdent { EIdent $1 }
|
||||
| '{' PIdent '}' { EConstr $2 }
|
||||
| '%' PIdent '%' { ECons $2 }
|
||||
| Sort { ESort $1 }
|
||||
| String { EString $1 }
|
||||
| Integer { EInt $1 }
|
||||
| Double { EFloat $1 }
|
||||
| '?' { EMeta }
|
||||
| '[' ']' { EEmpty }
|
||||
| 'data' { EData }
|
||||
| '[' PIdent Exps ']' { EList $2 $3 }
|
||||
| '[' String ']' { EStrings $2 }
|
||||
| '{' ListLocDef '}' { ERecord $2 }
|
||||
| '<' ListTupleComp '>' { ETuple $2 }
|
||||
| '(' 'in' PIdent ')' { EIndir $3 }
|
||||
| '<' Exp ':' Exp '>' { ETyped $2 $4 }
|
||||
| '(' Exp ')' { $2 }
|
||||
| LString { ELString $1 }
|
||||
|
||||
|
||||
Exp5 :: { Exp }
|
||||
Exp5 : Exp5 '.' Label { EProj $1 $3 }
|
||||
| '{' PIdent '.' PIdent '}' { EQConstr $2 $4 }
|
||||
| '%' PIdent '.' PIdent { EQCons $2 $4 }
|
||||
| Exp6 { $1 }
|
||||
|
||||
|
||||
Exp4 :: { Exp }
|
||||
Exp4 : Exp4 Exp5 { EApp $1 $2 }
|
||||
| 'table' '{' ListCase '}' { ETable $3 }
|
||||
| 'table' Exp6 '{' ListCase '}' { ETTable $2 $4 }
|
||||
| 'table' Exp6 '[' ListExp ']' { EVTable $2 $4 }
|
||||
| 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
|
||||
| 'variants' '{' ListExp '}' { EVariants $3 }
|
||||
| 'pre' '{' Exp ';' ListAltern '}' { EPre $3 $5 }
|
||||
| 'strs' '{' ListExp '}' { EStrs $3 }
|
||||
| PIdent '@' Exp6 { EConAt $1 $3 }
|
||||
| '#' Patt2 { EPatt $2 }
|
||||
| 'pattern' Exp5 { EPattType $2 }
|
||||
| Exp5 { $1 }
|
||||
| 'Lin' PIdent { ELin $2 }
|
||||
|
||||
|
||||
Exp3 :: { Exp }
|
||||
Exp3 : Exp3 '!' Exp4 { ESelect $1 $3 }
|
||||
| Exp3 '*' Exp4 { ETupTyp $1 $3 }
|
||||
| Exp3 '**' Exp4 { EExtend $1 $3 }
|
||||
| Exp4 { $1 }
|
||||
|
||||
|
||||
Exp2 :: { Exp }
|
||||
Exp2 : Exp3 '+' Exp2 { EGlue $1 $3 }
|
||||
| Exp3 { $1 }
|
||||
|
||||
|
||||
Exp1 :: { Exp }
|
||||
Exp1 : Exp2 '++' Exp1 { EConcat $1 $3 }
|
||||
| Exp2 { $1 }
|
||||
|
||||
|
||||
Exp :: { Exp }
|
||||
Exp : Exp1 '|' Exp { EVariant $1 $3 }
|
||||
| '\\' ListBind '->' Exp { EAbstr $2 $4 }
|
||||
| '\\' '\\' ListBind '=>' Exp { ECTable $3 $5 }
|
||||
| Decl '->' Exp { EProd $1 $3 }
|
||||
| Exp3 '=>' Exp { ETType $1 $3 }
|
||||
| 'let' '{' ListLocDef '}' 'in' Exp { ELet $3 $6 }
|
||||
| 'let' ListLocDef 'in' Exp { ELetb $2 $4 }
|
||||
| Exp3 'where' '{' ListLocDef '}' { EWhere $1 $4 }
|
||||
| 'fn' '{' ListEquation '}' { EEqs $3 }
|
||||
| 'in' Exp5 String { EExample $2 $3 }
|
||||
| Exp1 { $1 }
|
||||
|
||||
|
||||
ListExp :: { [Exp] }
|
||||
ListExp : {- empty -} { [] }
|
||||
| Exp { (:[]) $1 }
|
||||
| Exp ';' ListExp { (:) $1 $3 }
|
||||
|
||||
|
||||
Exps :: { Exps }
|
||||
Exps : {- empty -} { NilExp }
|
||||
| Exp6 Exps { ConsExp $1 $2 }
|
||||
|
||||
|
||||
Patt2 :: { Patt }
|
||||
Patt2 : '?' { PChar }
|
||||
| '[' String ']' { PChars $2 }
|
||||
| '#' PIdent { PMacro $2 }
|
||||
| '#' PIdent '.' PIdent { PM $2 $4 }
|
||||
| '_' { PW }
|
||||
| PIdent { PV $1 }
|
||||
| '{' PIdent '}' { PCon $2 }
|
||||
| PIdent '.' PIdent { PQ $1 $3 }
|
||||
| Integer { PInt $1 }
|
||||
| Double { PFloat $1 }
|
||||
| String { PStr $1 }
|
||||
| '{' ListPattAss '}' { PR $2 }
|
||||
| '<' ListPattTupleComp '>' { PTup $2 }
|
||||
| '(' Patt ')' { $2 }
|
||||
|
||||
|
||||
Patt1 :: { Patt }
|
||||
Patt1 : PIdent ListPatt { PC $1 $2 }
|
||||
| PIdent '.' PIdent ListPatt { PQC $1 $3 $4 }
|
||||
| Patt2 '*' { PRep $1 }
|
||||
| PIdent '@' Patt2 { PAs $1 $3 }
|
||||
| '-' Patt2 { PNeg $2 }
|
||||
| Patt2 { $1 }
|
||||
|
||||
|
||||
Patt :: { Patt }
|
||||
Patt : Patt '|' Patt1 { PDisj $1 $3 }
|
||||
| Patt '+' Patt1 { PSeq $1 $3 }
|
||||
| Patt1 { $1 }
|
||||
|
||||
|
||||
PattAss :: { PattAss }
|
||||
PattAss : ListPIdent '=' Patt { PA $1 $3 }
|
||||
|
||||
|
||||
Label :: { Label }
|
||||
Label : PIdent { LIdent $1 }
|
||||
| '$' Integer { LVar $2 }
|
||||
|
||||
|
||||
Sort :: { Sort }
|
||||
Sort : 'Type' { Sort_Type }
|
||||
| 'PType' { Sort_PType }
|
||||
| 'Tok' { Sort_Tok }
|
||||
| 'Str' { Sort_Str }
|
||||
| 'Strs' { Sort_Strs }
|
||||
|
||||
|
||||
ListPattAss :: { [PattAss] }
|
||||
ListPattAss : {- empty -} { [] }
|
||||
| PattAss { (:[]) $1 }
|
||||
| PattAss ';' ListPattAss { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPatt :: { [Patt] }
|
||||
ListPatt : Patt2 { (:[]) $1 }
|
||||
| Patt2 ListPatt { (:) $1 $2 }
|
||||
|
||||
|
||||
Bind :: { Bind }
|
||||
Bind : PIdent { BIdent $1 }
|
||||
| '_' { BWild }
|
||||
|
||||
|
||||
ListBind :: { [Bind] }
|
||||
ListBind : {- empty -} { [] }
|
||||
| Bind { (:[]) $1 }
|
||||
| Bind ',' ListBind { (:) $1 $3 }
|
||||
|
||||
|
||||
Decl :: { Decl }
|
||||
Decl : '(' ListBind ':' Exp ')' { DDec $2 $4 }
|
||||
| Exp4 { DExp $1 }
|
||||
|
||||
|
||||
TupleComp :: { TupleComp }
|
||||
TupleComp : Exp { TComp $1 }
|
||||
|
||||
|
||||
PattTupleComp :: { PattTupleComp }
|
||||
PattTupleComp : Patt { PTComp $1 }
|
||||
|
||||
|
||||
ListTupleComp :: { [TupleComp] }
|
||||
ListTupleComp : {- empty -} { [] }
|
||||
| TupleComp { (:[]) $1 }
|
||||
| TupleComp ',' ListTupleComp { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPattTupleComp :: { [PattTupleComp] }
|
||||
ListPattTupleComp : {- empty -} { [] }
|
||||
| PattTupleComp { (:[]) $1 }
|
||||
| PattTupleComp ',' ListPattTupleComp { (:) $1 $3 }
|
||||
|
||||
|
||||
Case :: { Case }
|
||||
Case : Patt '=>' Exp { Case $1 $3 }
|
||||
|
||||
|
||||
ListCase :: { [Case] }
|
||||
ListCase : Case { (:[]) $1 }
|
||||
| Case ';' ListCase { (:) $1 $3 }
|
||||
|
||||
|
||||
Equation :: { Equation }
|
||||
Equation : ListPatt '->' Exp { Equ $1 $3 }
|
||||
|
||||
|
||||
ListEquation :: { [Equation] }
|
||||
ListEquation : {- empty -} { [] }
|
||||
| Equation { (:[]) $1 }
|
||||
| Equation ';' ListEquation { (:) $1 $3 }
|
||||
|
||||
|
||||
Altern :: { Altern }
|
||||
Altern : Exp '/' Exp { Alt $1 $3 }
|
||||
|
||||
|
||||
ListAltern :: { [Altern] }
|
||||
ListAltern : {- empty -} { [] }
|
||||
| Altern { (:[]) $1 }
|
||||
| Altern ';' ListAltern { (:) $1 $3 }
|
||||
|
||||
|
||||
DDecl :: { DDecl }
|
||||
DDecl : '(' ListBind ':' Exp ')' { DDDec $2 $4 }
|
||||
| Exp6 { DDExp $1 }
|
||||
|
||||
|
||||
ListDDecl :: { [DDecl] }
|
||||
ListDDecl : {- empty -} { [] }
|
||||
| ListDDecl DDecl { flip (:) $1 $2 }
|
||||
|
||||
|
||||
OldGrammar :: { OldGrammar }
|
||||
OldGrammar : Include ListTopDef { OldGr $1 (reverse $2) }
|
||||
|
||||
|
||||
Include :: { Include }
|
||||
Include : {- empty -} { NoIncl }
|
||||
| 'include' ListFileName { Incl $2 }
|
||||
|
||||
|
||||
FileName :: { FileName }
|
||||
FileName : String { FString $1 }
|
||||
| PIdent { FIdent $1 }
|
||||
| '/' FileName { FSlash $2 }
|
||||
| '.' FileName { FDot $2 }
|
||||
| '-' FileName { FMinus $2 }
|
||||
| PIdent FileName { FAddId $1 $2 }
|
||||
|
||||
|
||||
ListFileName :: { [FileName] }
|
||||
ListFileName : FileName ';' { (:[]) $1 }
|
||||
| FileName ';' ListFileName { (:) $1 $3 }
|
||||
|
||||
|
||||
|
||||
{
|
||||
|
||||
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 ++
|
||||
case ts of
|
||||
[] -> []
|
||||
[Err _] -> " due to lexer error"
|
||||
_ -> " before " ++ unwords (map (BS.unpack . prToken) (take 4 ts))
|
||||
|
||||
myLexer = tokens
|
||||
}
|
||||
|
||||
13
src/GFI.hs
13
src/GFI.hs
@@ -7,7 +7,9 @@ import GF.Command.Commands
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Parse
|
||||
import GF.Data.ErrM
|
||||
import GF.Grammar.API -- for cc command
|
||||
import GF.Grammar.API
|
||||
import GF.Grammar.Lexer
|
||||
import GF.Grammar.Parser
|
||||
import GF.Infra.Dependencies
|
||||
import GF.Infra.UseIO
|
||||
import GF.Infra.Option
|
||||
@@ -24,6 +26,7 @@ import Data.Char
|
||||
import Data.Maybe
|
||||
import Data.List(isPrefixOf)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Text.ParserCombinators.ReadP as RP
|
||||
import System.Cmd
|
||||
import System.CPUTime
|
||||
@@ -104,9 +107,11 @@ loop opts gfenv0 = do
|
||||
pOpts style q ws = (style,q,unwords ws)
|
||||
|
||||
(style,q,s) = pOpts TermPrintDefault Qualified ws
|
||||
case pTerm s >>= checkTerm sgr >>= computeTerm sgr of
|
||||
Ok x -> putStrLn $ enc (showTerm style q x)
|
||||
Bad s -> putStrLn $ enc s
|
||||
case runP pExp (BS.pack s) of
|
||||
Left (_,msg) -> putStrLn msg
|
||||
Right t -> case checkTerm sgr t >>= computeTerm sgr of
|
||||
Ok x -> putStrLn $ enc (showTerm style q x)
|
||||
Bad s -> putStrLn $ enc s
|
||||
loopNewCPU gfenv
|
||||
"dg":ws -> do
|
||||
writeFile "_gfdepgraph.dot" (depGraph sgr)
|
||||
|
||||
Reference in New Issue
Block a user