diff options
Diffstat (limited to 'src/GF/CF')
| -rw-r--r-- | src/GF/CF/CFIdent.hs | 10 | ||||
| -rw-r--r-- | src/GF/CF/CFtoGrammar.hs | 50 | ||||
| -rw-r--r-- | src/GF/CF/PPrCF.hs | 23 |
3 files changed, 76 insertions, 7 deletions
diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs index 99ab711e4..95d532e2d 100644 --- a/src/GF/CF/CFIdent.hs +++ b/src/GF/CF/CFIdent.hs @@ -68,6 +68,10 @@ varCFFun = mkCFFun . AV consCFFun :: CIdent -> CFFun consCFFun = mkCFFun . AC +-- standard way of making cf fun +string2CFFun :: String -> String -> CFFun +string2CFFun m c = consCFFun $ mkCIdent m c + stringCFFun :: String -> CFFun stringCFFun = mkCFFun . AS @@ -80,6 +84,9 @@ dummyCFFun = varCFFun $ identC "_" --- used in lexer-by-need rules cfFun2String :: CFFun -> String cfFun2String (CFFun (f,_)) = prt f +cfFun2Ident :: CFFun -> Ident +cfFun2Ident (CFFun (f,_)) = identC $ prt_ f --- + cfFun2Profile :: CFFun -> Profile cfFun2Profile (CFFun (_,p)) = p @@ -131,6 +138,9 @@ moduleOfCFCat (CFCat (CIQ m _, _)) = m cfCat2Cat :: CFCat -> (Ident,Ident) cfCat2Cat (CFCat (CIQ m c,_)) = (m,c) +cfCat2Ident :: CFCat -> Ident +cfCat2Ident = snd . cfCat2Cat + lexCFCat :: CFCat -> CFCat lexCFCat cat = ident2CFCat (uncurry CIQ (cfCat2Cat cat)) (identC "*") diff --git a/src/GF/CF/CFtoGrammar.hs b/src/GF/CF/CFtoGrammar.hs new file mode 100644 index 000000000..440c4f7c3 --- /dev/null +++ b/src/GF/CF/CFtoGrammar.hs @@ -0,0 +1,50 @@ +module CFtoGrammar where + +import Ident +import Grammar +import qualified AbsGF as A +import qualified GrammarToSource as S +import Macros + +import CF +import CFIdent +import PPrCF + +import Operations + +import List (nub) +import Char (isSpace) + +-- 26/1/2000 -- 18/4 -- 24/3/2004 + +cf2grammar :: CF -> [A.TopDef] +cf2grammar cf = concatMap S.trAnyDef (abs ++ conc) where + rules = rulesOfCF cf + abs = cats ++ funs + conc = lintypes ++ lins + cats = [(cat, AbsCat (yes []) (yes [])) | + cat <- nub (concat (map cf2cat rules))] ----notPredef cat + lintypes = [] ----[(cat, CncCat (yes) nope Nothing) | (cat,AbsCat _ _) <- cats] + (funs,lins) = unzip (map cf2rule rules) + +cf2cat :: CFRule -> [Ident] +cf2cat (_,(cat, items)) = map cfCat2Ident $ cat : [c | CFNonterm c <- items] + +cf2rule :: CFRule -> ((Ident,Info),(Ident,Info)) +cf2rule (fun, (cat, items)) = (def,ldef) where + f = cfFun2Ident fun + def = (f, AbsFun (yes (mkProd (args', Cn (cfCat2Ident cat), []))) nope) + args0 = zip (map (mkIdent "x") [0..]) items + args = [(v, Cn (cfCat2Ident c)) | (v, CFNonterm c) <- args0] + args' = [(zIdent "_", Cn (cfCat2Ident c)) | (_, CFNonterm c) <- args0] + ldef = (f, CncFun + Nothing + (yes (mkAbs (map fst args) + (mkRecord linLabel [foldconcat (map mkIt args0)]))) + nope) + mkIt (v, CFNonterm _) = P (Vr v) (linLabel 0) + mkIt (_, CFTerm (RegAlts [a])) = K a + mkIt _ = K "" --- regexp not recognized in input CF ; use EBNF for this + foldconcat [] = K "" + foldconcat tt = foldr1 C tt + diff --git a/src/GF/CF/PPrCF.hs b/src/GF/CF/PPrCF.hs index ff4b64e66..91ab240ea 100644 --- a/src/GF/CF/PPrCF.hs +++ b/src/GF/CF/PPrCF.hs @@ -6,6 +6,8 @@ import CFIdent import AbsGFC import PrGrammar +import Char + -- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003 ---- use the Print class instead! @@ -42,18 +44,25 @@ prRegExp (RegAlts tt) = case tt of [t] -> prQuotedString t _ -> prParenth (prTList " | " (map prQuotedString tt)) -{- ---- -- rules have an amazingly easy parser, if we use the format -- fun. C -> item1 item2 ... where unquoted items are treated as cats -- Actually would be nice to add profiles to this. -getCFRule :: String -> Maybe CFRule -getCFRule s = getcf (wrds s) where +getCFRule :: String -> String -> Err CFRule +getCFRule mo s = getcf (wrds s) where getcf ww | length ww > 2 && ww !! 2 `elem` ["->", "::="] = - Just (string2CFFun (init fun), (string2CFCat cat, map mkIt its)) where + Ok (string2CFFun mo (init fun), (string2CFCat mo cat, map mkIt its)) where fun : cat : _ : its = words s mkIt ('"':w@(_:_)) = atomCFTerm (string2CFTok (init w)) - mkIt w = CFNonterm (string2CFCat w) - getcf _ = Nothing + mkIt w = CFNonterm (string2CFCat mo w) + getcf _ = Bad "invalid rule" wrds = takeWhile (/= ";") . words -- to permit semicolon in the end --}
\ No newline at end of file + +pCF :: String -> String -> Err CF +pCF mo s = do + rules <- mapM (getCFRule mo) $ filter isRule $ lines s + return $ rules2CF rules + where + isRule line = case line of + '-':'-':_ -> False + _ -> not $ all isSpace line |