diff options
| -rw-r--r-- | src/GF/GFCC/Raw/AbsGFCCRaw.hs | 1 | ||||
| -rw-r--r-- | src/GF/GFCC/Raw/ConvertGFCC.hs | 22 | ||||
| -rw-r--r-- | src/GF/GFCC/Raw/ParGFCCRaw.hs | 11 | ||||
| -rw-r--r-- | src/GF/GFCC/Raw/PrintGFCCRaw.hs | 19 |
4 files changed, 25 insertions, 28 deletions
diff --git a/src/GF/GFCC/Raw/AbsGFCCRaw.hs b/src/GF/GFCC/Raw/AbsGFCCRaw.hs index 7792c0450..ab5f184a8 100644 --- a/src/GF/GFCC/Raw/AbsGFCCRaw.hs +++ b/src/GF/GFCC/Raw/AbsGFCCRaw.hs @@ -9,7 +9,6 @@ data Grammar = data RExp = App CId [RExp] - | AId CId | AInt Integer | AStr String | AFlt Double diff --git a/src/GF/GFCC/Raw/ConvertGFCC.hs b/src/GF/GFCC/Raw/ConvertGFCC.hs index b477e9f94..2b0db7a0f 100644 --- a/src/GF/GFCC/Raw/ConvertGFCC.hs +++ b/src/GF/GFCC/Raw/ConvertGFCC.hs @@ -16,7 +16,7 @@ import Data.Map toGFCC :: Grammar -> GFCC toGFCC (Grm [ - App (CId "grammar") (AId a:cs), + App (CId "grammar") (App a []:cs), App (CId "flags") gfs, ab@( App (CId "abstract") [ @@ -26,7 +26,7 @@ toGFCC (Grm [ App (CId "concrete") ccs ]) = GFCC { absname = a, - cncnames = [c | AId c <- cs], + cncnames = [c | App c [] <- cs], gflags = fromAscList [(f,v) | App f [AStr v] <- gfs], abstract = let @@ -134,15 +134,15 @@ toHypo e = case e of toExp :: RExp -> Exp toExp e = case e of - App fun [App (CId "B") xs, App (CId "X") exps] -> - DTr [x | AId x <- xs] (AC fun) (lmap toExp exps) + App (CId "App") [App fun [], App (CId "B") xs, App (CId "X") exps] -> + DTr [x | App x [] <- xs] (AC fun) (lmap toExp exps) App (CId "Eq") eqs -> EEq [Equ (lmap toExp ps) (toExp v) | App (CId "E") (v:ps) <- eqs] + App (CId "Var") [App i []] -> DTr [] (AV i) [] AMet -> DTr [] (AM 0) [] AInt i -> DTr [] (AI i) [] AFlt i -> DTr [] (AF i) [] AStr i -> DTr [] (AS i) [] - AId i -> DTr [] (AV i) [] _ -> error $ "exp " ++ show e toTerm :: RExp -> Term @@ -153,10 +153,10 @@ toTerm e = case e of App (CId "P") [e,v] -> P (toTerm e) (toTerm v) App (CId "RP") [e,v] -> RP (toTerm e) (toTerm v) ---- App (CId "W") [AStr s,v] -> W s (toTerm v) + App (CId "A") [AInt i] -> V (fromInteger i) + App f [] -> F f AInt i -> C (fromInteger i) AMet -> TM - AId f -> F f - App (CId "A") [AInt i] -> V (fromInteger i) AStr s -> K (KS s) ---- _ -> error $ "term " ++ show e @@ -166,7 +166,7 @@ toTerm e = case e of fromGFCC :: GFCC -> Grammar fromGFCC gfcc0 = Grm [ - app "grammar" (AId (absname gfcc) : lmap AId (cncnames gfcc)), + app "grammar" (App (absname gfcc) [] : lmap (flip App []) (cncnames gfcc)), app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)], app "abstract" [ app "fun" [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)], @@ -202,10 +202,10 @@ fromHypo e = case e of fromExp :: Exp -> RExp fromExp e = case e of DTr xs (AC fun) exps -> - App fun [App (CId "B") (lmap AId xs), App (CId "X") (lmap fromExp exps)] + App (CId "App") [App fun [], App (CId "B") (lmap (flip App []) xs), App (CId "X") (lmap fromExp exps)] + DTr [] (AV x) [] -> App (CId "Var") [App x []] DTr [] (AS s) [] -> AStr s DTr [] (AF d) [] -> AFlt d - DTr [] (AV x) [] -> AId x DTr [] (AI i) [] -> AInt (toInteger i) DTr [] (AM _) [] -> AMet ---- EEq eqs -> @@ -222,7 +222,7 @@ fromTerm e = case e of W s v -> app "W" [AStr s, fromTerm v] C i -> AInt (toInteger i) TM -> AMet - F f -> AId f + F f -> App f [] V i -> App (CId "A") [AInt (toInteger i)] K (KS s) -> AStr s ---- K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ---- diff --git a/src/GF/GFCC/Raw/ParGFCCRaw.hs b/src/GF/GFCC/Raw/ParGFCCRaw.hs index 455b2713a..06ed83c04 100644 --- a/src/GF/GFCC/Raw/ParGFCCRaw.hs +++ b/src/GF/GFCC/Raw/ParGFCCRaw.hs @@ -14,13 +14,12 @@ pGrammar :: P Grammar pGrammar = liftM Grm pTerms pTerms :: P [RExp] -pTerms = liftM2 (:) pTerm pTerms <++ (skipSpaces >> return []) +pTerms = liftM2 (:) (pTerm 1) pTerms <++ (skipSpaces >> return []) -pTerm :: P RExp -pTerm = skipSpaces >> (pApp <++ pId <++ pNum <++ pStr <++ pMeta) - where pApp = between (char '(') (char ')') - (liftM2 App pIdent pTerms) - pId = liftM AId pIdent +pTerm :: Int -> P RExp +pTerm n = skipSpaces >> (pParen <++ pApp <++ pNum <++ pStr <++ pMeta) + where pParen = between (char '(') (char ')') (pTerm 0) + pApp = liftM2 App pIdent (if n == 0 then pTerms else return []) pStr = char '"' >> liftM AStr (manyTill (pEsc <++ get) (char '"')) -- FIXME: what escapes are used? pEsc = char '\\' >> get diff --git a/src/GF/GFCC/Raw/PrintGFCCRaw.hs b/src/GF/GFCC/Raw/PrintGFCCRaw.hs index d1041e380..45ca6b9cb 100644 --- a/src/GF/GFCC/Raw/PrintGFCCRaw.hs +++ b/src/GF/GFCC/Raw/PrintGFCCRaw.hs @@ -10,15 +10,14 @@ printTree g = prGrammar g "" prGrammar :: Grammar -> ShowS prGrammar (Grm xs) = prRExpList xs -prRExp :: RExp -> ShowS -prRExp (App x []) = showChar '(' . prCId x . showChar ')' -prRExp (App x xs) = showChar '(' . prCId x . showChar ' ' - . prRExpList xs . showChar ')' -prRExp (AId x) = prCId x -prRExp (AInt x) = shows x -prRExp (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"' -prRExp (AFlt x) = shows x -- FIXME: simpler format -prRExp AMet = showChar '?' +prRExp :: Int -> RExp -> ShowS +prRExp _ (App x []) = prCId x +prRExp n (App x xs) = p (prCId x . showChar ' ' . prRExpList xs) + where p s = if n == 0 then s else showChar '(' . s . showChar ')' +prRExp _ (AInt x) = shows x +prRExp _ (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"' +prRExp _ (AFlt x) = shows x -- FIXME: simpler format +prRExp _ AMet = showChar '?' mkEsc :: Char -> ShowS mkEsc s = case s of @@ -29,7 +28,7 @@ mkEsc s = case s of _ -> showChar s prRExpList :: [RExp] -> ShowS -prRExpList = concatS . intersperse (showChar ' ') . map prRExp +prRExpList = concatS . intersperse (showChar ' ') . map (prRExp 1) prCId :: CId -> ShowS prCId (CId x) = showString x |