mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Added support for list categories.
This commit is contained in:
bringert
@@ -79,10 +79,10 @@ data Included =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Def =
|
||||
DDecl [Ident] Exp
|
||||
| DDef [Ident] Exp
|
||||
| DPatt Ident [Patt] Exp
|
||||
| DFull [Ident] Exp Exp
|
||||
DDecl [Name] Exp
|
||||
| DDef [Name] Exp
|
||||
| DPatt Name [Patt] Exp
|
||||
| DFull [Name] Exp Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data TopDef =
|
||||
@@ -109,7 +109,9 @@ data TopDef =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data CatDef =
|
||||
CatDef Ident [DDecl]
|
||||
SimpleCatDef Ident [DDecl]
|
||||
| ListCatDef Ident [DDecl]
|
||||
| ListSizeCatDef Ident [DDecl] Integer
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FunDef =
|
||||
@@ -136,13 +138,18 @@ data ParConstr =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PrintDef =
|
||||
PrintDef [Ident] Exp
|
||||
PrintDef [Name] Exp
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data FlagDef =
|
||||
FlagDef Ident Ident
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Name =
|
||||
IdentName Ident
|
||||
| ListName Ident
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data LocDef =
|
||||
LDDecl [Ident] Exp
|
||||
| LDDef [Ident] Exp
|
||||
@@ -159,6 +166,7 @@ data Exp =
|
||||
| EMeta
|
||||
| EEmpty
|
||||
| EData
|
||||
| EList Ident Exps
|
||||
| EStrings String
|
||||
| ERecord [LocDef]
|
||||
| ETuple [TupleComp]
|
||||
@@ -169,8 +177,8 @@ data Exp =
|
||||
| EQCons Ident Ident
|
||||
| EApp Exp Exp
|
||||
| ETable [Case]
|
||||
| EVTable Exp [Exp]
|
||||
| ETTable Exp [Case]
|
||||
| EVTable Exp [Exp]
|
||||
| ECase Exp [Case]
|
||||
| EVariants [Exp]
|
||||
| EPre Exp [Altern]
|
||||
@@ -193,6 +201,11 @@ data Exp =
|
||||
| ELin Ident
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Exps =
|
||||
NilExp
|
||||
| ConsExp Exp Exps
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Patt =
|
||||
PW
|
||||
| PV Ident
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:23:25 $
|
||||
-- > CVS $Date: 2005/05/25 10:41:59 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
-- > CVS $Revision: 1.20 $
|
||||
--
|
||||
-- From internal source syntax to BNFC-generated (used for printing).
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -72,16 +72,16 @@ mkTopDefs ds = ds
|
||||
|
||||
trAnyDef :: (Ident,Info) -> [P.TopDef]
|
||||
trAnyDef (i,info) = let i' = tri i in case info of
|
||||
AbsCat (Yes co) pd -> [P.DefCat [P.CatDef i' (map trDecl co)]] ++ case pd of
|
||||
AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]] ++ case pd of
|
||||
Yes fs -> [P.DefData [P.DataDef i' [P.DataQId (tri m) (tri c) | QC m c <- fs]]]
|
||||
_ -> []
|
||||
AbsFun (Yes ty) pt -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++ case pt of
|
||||
Yes EData -> [] -- keep this information in data defs only
|
||||
Yes t -> [P.DefDef [P.DDef [i'] (trt t)]]
|
||||
Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
|
||||
_ -> []
|
||||
AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
|
||||
---- don't destroy definitions!
|
||||
AbsTrans f -> [P.DefTrans [P.DDef [i'] (trt f)]]
|
||||
AbsTrans f -> [P.DefTrans [P.DDef [mkName i'] (trt f)]]
|
||||
|
||||
ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
|
||||
ResParam pp -> [P.DefPar [case pp of
|
||||
@@ -90,7 +90,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
|
||||
_ -> P.ParDefAbs i']]
|
||||
|
||||
CncCat (Yes ty) Nope _ ->
|
||||
[P.DefLincat [P.PrintDef [i'] (trt ty)]]
|
||||
[P.DefLincat [P.PrintDef [mkName i'] (trt ty)]]
|
||||
CncCat pty ptr ppr ->
|
||||
[P.DefLindef [trDef i' pty ptr]]
|
||||
---- P.DefPrintCat [P.PrintDef i' (trt pr)]]
|
||||
@@ -101,10 +101,10 @@ trAnyDef (i,info) = let i' = tri i in case info of
|
||||
|
||||
trDef :: Ident -> Perh Type -> Perh Term -> P.Def
|
||||
trDef i pty ptr = case (pty,ptr) of
|
||||
(Nope, Nope) -> P.DDef [i] (P.EMeta) ---
|
||||
(_, Nope) -> P.DDecl [i] (trPerh pty)
|
||||
(Nope, _ ) -> P.DDef [i] (trPerh ptr)
|
||||
(_, _ ) -> P.DFull [i] (trPerh pty) (trPerh ptr)
|
||||
(Nope, Nope) -> P.DDef [mkName i] (P.EMeta) ---
|
||||
(_, Nope) -> P.DDecl [mkName i] (trPerh pty)
|
||||
(Nope, _ ) -> P.DDef [mkName i] (trPerh ptr)
|
||||
(_, _ ) -> P.DFull [mkName i] (trPerh pty) (trPerh ptr)
|
||||
|
||||
trPerh p = case p of
|
||||
Yes t -> trt t
|
||||
@@ -221,3 +221,5 @@ trLabelIdent i = identC $ case i of
|
||||
LIdent s -> s
|
||||
LVar i -> "v" ++ show i --- should not happen
|
||||
|
||||
mkName :: Ident -> P.Name
|
||||
mkName = P.IdentName
|
||||
File diff suppressed because one or more lines are too long
@@ -1,9 +1,10 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
module LexGF where
|
||||
module GF.Source.LexGF where -- H
|
||||
|
||||
import ErrM
|
||||
import GF.Data.ErrM -- H
|
||||
import GF.Data.SharedString -- H
|
||||
}
|
||||
|
||||
|
||||
@@ -15,34 +16,37 @@ $i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- reserved words consisting of special symbols
|
||||
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \. | \| | \? | \< | \> | \@ | \! | \* | \\ | \= \> | \+ \+ | \+ | \_ | \$ | \/ | \-
|
||||
\; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \. | \| | \% | \? | \< | \> | \@ | \! | \* | \\ | \= \> | \+ \+ | \+ | \_ | \$ | \/ | \-
|
||||
|
||||
:-
|
||||
"--" [.]* ; -- Toss single line comments
|
||||
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS s)) }
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent T_LString s)) }
|
||||
@rsyms { tok (\p s -> PT p (TS $ share s)) }
|
||||
\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent TV s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ unescapeInitTail 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 s)) }
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: String -> String
|
||||
share = shareString
|
||||
|
||||
data Tok =
|
||||
TS String -- reserved words
|
||||
| TL String -- string literals
|
||||
| TI String -- integer literals
|
||||
| TV String -- identifiers
|
||||
| TD String -- double precision float literals
|
||||
| TC String -- character literals
|
||||
| T_LString String
|
||||
TS !String -- reserved words
|
||||
| TL !String -- string literals
|
||||
| TI !String -- integer literals
|
||||
| TV !String -- identifiers
|
||||
| TD !String -- double precision float literals
|
||||
| TC !String -- character literals
|
||||
| T_LString !String
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
597
src/GF/Source/ParGF.y
Normal file
597
src/GF/Source/ParGF.y
Normal file
@@ -0,0 +1,597 @@
|
||||
-- This Happy file was machine-generated by the BNF converter
|
||||
{
|
||||
module GF.Source.ParGF where -- H
|
||||
import GF.Source.AbsGF -- H
|
||||
import GF.Source.LexGF -- H
|
||||
import GF.Infra.Ident -- H
|
||||
import GF.Data.ErrM -- H
|
||||
}
|
||||
|
||||
%name pGrammar Grammar
|
||||
%name pModDef ModDef
|
||||
%name pOldGrammar OldGrammar
|
||||
%name pExp Exp
|
||||
|
||||
-- no lexer declaration
|
||||
%monad { Err } { thenM } { returnM }
|
||||
%tokentype { Token }
|
||||
|
||||
%token
|
||||
';' { PT _ (TS ";") }
|
||||
'=' { PT _ (TS "=") }
|
||||
'{' { PT _ (TS "{") }
|
||||
'}' { PT _ (TS "}") }
|
||||
'(' { PT _ (TS "(") }
|
||||
')' { PT _ (TS ")") }
|
||||
':' { PT _ (TS ":") }
|
||||
'->' { PT _ (TS "->") }
|
||||
'**' { PT _ (TS "**") }
|
||||
',' { PT _ (TS ",") }
|
||||
'[' { PT _ (TS "[") }
|
||||
']' { PT _ (TS "]") }
|
||||
'.' { PT _ (TS ".") }
|
||||
'|' { PT _ (TS "|") }
|
||||
'%' { PT _ (TS "%") }
|
||||
'?' { PT _ (TS "?") }
|
||||
'<' { PT _ (TS "<") }
|
||||
'>' { PT _ (TS ">") }
|
||||
'@' { PT _ (TS "@") }
|
||||
'!' { PT _ (TS "!") }
|
||||
'*' { PT _ (TS "*") }
|
||||
'\\' { PT _ (TS "\\") }
|
||||
'=>' { PT _ (TS "=>") }
|
||||
'++' { PT _ (TS "++") }
|
||||
'+' { PT _ (TS "+") }
|
||||
'_' { PT _ (TS "_") }
|
||||
'$' { PT _ (TS "$") }
|
||||
'/' { PT _ (TS "/") }
|
||||
'-' { PT _ (TS "-") }
|
||||
'Lin' { PT _ (TS "Lin") }
|
||||
'PType' { PT _ (TS "PType") }
|
||||
'Str' { PT _ (TS "Str") }
|
||||
'Strs' { PT _ (TS "Strs") }
|
||||
'Tok' { PT _ (TS "Tok") }
|
||||
'Type' { PT _ (TS "Type") }
|
||||
'abstract' { PT _ (TS "abstract") }
|
||||
'case' { PT _ (TS "case") }
|
||||
'cat' { PT _ (TS "cat") }
|
||||
'concrete' { PT _ (TS "concrete") }
|
||||
'data' { PT _ (TS "data") }
|
||||
'def' { PT _ (TS "def") }
|
||||
'flags' { PT _ (TS "flags") }
|
||||
'fn' { PT _ (TS "fn") }
|
||||
'fun' { PT _ (TS "fun") }
|
||||
'grammar' { PT _ (TS "grammar") }
|
||||
'in' { PT _ (TS "in") }
|
||||
'include' { PT _ (TS "include") }
|
||||
'incomplete' { PT _ (TS "incomplete") }
|
||||
'instance' { PT _ (TS "instance") }
|
||||
'interface' { PT _ (TS "interface") }
|
||||
'let' { PT _ (TS "let") }
|
||||
'lin' { PT _ (TS "lin") }
|
||||
'lincat' { PT _ (TS "lincat") }
|
||||
'lindef' { PT _ (TS "lindef") }
|
||||
'lintype' { PT _ (TS "lintype") }
|
||||
'of' { PT _ (TS "of") }
|
||||
'open' { PT _ (TS "open") }
|
||||
'oper' { PT _ (TS "oper") }
|
||||
'out' { PT _ (TS "out") }
|
||||
'package' { PT _ (TS "package") }
|
||||
'param' { PT _ (TS "param") }
|
||||
'pattern' { PT _ (TS "pattern") }
|
||||
'pre' { PT _ (TS "pre") }
|
||||
'printname' { PT _ (TS "printname") }
|
||||
'resource' { PT _ (TS "resource") }
|
||||
'reuse' { PT _ (TS "reuse") }
|
||||
'strs' { PT _ (TS "strs") }
|
||||
'table' { PT _ (TS "table") }
|
||||
'tokenizer' { PT _ (TS "tokenizer") }
|
||||
'transfer' { PT _ (TS "transfer") }
|
||||
'union' { PT _ (TS "union") }
|
||||
'var' { PT _ (TS "var") }
|
||||
'variants' { PT _ (TS "variants") }
|
||||
'where' { PT _ (TS "where") }
|
||||
'with' { PT _ (TS "with") }
|
||||
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_LString { PT _ (T_LString $$) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
Ident :: { Ident } : L_ident { identC $1 } -- H
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
String :: { String } : L_quoted { $1 }
|
||||
LString :: { LString} : L_LString { LString ($1)}
|
||||
|
||||
Grammar :: { Grammar }
|
||||
Grammar : ListModDef { Gr (reverse $1) }
|
||||
|
||||
|
||||
ListModDef :: { [ModDef] }
|
||||
ListModDef : {- empty -} { [] }
|
||||
| ListModDef ModDef { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ModDef :: { ModDef }
|
||||
ModDef : ModDef ';' { $1 }
|
||||
| 'grammar' Ident '=' '{' 'abstract' '=' Ident ';' ListConcSpec '}' { MMain $2 $7 $9 }
|
||||
| ComplMod ModType '=' ModBody { MModule $1 $2 $4 }
|
||||
|
||||
|
||||
ConcSpec :: { ConcSpec }
|
||||
ConcSpec : Ident '=' ConcExp { ConcSpec $1 $3 }
|
||||
|
||||
|
||||
ListConcSpec :: { [ConcSpec] }
|
||||
ListConcSpec : {- empty -} { [] }
|
||||
| ConcSpec { (:[]) $1 }
|
||||
| ConcSpec ';' ListConcSpec { (:) $1 $3 }
|
||||
|
||||
|
||||
ConcExp :: { ConcExp }
|
||||
ConcExp : Ident 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 }
|
||||
|
||||
|
||||
ModType :: { ModType }
|
||||
ModType : 'abstract' Ident { MTAbstract $2 }
|
||||
| 'resource' Ident { MTResource $2 }
|
||||
| 'interface' Ident { MTInterface $2 }
|
||||
| 'concrete' Ident 'of' Ident { MTConcrete $2 $4 }
|
||||
| 'instance' Ident 'of' Ident { MTInstance $2 $4 }
|
||||
| 'transfer' Ident ':' Open '->' Open { MTTransfer $2 $4 $6 }
|
||||
|
||||
|
||||
ModBody :: { ModBody }
|
||||
ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) }
|
||||
| Ident 'with' ListOpen { MWith $1 $3 }
|
||||
| ListIdent '**' Ident 'with' ListOpen { MWithE $1 $3 $5 }
|
||||
| 'reuse' Ident { MReuse $2 }
|
||||
| 'union' ListIncluded { MUnion $2 }
|
||||
|
||||
|
||||
ListTopDef :: { [TopDef] }
|
||||
ListTopDef : {- empty -} { [] }
|
||||
| ListTopDef TopDef { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Extend :: { Extend }
|
||||
Extend : ListIdent '**' { 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 : Ident { OName $1 }
|
||||
| '(' QualOpen Ident ')' { OQualQO $2 $3 }
|
||||
| '(' QualOpen Ident '=' Ident ')' { 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 : Ident { IAll $1 }
|
||||
| Ident '[' ListIdent ']' { ISome $1 $3 }
|
||||
|
||||
|
||||
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' Ident '=' '{' ListTopDef '}' ';' { DefPackage $2 (reverse $5) }
|
||||
| 'var' ListDef { DefVars $2 }
|
||||
| 'tokenizer' Ident ';' { DefTokenizer $2 }
|
||||
|
||||
|
||||
CatDef :: { CatDef }
|
||||
CatDef : Ident ListDDecl { SimpleCatDef $1 (reverse $2) }
|
||||
| '[' Ident ListDDecl ']' { ListCatDef $2 (reverse $3) }
|
||||
| '[' Ident ListDDecl ']' '{' Integer '}' { ListSizeCatDef $2 (reverse $3) $6 }
|
||||
|
||||
|
||||
FunDef :: { FunDef }
|
||||
FunDef : ListIdent ':' Exp { FunDef $1 $3 }
|
||||
|
||||
|
||||
DataDef :: { DataDef }
|
||||
DataDef : Ident '=' ListDataConstr { DataDef $1 $3 }
|
||||
|
||||
|
||||
DataConstr :: { DataConstr }
|
||||
DataConstr : Ident { DataId $1 }
|
||||
| Ident '.' Ident { DataQId $1 $3 }
|
||||
|
||||
|
||||
ListDataConstr :: { [DataConstr] }
|
||||
ListDataConstr : {- empty -} { [] }
|
||||
| DataConstr { (:[]) $1 }
|
||||
| DataConstr '|' ListDataConstr { (:) $1 $3 }
|
||||
|
||||
|
||||
ParDef :: { ParDef }
|
||||
ParDef : Ident '=' ListParConstr { ParDefDir $1 $3 }
|
||||
| Ident '=' '(' 'in' Ident ')' { ParDefIndir $1 $5 }
|
||||
| Ident { ParDefAbs $1 }
|
||||
|
||||
|
||||
ParConstr :: { ParConstr }
|
||||
ParConstr : Ident ListDDecl { ParConstr $1 (reverse $2) }
|
||||
|
||||
|
||||
PrintDef :: { PrintDef }
|
||||
PrintDef : ListName '=' Exp { PrintDef $1 $3 }
|
||||
|
||||
|
||||
FlagDef :: { FlagDef }
|
||||
FlagDef : Ident '=' Ident { 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 }
|
||||
|
||||
|
||||
ListIdent :: { [Ident] }
|
||||
ListIdent : Ident { (:[]) $1 }
|
||||
| Ident ',' ListIdent { (:) $1 $3 }
|
||||
|
||||
|
||||
Name :: { Name }
|
||||
Name : Ident { IdentName $1 }
|
||||
| '[' Ident ']' { ListName $2 }
|
||||
|
||||
|
||||
ListName :: { [Name] }
|
||||
ListName : Name { (:[]) $1 }
|
||||
| Name ',' ListName { (:) $1 $3 }
|
||||
|
||||
|
||||
LocDef :: { LocDef }
|
||||
LocDef : ListIdent ':' Exp { LDDecl $1 $3 }
|
||||
| ListIdent '=' Exp { LDDef $1 $3 }
|
||||
| ListIdent ':' Exp '=' Exp { LDFull $1 $3 $5 }
|
||||
|
||||
|
||||
ListLocDef :: { [LocDef] }
|
||||
ListLocDef : {- empty -} { [] }
|
||||
| LocDef { (:[]) $1 }
|
||||
| LocDef ';' ListLocDef { (:) $1 $3 }
|
||||
|
||||
|
||||
Exp4 :: { Exp }
|
||||
Exp4 : Ident { EIdent $1 }
|
||||
| '{' Ident '}' { EConstr $2 }
|
||||
| '%' Ident '%' { ECons $2 }
|
||||
| Sort { ESort $1 }
|
||||
| String { EString $1 }
|
||||
| Integer { EInt $1 }
|
||||
| '?' { EMeta }
|
||||
| '[' ']' { EEmpty }
|
||||
| 'data' { EData }
|
||||
| '[' Ident Exps ']' { EList $2 $3 }
|
||||
| '[' String ']' { EStrings $2 }
|
||||
| '{' ListLocDef '}' { ERecord $2 }
|
||||
| '<' ListTupleComp '>' { ETuple $2 }
|
||||
| '(' 'in' Ident ')' { EIndir $3 }
|
||||
| '<' Exp ':' Exp '>' { ETyped $2 $4 }
|
||||
| '(' Exp ')' { $2 }
|
||||
| LString { ELString $1 }
|
||||
|
||||
|
||||
Exp3 :: { Exp }
|
||||
Exp3 : Exp3 '.' Label { EProj $1 $3 }
|
||||
| '{' Ident '.' Ident '}' { EQConstr $2 $4 }
|
||||
| '%' Ident '.' Ident '%' { EQCons $2 $4 }
|
||||
| Exp4 { $1 }
|
||||
|
||||
|
||||
Exp2 :: { Exp }
|
||||
Exp2 : Exp2 Exp3 { EApp $1 $2 }
|
||||
| 'table' '{' ListCase '}' { ETable $3 }
|
||||
| 'table' Exp4 '{' ListCase '}' { ETTable $2 $4 }
|
||||
| 'table' Exp4 '[' 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 }
|
||||
| Ident '@' Exp4 { EConAt $1 $3 }
|
||||
| Exp3 { $1 }
|
||||
| 'Lin' Ident { ELin $2 }
|
||||
|
||||
|
||||
Exp1 :: { Exp }
|
||||
Exp1 : Exp1 '!' Exp2 { ESelect $1 $3 }
|
||||
| Exp1 '*' Exp2 { ETupTyp $1 $3 }
|
||||
| Exp1 '**' Exp2 { EExtend $1 $3 }
|
||||
| Exp2 { $1 }
|
||||
|
||||
|
||||
Exp :: { Exp }
|
||||
Exp : '\\' ListBind '->' Exp { EAbstr $2 $4 }
|
||||
| '\\' '\\' ListBind '=>' Exp { ECTable $3 $5 }
|
||||
| Decl '->' Exp { EProd $1 $3 }
|
||||
| Exp1 '=>' Exp { ETType $1 $3 }
|
||||
| Exp1 '++' Exp { EConcat $1 $3 }
|
||||
| Exp1 '+' Exp { EGlue $1 $3 }
|
||||
| 'let' '{' ListLocDef '}' 'in' Exp { ELet $3 $6 }
|
||||
| 'let' ListLocDef 'in' Exp { ELetb $2 $4 }
|
||||
| Exp1 'where' '{' ListLocDef '}' { EWhere $1 $4 }
|
||||
| 'fn' '{' ListEquation '}' { EEqs $3 }
|
||||
| Exp1 { $1 }
|
||||
|
||||
|
||||
ListExp :: { [Exp] }
|
||||
ListExp : {- empty -} { [] }
|
||||
| Exp { (:[]) $1 }
|
||||
| Exp ';' ListExp { (:) $1 $3 }
|
||||
|
||||
|
||||
Exps :: { Exps }
|
||||
Exps : {- empty -} { NilExp }
|
||||
| Exp4 Exps { ConsExp $1 $2 }
|
||||
|
||||
|
||||
Patt1 :: { Patt }
|
||||
Patt1 : '_' { PW }
|
||||
| Ident { PV $1 }
|
||||
| '{' Ident '}' { PCon $2 }
|
||||
| Ident '.' Ident { PQ $1 $3 }
|
||||
| Integer { PInt $1 }
|
||||
| String { PStr $1 }
|
||||
| '{' ListPattAss '}' { PR $2 }
|
||||
| '<' ListPattTupleComp '>' { PTup $2 }
|
||||
| '(' Patt ')' { $2 }
|
||||
|
||||
|
||||
Patt :: { Patt }
|
||||
Patt : Ident ListPatt { PC $1 $2 }
|
||||
| Ident '.' Ident ListPatt { PQC $1 $3 $4 }
|
||||
| Patt1 { $1 }
|
||||
|
||||
|
||||
PattAss :: { PattAss }
|
||||
PattAss : ListIdent '=' Patt { PA $1 $3 }
|
||||
|
||||
|
||||
Label :: { Label }
|
||||
Label : Ident { 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 }
|
||||
|
||||
|
||||
PattAlt :: { PattAlt }
|
||||
PattAlt : Patt { AltP $1 }
|
||||
|
||||
|
||||
ListPatt :: { [Patt] }
|
||||
ListPatt : Patt1 { (:[]) $1 }
|
||||
| Patt1 ListPatt { (:) $1 $2 }
|
||||
|
||||
|
||||
ListPattAlt :: { [PattAlt] }
|
||||
ListPattAlt : PattAlt { (:[]) $1 }
|
||||
| PattAlt '|' ListPattAlt { (:) $1 $3 }
|
||||
|
||||
|
||||
Bind :: { Bind }
|
||||
Bind : Ident { BIdent $1 }
|
||||
| '_' { BWild }
|
||||
|
||||
|
||||
ListBind :: { [Bind] }
|
||||
ListBind : {- empty -} { [] }
|
||||
| Bind { (:[]) $1 }
|
||||
| Bind ',' ListBind { (:) $1 $3 }
|
||||
|
||||
|
||||
Decl :: { Decl }
|
||||
Decl : '(' ListBind ':' Exp ')' { DDec $2 $4 }
|
||||
| Exp2 { 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 : ListPattAlt '=>' 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 }
|
||||
| Exp4 { 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 }
|
||||
| Ident { FIdent $1 }
|
||||
| '/' FileName { FSlash $2 }
|
||||
| '.' FileName { FDot $2 }
|
||||
| '-' FileName { FMinus $2 }
|
||||
| Ident 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 ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts)))
|
||||
|
||||
myLexer = tokens
|
||||
}
|
||||
|
||||
@@ -198,10 +198,10 @@ instance Print Included where
|
||||
|
||||
instance Print Def where
|
||||
prt i e = case e of
|
||||
DDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
|
||||
DDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
|
||||
DPatt id patts exp -> prPrec i 0 (concatD [prt 0 id , prt 0 patts , doc (showString "=") , prt 0 exp])
|
||||
DFull ids exp0 exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
|
||||
DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
|
||||
DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
|
||||
DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
|
||||
DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
@@ -236,7 +236,9 @@ instance Print TopDef where
|
||||
|
||||
instance Print CatDef where
|
||||
prt i e = case e of
|
||||
CatDef id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
|
||||
SimpleCatDef id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
|
||||
ListCatDef id ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , prt 0 ddecls , doc (showString "]")])
|
||||
ListSizeCatDef id ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
@@ -289,7 +291,7 @@ instance Print ParConstr where
|
||||
|
||||
instance Print PrintDef where
|
||||
prt i e = case e of
|
||||
PrintDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
|
||||
PrintDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
@@ -303,6 +305,15 @@ instance Print FlagDef where
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Name where
|
||||
prt i e = case e of
|
||||
IdentName id -> prPrec i 0 (concatD [prt 0 id])
|
||||
ListName id -> prPrec i 0 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print LocDef where
|
||||
prt i e = case e of
|
||||
LDDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
|
||||
@@ -318,13 +329,14 @@ instance Print Exp where
|
||||
prt i e = case e of
|
||||
EIdent id -> prPrec i 4 (concatD [prt 0 id])
|
||||
EConstr id -> prPrec i 4 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
|
||||
ECons id -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")])
|
||||
ECons id -> prPrec i 4 (concatD [doc (showString "%") , prt 0 id , doc (showString "%")])
|
||||
ESort sort -> prPrec i 4 (concatD [prt 0 sort])
|
||||
EString str -> prPrec i 4 (concatD [prt 0 str])
|
||||
EInt n -> prPrec i 4 (concatD [prt 0 n])
|
||||
EMeta -> prPrec i 4 (concatD [doc (showString "?")])
|
||||
EEmpty -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EData -> prPrec i 4 (concatD [doc (showString "data")])
|
||||
EList id exps -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , prt 0 exps , doc (showString "]")])
|
||||
EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
|
||||
@@ -332,7 +344,7 @@ instance Print Exp where
|
||||
ETyped exp0 exp -> prPrec i 4 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
|
||||
EProj exp label -> prPrec i 3 (concatD [prt 3 exp , doc (showString ".") , prt 0 label])
|
||||
EQConstr id0 id -> prPrec i 3 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")]) -- H
|
||||
EQCons id0 id -> prPrec i 3 (concatD [doc (showString "[") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "]")])
|
||||
EQCons id0 id -> prPrec i 3 (concatD [doc (showString "%") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "%")])
|
||||
EApp exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , prt 3 exp])
|
||||
ETable cases -> prPrec i 2 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
ETTable exp cases -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
@@ -363,6 +375,12 @@ instance Print Exp where
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Exps where
|
||||
prt i e = case e of
|
||||
NilExp -> prPrec i 0 (concatD [])
|
||||
ConsExp exp exps -> prPrec i 0 (concatD [prt 4 exp , prt 0 exps])
|
||||
|
||||
|
||||
instance Print Patt where
|
||||
prt i e = case e of
|
||||
PW -> prPrec i 1 (concatD [doc (showString "_")])
|
||||
|
||||
@@ -1,10 +1,11 @@
|
||||
|
||||
module GF.Source.SkelGF where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import GF.Source.AbsGF
|
||||
import GF.Infra.Ident
|
||||
import GF.Data.ErrM
|
||||
|
||||
type Result = Err String
|
||||
|
||||
failure :: Show a => a -> Result
|
||||
@@ -12,7 +13,7 @@ failure x = Bad $ "Undefined case: " ++ show x
|
||||
|
||||
transIdent :: Ident -> Result
|
||||
transIdent x = case x of
|
||||
Ident str -> failure x
|
||||
IC str -> failure x
|
||||
|
||||
|
||||
transLString :: LString -> Result
|
||||
@@ -61,6 +62,7 @@ transModBody :: ModBody -> Result
|
||||
transModBody x = case x of
|
||||
MBody extend opens topdefs -> failure x
|
||||
MWith id opens -> failure x
|
||||
MWithE ids id opens -> failure x
|
||||
MReuse id -> failure x
|
||||
MUnion includeds -> failure x
|
||||
|
||||
@@ -74,7 +76,7 @@ transExtend x = case x of
|
||||
transOpens :: Opens -> Result
|
||||
transOpens x = case x of
|
||||
NoOpens -> failure x
|
||||
Opens opens -> failure x
|
||||
OpenIn opens -> failure x
|
||||
|
||||
|
||||
transOpen :: Open -> Result
|
||||
@@ -105,10 +107,10 @@ transIncluded x = case x of
|
||||
|
||||
transDef :: Def -> Result
|
||||
transDef x = case x of
|
||||
DDecl ids exp -> failure x
|
||||
DDef ids exp -> failure x
|
||||
DPatt id patts exp -> failure x
|
||||
DFull ids exp0 exp -> failure x
|
||||
DDecl names exp -> failure x
|
||||
DDef names exp -> failure x
|
||||
DPatt name patts exp -> failure x
|
||||
DFull names exp0 exp -> failure x
|
||||
|
||||
|
||||
transTopDef :: TopDef -> Result
|
||||
@@ -137,7 +139,9 @@ transTopDef x = case x of
|
||||
|
||||
transCatDef :: CatDef -> Result
|
||||
transCatDef x = case x of
|
||||
CatDef id ddecls -> failure x
|
||||
SimpleCatDef id ddecls -> failure x
|
||||
ListCatDef id ddecls -> failure x
|
||||
ListSizeCatDef id ddecls n -> failure x
|
||||
|
||||
|
||||
transFunDef :: FunDef -> Result
|
||||
@@ -158,7 +162,7 @@ transDataConstr x = case x of
|
||||
|
||||
transParDef :: ParDef -> Result
|
||||
transParDef x = case x of
|
||||
ParDef id parconstrs -> failure x
|
||||
ParDefDir id parconstrs -> failure x
|
||||
ParDefIndir id0 id -> failure x
|
||||
ParDefAbs id -> failure x
|
||||
|
||||
@@ -170,7 +174,7 @@ transParConstr x = case x of
|
||||
|
||||
transPrintDef :: PrintDef -> Result
|
||||
transPrintDef x = case x of
|
||||
PrintDef ids exp -> failure x
|
||||
PrintDef names exp -> failure x
|
||||
|
||||
|
||||
transFlagDef :: FlagDef -> Result
|
||||
@@ -178,6 +182,12 @@ transFlagDef x = case x of
|
||||
FlagDef id0 id -> failure x
|
||||
|
||||
|
||||
transName :: Name -> Result
|
||||
transName x = case x of
|
||||
IdentName id -> failure x
|
||||
ListName id -> failure x
|
||||
|
||||
|
||||
transLocDef :: LocDef -> Result
|
||||
transLocDef x = case x of
|
||||
LDDecl ids exp -> failure x
|
||||
@@ -196,6 +206,7 @@ transExp x = case x of
|
||||
EMeta -> failure x
|
||||
EEmpty -> failure x
|
||||
EData -> failure x
|
||||
EList id exps -> failure x
|
||||
EStrings str -> failure x
|
||||
ERecord locdefs -> failure x
|
||||
ETuple tuplecomps -> failure x
|
||||
@@ -230,6 +241,12 @@ transExp x = case x of
|
||||
ELin id -> failure x
|
||||
|
||||
|
||||
transExps :: Exps -> Result
|
||||
transExps x = case x of
|
||||
NilExp -> failure x
|
||||
ConsExp exp exps -> failure x
|
||||
|
||||
|
||||
transPatt :: Patt -> Result
|
||||
transPatt x = case x of
|
||||
PW -> failure x
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:23:29 $
|
||||
-- > CVS $Date: 2005/05/25 10:42:00 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.22 $
|
||||
-- > CVS $Revision: 1.23 $
|
||||
--
|
||||
-- based on the skeleton Haskell module generated by the BNF converter
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -36,6 +36,7 @@ import GF.Infra.Option
|
||||
|
||||
import Control.Monad
|
||||
import Data.Char
|
||||
import Data.List (genericReplicate)
|
||||
|
||||
-- based on the skeleton Haskell module generated by the BNF converter
|
||||
|
||||
@@ -48,6 +49,11 @@ transIdent :: Ident -> Err Ident
|
||||
transIdent x = case x of
|
||||
x -> return x
|
||||
|
||||
transName :: Name -> Err Ident
|
||||
transName n = case n of
|
||||
IdentName i -> transIdent i
|
||||
ListName i -> transIdent (mkListId i)
|
||||
|
||||
transGrammar :: Grammar -> Err G.SourceGrammar
|
||||
transGrammar x = case x of
|
||||
Gr moddefs -> do
|
||||
@@ -192,9 +198,7 @@ transIncluded x = case x of
|
||||
|
||||
transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
|
||||
transAbsDef x = case x of
|
||||
DefCat catdefs -> do
|
||||
catdefs' <- mapM transCatDef catdefs
|
||||
returnl [(cat, G.AbsCat (yes cont) nope) | (cat,cont) <- catdefs']
|
||||
DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs
|
||||
DefFun fundefs -> do
|
||||
fundefs' <- mapM transFunDef fundefs
|
||||
returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
|
||||
@@ -229,10 +233,27 @@ transFlagDef :: FlagDef -> Err GO.Option
|
||||
transFlagDef x = case x of
|
||||
FlagDef f x -> return $ GO.Opt (prIdent f,[prIdent x])
|
||||
|
||||
transCatDef :: CatDef -> Err (Ident, G.Context)
|
||||
-- | Cat definitions can also return some fun defs
|
||||
-- if it is a list category definition
|
||||
transCatDef :: CatDef -> Err [(Ident, G.Info)]
|
||||
transCatDef x = case x of
|
||||
CatDef id ddecls -> liftM2 (,) (transIdent id)
|
||||
(mapM transDDecl ddecls >>= return . concat)
|
||||
SimpleCatDef id ddecls -> liftM (:[]) $ cat id ddecls
|
||||
ListCatDef id ddecls -> listCat id ddecls 0
|
||||
ListSizeCatDef id ddecls size -> listCat id ddecls size
|
||||
where cat id ddecls = do
|
||||
i <- transIdent id
|
||||
cont <- liftM concat $ mapM transDDecl ddecls
|
||||
return (i, G.AbsCat (yes cont) nope)
|
||||
listCat id ddecls size = do
|
||||
let li = mkListId id
|
||||
catd <- cat li ddecls
|
||||
let cd = M.mkDecl (G.Vr id)
|
||||
lc = G.Vr li
|
||||
niltyp = M.mkProdSimple (genericReplicate size cd) lc
|
||||
nilfund = (mkBaseId id, G.AbsFun (yes niltyp) nope)
|
||||
constyp = M.mkProdSimple [cd, M.mkDecl lc] lc
|
||||
consfund = (mkConsId id, G.AbsFun (yes constyp) nope)
|
||||
return [catd,nilfund,consfund]
|
||||
|
||||
transFunDef :: FunDef -> Err ([Ident], G.Type)
|
||||
transFunDef x = case x of
|
||||
@@ -302,27 +323,27 @@ transCncDef x = case x of
|
||||
|
||||
transPrintDef :: PrintDef -> Err [(Ident,G.Term)]
|
||||
transPrintDef x = case x of
|
||||
PrintDef id exp -> do
|
||||
(ids,e) <- liftM2 (,) (mapM transIdent id) (transExp exp)
|
||||
PrintDef ids exp -> do
|
||||
(ids,e) <- liftM2 (,) (mapM transName ids) (transExp exp)
|
||||
return $ [(i,e) | i <- ids]
|
||||
|
||||
getDefsGen :: Def -> Err [(Ident, (G.Perh G.Type, G.Perh G.Term))]
|
||||
getDefsGen d = case d of
|
||||
DDecl ids t -> do
|
||||
ids' <- mapM transIdent ids
|
||||
ids' <- mapM transName ids
|
||||
t' <- transExp t
|
||||
return [(i,(yes t', nope)) | i <- ids']
|
||||
DDef ids e -> do
|
||||
ids' <- mapM transIdent ids
|
||||
ids' <- mapM transName ids
|
||||
e' <- transExp e
|
||||
return [(i,(nope, yes e')) | i <- ids']
|
||||
DFull ids t e -> do
|
||||
ids' <- mapM transIdent ids
|
||||
ids' <- mapM transName ids
|
||||
t' <- transExp t
|
||||
e' <- transExp e
|
||||
return [(i,(yes t', yes e')) | i <- ids']
|
||||
DPatt id patts e -> do
|
||||
id' <- transIdent id
|
||||
id' <- transName id
|
||||
ps' <- mapM transPatt patts
|
||||
e' <- transExp e
|
||||
return [(id',(nope, yes (G.Eqs [(ps',e')])))]
|
||||
@@ -331,7 +352,7 @@ getDefsGen d = case d of
|
||||
getDefs :: Def -> Err [(Ident, (G.Perh G.Type, G.Perh G.Term))]
|
||||
getDefs d = case d of
|
||||
DPatt id patts e -> do
|
||||
id' <- transIdent id
|
||||
id' <- transName id
|
||||
xs <- mapM tryMakeVar patts
|
||||
e' <- transExp e
|
||||
return [(id',(nope, yes (M.mkAbs xs e')))]
|
||||
@@ -358,6 +379,8 @@ transExp x = case x of
|
||||
EInt n -> return $ G.EInt $ fromInteger n
|
||||
EMeta -> return $ M.meta $ M.int2meta 0
|
||||
EEmpty -> return G.Empty
|
||||
-- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
|
||||
EList i es -> transExp $ foldl EApp (EIdent (mkListId i)) (exps2list es)
|
||||
EStrings [] -> return G.Empty
|
||||
EStrings str -> return $ foldr1 G.C $ map G.K $ words str
|
||||
ERecord defs -> erecord2term defs
|
||||
@@ -416,6 +439,10 @@ transExp x = case x of
|
||||
|
||||
_ -> Bad $ "translation not yet defined for" +++ printTree x ----
|
||||
|
||||
exps2list :: Exps -> [Exp]
|
||||
exps2list NilExp = []
|
||||
exps2list (ConsExp e es) = e : exps2list es
|
||||
|
||||
--- this is complicated: should we change Exp or G.Term ?
|
||||
|
||||
erecord2term :: [LocDef] -> Err G.Term
|
||||
@@ -615,3 +642,11 @@ termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where
|
||||
abss xs t = case t of
|
||||
G.Abs x b -> abss (x:xs) b
|
||||
_ -> (reverse xs,t)
|
||||
|
||||
mkListId,mkConsId,mkBaseId :: Ident -> Ident
|
||||
mkListId = prefixId "List"
|
||||
mkConsId = prefixId "Cons"
|
||||
mkBaseId = prefixId "Base"
|
||||
|
||||
prefixId :: String -> Ident -> Ident
|
||||
prefixId pref id = IC (pref ++ prIdent id)
|
||||
@@ -1,6 +1,5 @@
|
||||
|
||||
-- automatically generated by BNF Converter
|
||||
module GF.Source.TestGF where
|
||||
module Main where
|
||||
|
||||
|
||||
import System.IO ( stdin, hGetContents )
|
||||
@@ -13,6 +12,8 @@ import GF.Source.PrintGF
|
||||
import GF.Source.AbsGF
|
||||
|
||||
|
||||
|
||||
|
||||
import GF.Data.ErrM
|
||||
|
||||
type ParseFun a = [Token] -> Err a
|
||||
@@ -29,18 +30,29 @@ runFile v p f = putStrLn f >> readFile f >>= run v p
|
||||
|
||||
run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO ()
|
||||
run v p s = let ts = myLLexer s in case p ts of
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrV v "Tokens:"
|
||||
putStrV v $ show ts
|
||||
putStrLn s
|
||||
Bad s -> do putStrLn "\nParse Failed...\n"
|
||||
putStrV v "Tokens:"
|
||||
putStrV v $ show ts
|
||||
putStrLn s
|
||||
Ok tree -> do putStrLn "\nParse Successful!"
|
||||
putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
showTree v tree
|
||||
|
||||
|
||||
|
||||
showTree :: (Show a, Print a) => Int -> a -> IO ()
|
||||
showTree v tree
|
||||
= do
|
||||
putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
|
||||
putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
|
||||
|
||||
main :: IO ()
|
||||
main = do args <- getArgs
|
||||
case args of
|
||||
[] -> hGetContents stdin >>= run 2 pGrammar
|
||||
"-s":fs -> mapM_ (runFile 0 pGrammar) fs
|
||||
fs -> mapM_ (runFile 2 pGrammar) fs
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user