diff options
| author | peb <unknown> | 2005-02-17 09:12:32 +0000 |
|---|---|---|
| committer | peb <unknown> | 2005-02-17 09:12:32 +0000 |
| commit | 359f1b8ea2032fbf5b8ad7ad6c88e922fa83470b (patch) | |
| tree | 17d52866d7f97c1817832eefb741e07a0b54cffb /src/GF | |
| parent | 55f889eda88d847ace5cdae00b175434006be287 (diff) | |
"Committed_by_peb"
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/CF/PPrCF.hs | 2 | ||||
| -rw-r--r-- | src/GF/Canon/MkGFC.hs | 4 | ||||
| -rw-r--r-- | src/GF/Data/Str.hs | 1 | ||||
| -rw-r--r-- | src/GF/Data/Trie2.hs | 2 | ||||
| -rw-r--r-- | src/GF/Infra/ReadFiles.hs | 8 | ||||
| -rw-r--r-- | src/GF/Text/Unicode.hs | 1 |
6 files changed, 18 insertions, 0 deletions
diff --git a/src/GF/CF/PPrCF.hs b/src/GF/CF/PPrCF.hs index 11a710986..5f00e4b7e 100644 --- a/src/GF/CF/PPrCF.hs +++ b/src/GF/CF/PPrCF.hs @@ -50,9 +50,11 @@ prCFFun' profs (CFFun (t, p)) = prt_ t ++ pp p where prCFCat :: CFCat -> String prCFCat (CFCat (c,l)) = prt_ c ++ "-" ++ prt_ l ---- +prCFItem :: CFItem -> String prCFItem (CFNonterm c) = prCFCat c prCFItem (CFTerm a) = prRegExp a +prRegExp :: RegExp -> String prRegExp (RegAlts tt) = case tt of [t] -> prQuotedString t _ -> prParenth (prTList " | " (map prQuotedString tt)) diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs index a1dfdbe2f..d1cf29e93 100644 --- a/src/GF/Canon/MkGFC.hs +++ b/src/GF/Canon/MkGFC.hs @@ -58,6 +58,7 @@ canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where grammar2canon :: CanonGrammar -> Canon grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules +info2mod :: (Ident, M.ModInfo Ident Flag Info) -> Module info2mod m = case m of (a, M.ModMod (M.Module mt _ flags me os defs)) -> let defs' = map info2def $ tree2list defs @@ -93,6 +94,7 @@ trCont cont = [(x,trExp t) | Decl x t <- cont] trFs = map trQIdent +trExp :: Exp -> A.Term trExp t = case t of EProd x a b -> A.Prod x (trExp a) (trExp b) EAbs x b -> A.Abs x (trExp b) @@ -136,6 +138,7 @@ rtCont cont = [Decl (rtIdent x) (rtExp t) | (x,t) <- cont] rtFs = map rtQIdent +rtExp :: A.Term -> Exp rtExp t = case t of A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b) A.Abs x b -> EAbs (rtIdent x) (rtExp b) @@ -162,6 +165,7 @@ rtExp t = case t of _ -> error $ "MkGFC.rt not defined for" +++ show p +rtQIdent :: (Ident, Ident) -> CIdent rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c) rtIdent x | isWildIdent x = identC "h_" --- needed in declarations diff --git a/src/GF/Data/Str.hs b/src/GF/Data/Str.hs index 138c39f26..743d9edc9 100644 --- a/src/GF/Data/Str.hs +++ b/src/GF/Data/Str.hs @@ -102,6 +102,7 @@ isZeroTok t = case t of strTok :: Ss -> [(Ss,[String])] -> Str strTok ds vs = Str [TN ds vs] +prStr :: Str -> String prStr = prQuotedString . sstr plusStr :: Str -> Str -> Str diff --git a/src/GF/Data/Trie2.hs b/src/GF/Data/Trie2.hs index 5f2d3de0a..08a6531be 100644 --- a/src/GF/Data/Trie2.hs +++ b/src/GF/Data/Trie2.hs @@ -30,6 +30,8 @@ newtype TrieT a b = TrieT ([(a,TrieT a b)],[b]) newtype Trie a b = Trie (Map a (Trie a b), [b]) emptyTrieT = TrieT ([],[]) + +emptyTrie :: Trie a b emptyTrie = Trie (empty,[]) optimize :: (Ord a,Eq b) => TrieT a b -> Trie a b diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index 8f6b5c971..7fd81386e 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/src/GF/Infra/ReadFiles.hs @@ -161,12 +161,19 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where CSRead -> gfcFile CSRes -> gfrFile +isGFC :: FilePath -> Bool isGFC = (== "gfc") . fileSuffix +gfcFile :: FilePath -> FilePath gfcFile = suffixFile "gfc" + +gfrFile :: FilePath -> FilePath gfrFile = suffixFile "gfr" + +gfFile :: FilePath -> FilePath gfFile = suffixFile "gf" +resModName :: ModName -> ModName resModName = ('#':) -- to get imports without parsing the whole files @@ -306,6 +313,7 @@ isOldFile f = do -- old GF tolerated newlines in quotes. No more supported! +fixNewlines :: String -> String fixNewlines s = case s of '"':cs -> '"':mk cs c :cs -> c:fixNewlines cs diff --git a/src/GF/Text/Unicode.hs b/src/GF/Text/Unicode.hs index 9039fbef0..e2775eb91 100644 --- a/src/GF/Text/Unicode.hs +++ b/src/GF/Text/Unicode.hs @@ -31,6 +31,7 @@ import ExtraDiacritics (mkExtraDiacritics) import Char +mkUnicode :: String -> String mkUnicode s = case s of '/':'/':cs -> treat [] mkGreek unic ++ mkUnicode rest '/':'+':cs -> mkHebrew unic ++ mkUnicode rest |
