mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-15 22:22:51 -06:00
use new parser which supports the syntax in GF.Grammar.Grammar directly
This commit is contained in:
krasimir
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user