mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Changed name of Con constructor in GFC.cf to avoid errors on Windows when generating Java code with BNFC for the GFC grammar. CON is a reserved filename on Windows. Con was changed to Par, and all the code using was changed too.
This commit is contained in:
bringert
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:14 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:16 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.10 $
|
||||
-- > CVS $Revision: 1.11 $
|
||||
--
|
||||
-- Printing CF grammars generated from GF as LBNF grammar for BNFC.
|
||||
-- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004.
|
||||
@@ -68,7 +68,7 @@ mkLBNF gr rules = (coercions, nub $ concatMap mkRule rules) where
|
||||
(f,CncFun _ _ (R lin) _) <- tree2list $ jments m,
|
||||
(Just prec, Just assoc) <- [(
|
||||
lookup "p" [(lab,p) | Ass (L (IC lab)) (EInt p) <- lin],
|
||||
lookup "a" [(lab,a) | Ass (L (IC lab)) (Con (CIQ _ (IC a)) []) <- lin]
|
||||
lookup "a" [(lab,a) | Ass (L (IC lab)) (Par (CIQ _ (IC a)) []) <- lin]
|
||||
)]
|
||||
]
|
||||
precfuns = map fst precedences
|
||||
|
||||
@@ -5,6 +5,7 @@ import GF.Infra.Ident --H
|
||||
-- Haskell module generated by the BNF converter, except --H
|
||||
|
||||
-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
|
||||
|
||||
data Canon =
|
||||
MGr [Ident] Ident [Module]
|
||||
| Gr [Module]
|
||||
@@ -121,7 +122,7 @@ data Labelling =
|
||||
data Term =
|
||||
Arg ArgVar
|
||||
| I CIdent
|
||||
| Con CIdent [Term]
|
||||
| Par CIdent [Term]
|
||||
| LI Ident
|
||||
| R [Assign]
|
||||
| P Term Label
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:21 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:17 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.24 $
|
||||
-- > CVS $Revision: 1.25 $
|
||||
--
|
||||
-- Macros for building and analysing terms in GFC concrete syntax.
|
||||
--
|
||||
@@ -121,7 +121,7 @@ tM = K . KM
|
||||
|
||||
term2patt :: Term -> Err Patt
|
||||
term2patt trm = case trm of
|
||||
Con c aa -> do
|
||||
Par c aa -> do
|
||||
aa' <- mapM term2patt aa
|
||||
return (PC c aa')
|
||||
R r -> do
|
||||
@@ -135,7 +135,7 @@ term2patt trm = case trm of
|
||||
|
||||
patt2term :: Patt -> Term
|
||||
patt2term p = case p of
|
||||
PC x ps -> Con x (map patt2term ps)
|
||||
PC x ps -> Par x (map patt2term ps)
|
||||
PV x -> LI x
|
||||
PW -> anyTerm ----
|
||||
PR pas -> R [ Ass lbl (patt2term q) | PAss lbl q <- pas ]
|
||||
@@ -258,10 +258,10 @@ composSafeOp op trm = case composOp (mkMonadic op) trm of
|
||||
composOp :: Monad m => (Term -> m Term) -> Term -> m Term
|
||||
composOp co trm =
|
||||
case trm of
|
||||
Con x as ->
|
||||
Par x as ->
|
||||
do
|
||||
as' <- mapM co as
|
||||
return (Con x as')
|
||||
return (Par x as')
|
||||
R as ->
|
||||
do
|
||||
let onAss (Ass l t) = liftM (Ass l) (co t)
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/05/30 21:08:14 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.14 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:17 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.15 $
|
||||
--
|
||||
-- a decompiler. AR 12/6/2003 -- 19/4/2004
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -129,7 +129,7 @@ redCTerm :: Term -> Err G.Term
|
||||
redCTerm x = case x of
|
||||
Arg argvar -> liftM G.Vr $ redArgVar argvar
|
||||
I cident -> liftM (uncurry G.Q) $ redQIdent cident
|
||||
Con cident terms -> liftM2 F.mkApp
|
||||
Par cident terms -> liftM2 F.mkApp
|
||||
(liftM (uncurry G.QC) $ redQIdent cident)
|
||||
(mapM redCTerm terms)
|
||||
LI id -> liftM G.Vr $ redIdent id
|
||||
|
||||
@@ -109,7 +109,7 @@ Lbg. Labelling ::= Label ":" CType ;
|
||||
|
||||
Arg. Term2 ::= ArgVar ;
|
||||
I. Term2 ::= CIdent ; -- from resources
|
||||
Con. Term2 ::= "<" CIdent [Term2] ">" ;
|
||||
Par. Term2 ::= "<" CIdent [Term2] ">" ;
|
||||
LI. Term2 ::= "$" Ident ; -- from pattern variables
|
||||
|
||||
R. Term2 ::= "{" [Assign] "}" ;
|
||||
|
||||
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 LexGFC where
|
||||
module GF.Canon.LexGFC where
|
||||
|
||||
import ErrM
|
||||
import GF.Data.ErrM -- H
|
||||
import GF.Data.SharedString -- H
|
||||
}
|
||||
|
||||
|
||||
@@ -20,25 +21,28 @@ $u = [\0-\255] -- universal: any character
|
||||
:-
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS s)) }
|
||||
@rsyms { tok (\p s -> PT p (TS $ 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
|
||||
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
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
@@ -63,20 +67,18 @@ prToken t = case t of
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
|
||||
isResWord s = isInTree s $
|
||||
B "lin" (B "concrete" (B "Type" (B "Str" (B "Ints" N N) N) (B "cat" (B "abstract" N N) N)) (B "fun" (B "flags" (B "data" N N) N) (B "in" (B "grammar" N N) N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
|
||||
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
|
||||
|
||||
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
|
||||
resWords = b "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" N N)))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/28 16:42:48 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.13 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:17 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.14 $
|
||||
--
|
||||
-- lookup in GFC. AR 2003
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -104,7 +104,7 @@ lookupParamValues gr pt@(CIQ m _) = do
|
||||
where
|
||||
mkPar (ParD f co) = do
|
||||
vs <- liftM combinations $ mapM (allParamValues gr) co
|
||||
return $ map (Con (CIQ m f)) vs
|
||||
return $ map (Par (CIQ m f)) vs
|
||||
|
||||
-- this is needed since param type can also be a record type
|
||||
|
||||
@@ -179,7 +179,7 @@ ccompute cnc = comp []
|
||||
let cc = [Cas [p] u | (p,u) <- zip vs ts]
|
||||
compt $ T ptyp cc
|
||||
|
||||
Con c xs -> liftM (Con c) $ mapM compt xs
|
||||
Par c xs -> liftM (Par c) $ mapM compt xs
|
||||
|
||||
K (KS []) -> return E --- should not be needed
|
||||
|
||||
@@ -195,7 +195,7 @@ ccompute cnc = comp []
|
||||
noVar v = case v of
|
||||
LI _ -> False
|
||||
R rs -> all noVar [t | Ass _ t <- rs]
|
||||
Con _ ts -> all noVar ts
|
||||
Par _ ts -> all noVar ts
|
||||
FV ts -> all noVar ts
|
||||
S x y -> noVar x && noVar y
|
||||
_ -> True --- other cases that can be values to pattern match?
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
module GF.Canon.ParGFC where
|
||||
import GF.Canon.AbsGFC
|
||||
import GF.Canon.LexGFC
|
||||
import GF.Data.ErrM
|
||||
import GF.Infra.Ident --H
|
||||
import Data.Array
|
||||
import GF.Data.ErrM -- H
|
||||
import GF.Infra.Ident -- H
|
||||
import Array
|
||||
#if __GLASGOW_HASKELL__ >= 503
|
||||
import GHC.Exts
|
||||
#else
|
||||
@@ -511,7 +511,7 @@ happyReduce_2 = happySpecReduce_1 0# happyReduction_2
|
||||
happyReduction_2 happy_x_1
|
||||
= case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) ->
|
||||
happyIn5
|
||||
(identC happy_var_1 --H
|
||||
(identC happy_var_1
|
||||
)}
|
||||
|
||||
happyReduce_3 = happySpecReduce_1 1# happyReduction_3
|
||||
@@ -1194,7 +1194,7 @@ happyReduction_75 (happy_x_4 `HappyStk`
|
||||
= case happyOut19 happy_x_2 of { happy_var_2 ->
|
||||
case happyOut53 happy_x_3 of { happy_var_3 ->
|
||||
happyIn33
|
||||
(Con happy_var_2 (reverse happy_var_3)
|
||||
(Par happy_var_2 (reverse happy_var_3)
|
||||
) `HappyStk` happyRest}}
|
||||
|
||||
happyReduce_76 = happySpecReduce_2 28# happyReduction_76
|
||||
@@ -1836,7 +1836,7 @@ happyError ts =
|
||||
|
||||
myLexer = tokens
|
||||
{-# LINE 1 "GenericTemplate.hs" #-}
|
||||
-- $Id: ParGFC.hs,v 1.10 2005/05/27 21:05:17 aarne Exp $
|
||||
-- $Id: ParGFC.hs,v 1.11 2005/06/17 14:15:17 bringert Exp $
|
||||
|
||||
|
||||
|
||||
|
||||
385
src/GF/Canon/ParGFC.y
Normal file
385
src/GF/Canon/ParGFC.y
Normal file
@@ -0,0 +1,385 @@
|
||||
-- This Happy file was machine-generated by the BNF converter
|
||||
{
|
||||
module GF.Canon.ParGFC where
|
||||
import GF.Canon.AbsGFC
|
||||
import GF.Canon.LexGFC
|
||||
import GF.Data.ErrM -- H
|
||||
import GF.Infra.Ident -- H
|
||||
}
|
||||
|
||||
%name pCanon Canon
|
||||
%name pLine Line
|
||||
|
||||
-- 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 ",") }
|
||||
'Ints' { PT _ (TS "Ints") }
|
||||
'Str' { PT _ (TS "Str") }
|
||||
'Type' { PT _ (TS "Type") }
|
||||
'abstract' { PT _ (TS "abstract") }
|
||||
'cat' { PT _ (TS "cat") }
|
||||
'concrete' { PT _ (TS "concrete") }
|
||||
'data' { PT _ (TS "data") }
|
||||
'flags' { PT _ (TS "flags") }
|
||||
'fun' { PT _ (TS "fun") }
|
||||
'grammar' { PT _ (TS "grammar") }
|
||||
'in' { PT _ (TS "in") }
|
||||
'lin' { PT _ (TS "lin") }
|
||||
'lincat' { PT _ (TS "lincat") }
|
||||
'of' { PT _ (TS "of") }
|
||||
'open' { PT _ (TS "open") }
|
||||
'oper' { PT _ (TS "oper") }
|
||||
'param' { PT _ (TS "param") }
|
||||
'pre' { PT _ (TS "pre") }
|
||||
'resource' { PT _ (TS "resource") }
|
||||
'table' { PT _ (TS "table") }
|
||||
'transfer' { PT _ (TS "transfer") }
|
||||
'variants' { PT _ (TS "variants") }
|
||||
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
Ident :: { Ident } : L_ident { identC $1 } -- H
|
||||
String :: { String } : L_quoted { $1 }
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
|
||||
Canon :: { Canon }
|
||||
Canon : 'grammar' ListIdent 'of' Ident ';' ListModule { MGr $2 $4 (reverse $6) }
|
||||
| ListModule { Gr (reverse $1) }
|
||||
|
||||
|
||||
Line :: { Line }
|
||||
Line : 'grammar' ListIdent 'of' Ident ';' { LMulti $2 $4 }
|
||||
| ModType '=' Extend Open '{' { LHeader $1 $3 $4 }
|
||||
| Flag ';' { LFlag $1 }
|
||||
| Def ';' { LDef $1 }
|
||||
| '}' { LEnd }
|
||||
|
||||
|
||||
Module :: { Module }
|
||||
Module : ModType '=' Extend Open '{' ListFlag ListDef '}' { Mod $1 $3 $4 (reverse $6) (reverse $7) }
|
||||
|
||||
|
||||
ModType :: { ModType }
|
||||
ModType : 'abstract' Ident { MTAbs $2 }
|
||||
| 'concrete' Ident 'of' Ident { MTCnc $2 $4 }
|
||||
| 'resource' Ident { MTRes $2 }
|
||||
| 'transfer' Ident ':' Ident '->' Ident { MTTrans $2 $4 $6 }
|
||||
|
||||
|
||||
ListModule :: { [Module] }
|
||||
ListModule : {- empty -} { [] }
|
||||
| ListModule Module { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Extend :: { Extend }
|
||||
Extend : ListIdent '**' { Ext $1 }
|
||||
| {- empty -} { NoExt }
|
||||
|
||||
|
||||
Open :: { Open }
|
||||
Open : 'open' ListIdent 'in' { Opens $2 }
|
||||
| {- empty -} { NoOpens }
|
||||
|
||||
|
||||
Flag :: { Flag }
|
||||
Flag : 'flags' Ident '=' Ident { Flg $2 $4 }
|
||||
|
||||
|
||||
Def :: { Def }
|
||||
Def : 'cat' Ident '[' ListDecl ']' '=' ListCIdent { AbsDCat $2 $4 (reverse $7) }
|
||||
| 'fun' Ident ':' Exp '=' Exp { AbsDFun $2 $4 $6 }
|
||||
| 'transfer' Ident '=' Exp { AbsDTrans $2 $4 }
|
||||
| 'param' Ident '=' ListParDef { ResDPar $2 $4 }
|
||||
| 'oper' Ident ':' CType '=' Term { ResDOper $2 $4 $6 }
|
||||
| 'lincat' Ident '=' CType '=' Term ';' Term { CncDCat $2 $4 $6 $8 }
|
||||
| 'lin' Ident ':' CIdent '=' '\\' ListArgVar '->' Term ';' Term { CncDFun $2 $4 $7 $9 $11 }
|
||||
| Ident Status 'in' Ident { AnyDInd $1 $2 $4 }
|
||||
|
||||
|
||||
ParDef :: { ParDef }
|
||||
ParDef : Ident ListCType { ParD $1 (reverse $2) }
|
||||
|
||||
|
||||
Status :: { Status }
|
||||
Status : 'data' { Canon }
|
||||
| {- empty -} { NonCan }
|
||||
|
||||
|
||||
CIdent :: { CIdent }
|
||||
CIdent : Ident '.' Ident { CIQ $1 $3 }
|
||||
|
||||
|
||||
Exp1 :: { Exp }
|
||||
Exp1 : Exp1 Exp2 { EApp $1 $2 }
|
||||
| Exp2 { $1 }
|
||||
|
||||
|
||||
Exp :: { Exp }
|
||||
Exp : '(' Ident ':' Exp ')' '->' Exp { EProd $2 $4 $7 }
|
||||
| '\\' Ident '->' Exp { EAbs $2 $4 }
|
||||
| '{' ListEquation '}' { EEq (reverse $2) }
|
||||
| Exp1 { $1 }
|
||||
|
||||
|
||||
Exp2 :: { Exp }
|
||||
Exp2 : Atom { EAtom $1 }
|
||||
| 'data' { EData }
|
||||
| '(' Exp ')' { $2 }
|
||||
|
||||
|
||||
Sort :: { Sort }
|
||||
Sort : 'Type' { SType }
|
||||
|
||||
|
||||
Equation :: { Equation }
|
||||
Equation : ListAPatt '->' Exp { Equ (reverse $1) $3 }
|
||||
|
||||
|
||||
APatt :: { APatt }
|
||||
APatt : '(' CIdent ListAPatt ')' { APC $2 (reverse $3) }
|
||||
| Ident { APV $1 }
|
||||
| String { APS $1 }
|
||||
| Integer { API $1 }
|
||||
| '_' { APW }
|
||||
|
||||
|
||||
ListDecl :: { [Decl] }
|
||||
ListDecl : {- empty -} { [] }
|
||||
| Decl { (:[]) $1 }
|
||||
| Decl ';' ListDecl { (:) $1 $3 }
|
||||
|
||||
|
||||
ListAPatt :: { [APatt] }
|
||||
ListAPatt : {- empty -} { [] }
|
||||
| ListAPatt APatt { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListEquation :: { [Equation] }
|
||||
ListEquation : {- empty -} { [] }
|
||||
| ListEquation Equation ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
Atom :: { Atom }
|
||||
Atom : CIdent { AC $1 }
|
||||
| '<' CIdent '>' { AD $2 }
|
||||
| '$' Ident { AV $2 }
|
||||
| '?' Integer { AM $2 }
|
||||
| String { AS $1 }
|
||||
| Integer { AI $1 }
|
||||
| Sort { AT $1 }
|
||||
|
||||
|
||||
Decl :: { Decl }
|
||||
Decl : Ident ':' Exp { Decl $1 $3 }
|
||||
|
||||
|
||||
CType :: { CType }
|
||||
CType : '{' ListLabelling '}' { RecType $2 }
|
||||
| '(' CType '=>' CType ')' { Table $2 $4 }
|
||||
| CIdent { Cn $1 }
|
||||
| 'Str' { TStr }
|
||||
| 'Ints' Integer { TInts $2 }
|
||||
|
||||
|
||||
Labelling :: { Labelling }
|
||||
Labelling : Label ':' CType { Lbg $1 $3 }
|
||||
|
||||
|
||||
Term2 :: { Term }
|
||||
Term2 : ArgVar { Arg $1 }
|
||||
| CIdent { I $1 }
|
||||
| '<' CIdent ListTerm2 '>' { Par $2 (reverse $3) }
|
||||
| '$' Ident { LI $2 }
|
||||
| '{' ListAssign '}' { R $2 }
|
||||
| Integer { EInt $1 }
|
||||
| Tokn { K $1 }
|
||||
| '[' ']' { E }
|
||||
| '(' Term ')' { $2 }
|
||||
|
||||
|
||||
Term1 :: { Term }
|
||||
Term1 : Term2 '.' Label { P $1 $3 }
|
||||
| 'table' CType '{' ListCase '}' { T $2 $4 }
|
||||
| 'table' CType '[' ListTerm2 ']' { V $2 (reverse $4) }
|
||||
| Term1 '!' Term2 { S $1 $3 }
|
||||
| 'variants' '{' ListTerm2 '}' { FV (reverse $3) }
|
||||
| Term2 { $1 }
|
||||
|
||||
|
||||
Term :: { Term }
|
||||
Term : Term '++' Term1 { C $1 $3 }
|
||||
| Term1 { $1 }
|
||||
|
||||
|
||||
Tokn :: { Tokn }
|
||||
Tokn : String { KS $1 }
|
||||
| '[' 'pre' ListString '{' ListVariant '}' ']' { KP (reverse $3) $5 }
|
||||
|
||||
|
||||
Assign :: { Assign }
|
||||
Assign : Label '=' Term { Ass $1 $3 }
|
||||
|
||||
|
||||
Case :: { Case }
|
||||
Case : ListPatt '=>' Term { Cas (reverse $1) $3 }
|
||||
|
||||
|
||||
Variant :: { Variant }
|
||||
Variant : ListString '/' ListString { Var (reverse $1) (reverse $3) }
|
||||
|
||||
|
||||
Label :: { Label }
|
||||
Label : Ident { L $1 }
|
||||
| '$' Integer { LV $2 }
|
||||
|
||||
|
||||
ArgVar :: { ArgVar }
|
||||
ArgVar : Ident '@' Integer { A $1 $3 }
|
||||
| Ident '+' Integer '@' Integer { AB $1 $3 $5 }
|
||||
|
||||
|
||||
Patt :: { Patt }
|
||||
Patt : '(' CIdent ListPatt ')' { PC $2 (reverse $3) }
|
||||
| Ident { PV $1 }
|
||||
| '_' { PW }
|
||||
| '{' ListPattAssign '}' { PR $2 }
|
||||
| Integer { PI $1 }
|
||||
|
||||
|
||||
PattAssign :: { PattAssign }
|
||||
PattAssign : Label '=' Patt { PAss $1 $3 }
|
||||
|
||||
|
||||
ListFlag :: { [Flag] }
|
||||
ListFlag : {- empty -} { [] }
|
||||
| ListFlag Flag ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListDef :: { [Def] }
|
||||
ListDef : {- empty -} { [] }
|
||||
| ListDef Def ';' { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListParDef :: { [ParDef] }
|
||||
ListParDef : {- empty -} { [] }
|
||||
| ParDef { (:[]) $1 }
|
||||
| ParDef '|' ListParDef { (:) $1 $3 }
|
||||
|
||||
|
||||
ListCType :: { [CType] }
|
||||
ListCType : {- empty -} { [] }
|
||||
| ListCType CType { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListCIdent :: { [CIdent] }
|
||||
ListCIdent : {- empty -} { [] }
|
||||
| ListCIdent CIdent { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListAssign :: { [Assign] }
|
||||
ListAssign : {- empty -} { [] }
|
||||
| Assign { (:[]) $1 }
|
||||
| Assign ';' ListAssign { (:) $1 $3 }
|
||||
|
||||
|
||||
ListArgVar :: { [ArgVar] }
|
||||
ListArgVar : {- empty -} { [] }
|
||||
| ArgVar { (:[]) $1 }
|
||||
| ArgVar ',' ListArgVar { (:) $1 $3 }
|
||||
|
||||
|
||||
ListLabelling :: { [Labelling] }
|
||||
ListLabelling : {- empty -} { [] }
|
||||
| Labelling { (:[]) $1 }
|
||||
| Labelling ';' ListLabelling { (:) $1 $3 }
|
||||
|
||||
|
||||
ListCase :: { [Case] }
|
||||
ListCase : {- empty -} { [] }
|
||||
| Case { (:[]) $1 }
|
||||
| Case ';' ListCase { (:) $1 $3 }
|
||||
|
||||
|
||||
ListTerm2 :: { [Term] }
|
||||
ListTerm2 : {- empty -} { [] }
|
||||
| ListTerm2 Term2 { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListString :: { [String] }
|
||||
ListString : {- empty -} { [] }
|
||||
| ListString String { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListVariant :: { [Variant] }
|
||||
ListVariant : {- empty -} { [] }
|
||||
| Variant { (:[]) $1 }
|
||||
| Variant ';' ListVariant { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPattAssign :: { [PattAssign] }
|
||||
ListPattAssign : {- empty -} { [] }
|
||||
| PattAssign { (:[]) $1 }
|
||||
| PattAssign ';' ListPattAssign { (:) $1 $3 }
|
||||
|
||||
|
||||
ListPatt :: { [Patt] }
|
||||
ListPatt : {- empty -} { [] }
|
||||
| ListPatt Patt { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListIdent :: { [Ident] }
|
||||
ListIdent : {- empty -} { [] }
|
||||
| Ident { (:[]) $1 }
|
||||
| Ident ',' ListIdent { (:) $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
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
|
||||
module GF.Canon.PrintGFC where
|
||||
|
||||
|
||||
-- pretty-printer generated by the BNF converter, except handhacked spacing --H
|
||||
|
||||
import GF.Infra.Ident --H
|
||||
@@ -36,12 +36,11 @@ render d = rend 0 (map ($ "") $ d []) "" where
|
||||
t : "." :ts -> showString t . showString "." . rend i ts --H
|
||||
t :ts -> realspace t . rend i ts --H
|
||||
_ -> id
|
||||
space t = showString t . showChar ' ' -- H
|
||||
space t = showString t . showChar ' ' -- H
|
||||
realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H
|
||||
new i s = s -- H
|
||||
realnew = showChar '\n' --H
|
||||
|
||||
|
||||
parenth :: Doc -> Doc
|
||||
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
|
||||
|
||||
@@ -63,12 +62,6 @@ class Print a where
|
||||
instance Print a => Print [a] where
|
||||
prt _ = prtList
|
||||
|
||||
instance Print Integer where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
|
||||
prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
|
||||
@@ -85,31 +78,38 @@ prPrec :: Int -> Int -> Doc -> Doc
|
||||
prPrec i j = if j<i then parenth else id
|
||||
|
||||
|
||||
instance Print Integer where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Ident where
|
||||
prt _ i = doc (showString $ prIdent i)
|
||||
prt _ i = doc (showString $ prIdent i) -- H
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
|
||||
|
||||
instance Print Canon where
|
||||
prt i e = case e of
|
||||
MGr ids id modules -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , prt 0 modules])
|
||||
Gr modules -> prPrec i 0 (concatD [prt 0 modules])
|
||||
|
||||
|
||||
instance Print Line where
|
||||
prt i e = case e of
|
||||
LMulti ids id -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";") , doc (showString "*NEW")])
|
||||
LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{"), doc (showString "*NEW")])
|
||||
LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";") , doc (showString "*NEW")])
|
||||
LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";") , doc (showString "*NEW")])
|
||||
LMulti ids id -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 ids , doc (showString "of") , prt 0 id , doc (showString ";")])
|
||||
LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{")])
|
||||
LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";")])
|
||||
LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";")])
|
||||
LEnd -> prPrec i 0 (concatD [doc (showString "}")])
|
||||
|
||||
|
||||
instance Print Module where
|
||||
prt i e = case e of
|
||||
Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , doc (showString "*NEW") , prt 0 flags , prt 0 defs , doc (showString "}")])
|
||||
Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , prt 0 flags , prt 0 defs , doc (showString "}")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
@@ -141,7 +141,7 @@ instance Print Flag where
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , doc (showString "*NEW") , prt 0 xs])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Def where
|
||||
prt i e = case e of
|
||||
@@ -158,6 +158,7 @@ instance Print Def where
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*NEW") , prt 0 xs]) -- H
|
||||
|
||||
|
||||
instance Print ParDef where
|
||||
prt i e = case e of
|
||||
ParD id ctypes -> prPrec i 0 (concatD [prt 0 id , prt 0 ctypes])
|
||||
@@ -261,7 +262,7 @@ instance Print Term where
|
||||
prt i e = case e of
|
||||
Arg argvar -> prPrec i 2 (concatD [prt 0 argvar])
|
||||
I cident -> prPrec i 2 (concatD [prt 0 cident])
|
||||
Con cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")])
|
||||
Par cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")])
|
||||
LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id])
|
||||
R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")])
|
||||
P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label])
|
||||
@@ -281,8 +282,8 @@ instance Print Term where
|
||||
instance Print Tokn where
|
||||
prt i e = case e of
|
||||
KS str -> prPrec i 0 (concatD [prt 0 str])
|
||||
KM str -> prPrec i 0 (concatD [prt 0 str])
|
||||
KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
|
||||
KM str -> prPrec i 0 (concatD [prt 0 str])
|
||||
|
||||
|
||||
instance Print Assign where
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:21:30 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.11 $
|
||||
-- > CVS $Revision: 1.12 $
|
||||
--
|
||||
-- Optimizations on GFC code: sharing, parametrization, value sets.
|
||||
--
|
||||
@@ -128,8 +128,8 @@ replace old new trm = case trm of
|
||||
FV ts -> FV (map repl ts)
|
||||
|
||||
-- these are the important cases, since they can correspond to patterns
|
||||
Con c ts | trm == old -> new
|
||||
Con c ts -> Con c (map repl ts)
|
||||
Par c ts | trm == old -> new
|
||||
Par c ts -> Par c (map repl ts)
|
||||
R _ | isRec && trm == old -> new
|
||||
R lts -> R [Ass l (repl t) | Ass l t <- lts]
|
||||
|
||||
|
||||
@@ -1,10 +1,11 @@
|
||||
|
||||
module GF.Canon.SkelGFC where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import GF.Canon.AbsGFC
|
||||
import GF.Data.ErrM
|
||||
import GF.Infra.Ident
|
||||
|
||||
type Result = Err String
|
||||
|
||||
failure :: Show a => a -> Result
|
||||
@@ -21,6 +22,15 @@ transCanon x = case x of
|
||||
Gr modules -> failure x
|
||||
|
||||
|
||||
transLine :: Line -> Result
|
||||
transLine x = case x of
|
||||
LMulti ids id -> failure x
|
||||
LHeader modtype extend open -> failure x
|
||||
LFlag flag -> failure x
|
||||
LDef def -> failure x
|
||||
LEnd -> failure x
|
||||
|
||||
|
||||
transModule :: Module -> Result
|
||||
transModule x = case x of
|
||||
Mod modtype extend open flags defs -> failure x
|
||||
@@ -142,7 +152,7 @@ transTerm :: Term -> Result
|
||||
transTerm x = case x of
|
||||
Arg argvar -> failure x
|
||||
I cident -> failure x
|
||||
Con cident terms -> failure x
|
||||
Par cident terms -> failure x
|
||||
LI id -> failure x
|
||||
R assigns -> failure x
|
||||
P term label -> failure x
|
||||
|
||||
@@ -1,9 +1,8 @@
|
||||
|
||||
-- automatically generated by BNF Converter
|
||||
module GF.Canon.TestGFC where
|
||||
module Main where
|
||||
|
||||
|
||||
import System.IO ( stdin, hGetContents )
|
||||
import IO ( stdin, hGetContents )
|
||||
import System ( getArgs, getProgName )
|
||||
|
||||
import GF.Canon.LexGFC
|
||||
@@ -11,6 +10,8 @@ import GF.Canon.ParGFC
|
||||
import GF.Canon.SkelGFC
|
||||
import GF.Canon.PrintGFC
|
||||
import GF.Canon.AbsGFC
|
||||
import GF.Infra.Ident
|
||||
|
||||
|
||||
|
||||
import GF.Data.ErrM
|
||||
@@ -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 pCanon
|
||||
"-s":fs -> mapM_ (runFile 0 pCanon) fs
|
||||
fs -> mapM_ (runFile 2 pCanon) fs
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/05/30 21:08:14 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.20 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.21 $
|
||||
--
|
||||
-- Code generator from optimized GF source code to GFC.
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -197,10 +197,10 @@ redCTerm t = case t of
|
||||
(_,c,xx) <- termForm t
|
||||
xx' <- mapM redCTerm xx
|
||||
case c of
|
||||
QC p c -> liftM2 G.Con (redQIdent (p,c)) (return xx')
|
||||
QC p c -> liftM2 G.Par (redQIdent (p,c)) (return xx')
|
||||
_ -> prtBad "expected constructor head instead of" c
|
||||
Q p c -> liftM G.I (redQIdent (p,c))
|
||||
QC p c -> liftM2 G.Con (redQIdent (p,c)) (return [])
|
||||
QC p c -> liftM2 G.Par (redQIdent (p,c)) (return [])
|
||||
R rs -> do
|
||||
let (ls,tts) = unzip rs
|
||||
ls' = map redLabel ls
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/05/13 12:40:19 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.9 $
|
||||
--
|
||||
-- Converting GFC to SimpleGFC
|
||||
--
|
||||
@@ -101,7 +101,7 @@ convertCType gram (A.TInts n) = error "GFCtoSimple.convertCType: cannot hand
|
||||
|
||||
convertTerm :: Env -> A.Term -> STerm
|
||||
convertTerm gram (A.Arg arg) = convertArgVar arg
|
||||
convertTerm gram (A.Con con terms) = con :^ map (convertTerm gram) terms
|
||||
convertTerm gram (A.Par con terms) = con :^ map (convertTerm gram) terms
|
||||
-- convertTerm gram (A.LI var) = Var var
|
||||
convertTerm gram (A.R rec) = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
|
||||
convertTerm gram (A.P term lbl) = convertTerm gram term +. lbl
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:38 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- Pretty-printing
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -91,8 +91,8 @@ instance Print Ident where
|
||||
|
||||
instance Print Term where
|
||||
prt (Arg arg) = prt arg
|
||||
prt (con `Con` []) = prt con
|
||||
prt (con `Con` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
|
||||
prt (con `Par` []) = prt con
|
||||
prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
|
||||
prt (LI ident) = "$" ++ prt ident
|
||||
prt (R record) = "{" ++ prtSep "; " record ++ "}"
|
||||
prt (term `P` lbl) = prt term ++ "." ++ prt lbl
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:55 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting GFC grammars to MCFG grammars, nondeterministically.
|
||||
--
|
||||
@@ -98,7 +98,7 @@ simplTerm env = simplifyTerm
|
||||
where
|
||||
simplifyTerm :: Term -> CnvMonad STerm
|
||||
simplifyTerm (Arg (A cat nr)) = return (SArg (fromInteger nr) cat emptyPath)
|
||||
simplifyTerm (Con con terms) = liftM (SCon con) $ mapM simplifyTerm terms
|
||||
simplifyTerm (Par con terms) = liftM (SCon con) $ mapM simplifyTerm terms
|
||||
simplifyTerm (R record) = liftM SRec $ mapM simplifyAssign record
|
||||
simplifyTerm (P term lbl) = liftM (+. lbl) $ simplifyTerm term
|
||||
simplifyTerm (T ct table) = liftM STbl $ sequence $ concatMap simplifyCase table
|
||||
@@ -277,5 +277,5 @@ cTypeForArg env (SArg nr cat (Path path))
|
||||
" results in " ++ show err
|
||||
|
||||
term2spattern (R rec) = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
|
||||
term2spattern (Con con terms) = SCon con $ map term2spattern terms
|
||||
term2spattern (Par con terms) = SCon con $ map term2spattern terms
|
||||
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:56 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting GFC grammars to MCFG grammars. (Old variant)
|
||||
--
|
||||
@@ -66,7 +66,7 @@ cnvXMCFLin (Lin lbl lin) = Lin (cnvXMCFLabel lbl) $
|
||||
cnvTerm (R rec) = SRec [ (lbl, cnvTerm term) | Ass lbl term <- rec ]
|
||||
cnvTerm (T _ tbl) = STbl [ (cnvPattern pat, cnvTerm term) |
|
||||
Cas pats term <- tbl, pat <- pats ]
|
||||
cnvTerm (Con con terms) = SCon con $ map cnvTerm terms
|
||||
cnvTerm (Par con terms) = SCon con $ map cnvTerm terms
|
||||
cnvTerm term
|
||||
| isArgPath term = cnvArgPath term
|
||||
|
||||
@@ -208,7 +208,7 @@ strPaths gr l ctype term = [ (path, evalFV values) | (path, values) <- groupPair
|
||||
-- Substitute each instantiated parameter path for its instantiation
|
||||
substitutePaths :: CanonGrammar -> Ident -> [Term] -> Term -> Term
|
||||
substitutePaths gr l arguments trm = subst trm
|
||||
where subst (con `Con` terms) = con `Con` map subst terms
|
||||
where subst (con `Par` terms) = con `Par` map subst terms
|
||||
subst (R record) = R $ map substAss record
|
||||
subst (term `P` lbl) = subst term `evalP` lbl
|
||||
subst (T ptype table) = T ptype $ map substCas table
|
||||
@@ -264,11 +264,11 @@ matchesPats term patterns = or [ term == pattern2term pattern | pattern <- patte
|
||||
pattern2term :: Patt -> Term
|
||||
term2pattern :: Term -> Patt
|
||||
|
||||
pattern2term (con `PC` patterns) = con `Con` map pattern2term patterns
|
||||
pattern2term (con `PC` patterns) = con `Par` map pattern2term patterns
|
||||
pattern2term (PR record) = R [ lbl `Ass` pattern2term pattern |
|
||||
lbl `PAss` pattern <- record ]
|
||||
|
||||
term2pattern (con `Con` terms) = con `PC` map term2pattern terms
|
||||
term2pattern (con `Par` terms) = con `PC` map term2pattern terms
|
||||
term2pattern (R record) = PR [ lbl `PAss` term2pattern term |
|
||||
lbl `Ass` term <- record ]
|
||||
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:56 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting GFC grammars to MCFG grammars, nondeterministically.
|
||||
--
|
||||
@@ -106,7 +106,7 @@ enumerateArg env (A cat nr) = let ctype = lookupCType env cat
|
||||
-- Substitute each instantiated parameter path for its instantiation
|
||||
substitutePaths :: Env -> [STerm] -> Term -> STerm
|
||||
substitutePaths env arguments trm = subst trm
|
||||
where subst (con `Con` terms) = con `SCon` map subst terms
|
||||
where subst (con `Par` terms) = con `SCon` map subst terms
|
||||
subst (R record) = SRec [ (lbl, subst term) | lbl `Ass` term <- record ]
|
||||
subst (term `P` lbl) = subst term +. lbl
|
||||
subst (T ptype table) = STbl [ (pattern2sterm pat, subst term) |
|
||||
@@ -180,7 +180,7 @@ groundTerms env ctype = err error (map term2spattern) $
|
||||
allParamValues (fst env) ctype
|
||||
|
||||
term2spattern (R rec) = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
|
||||
term2spattern (Con con terms) = SCon con $ map term2spattern terms
|
||||
term2spattern (Par con terms) = SCon con $ map term2spattern terms
|
||||
|
||||
pattern2sterm :: Patt -> STerm
|
||||
pattern2sterm (con `PC` patterns) = con `SCon` map pattern2sterm patterns
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:22:45 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:18 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting GFC to SimpleGFC
|
||||
--
|
||||
@@ -81,7 +81,7 @@ convertCType gram (A.TInts n) = error "convertCType: cannot handle 'TInts' const
|
||||
|
||||
convertTerm :: Env -> A.Term -> Term
|
||||
convertTerm gram (A.Arg arg) = convertArgVar arg
|
||||
convertTerm gram (A.Con con terms) = con :^ map (convertTerm gram) terms
|
||||
convertTerm gram (A.Par con terms) = con :^ map (convertTerm gram) terms
|
||||
convertTerm gram (A.LI var) = Var var
|
||||
convertTerm gram (A.R rec) = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
|
||||
convertTerm gram (A.P term lbl) = convertTerm gram term +. lbl
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/21 16:23:17 $
|
||||
-- > CVS $Date: 2005/06/17 14:15:19 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- Instances for printing terms in a simplified format
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -23,8 +23,8 @@ import qualified GF.Canon.PrintGFC as P
|
||||
|
||||
instance Print Term where
|
||||
prt (Arg arg) = prt arg
|
||||
prt (con `Con` []) = prt con
|
||||
prt (con `Con` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
|
||||
prt (con `Par` []) = prt con
|
||||
prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
|
||||
prt (LI ident) = prt ident
|
||||
prt (R record) = "{" ++ prtSep ";" record ++ "}"
|
||||
prt (term `P` lbl) = prt term ++ "." ++ prt lbl
|
||||
@@ -112,7 +112,7 @@ sizeCT (Cn cn) = 1
|
||||
sizeCT (TStr) = 1
|
||||
|
||||
sizeT :: Term -> Int
|
||||
sizeT (_ `Con` ts) = 2 + sum (map sizeT ts)
|
||||
sizeT (_ `Par` ts) = 2 + sum (map sizeT ts)
|
||||
sizeT (R rec) = 1 + sum [ sizeT t | _ `Ass` t <- rec ]
|
||||
sizeT (t `P` _) = 1 + sizeT t
|
||||
sizeT (T _ tbl) = 1 + sum [ sum (map sizeP ps) + sizeT t | ps `Cas` t <- tbl ]
|
||||
|
||||
Reference in New Issue
Block a user