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 diff --git a/src/haddock/haddock-check.perl b/src/haddock/haddock-check.perl index 57e311ed2..b65fbcc68 100644 --- a/src/haddock/haddock-check.perl +++ b/src/haddock/haddock-check.perl @@ -1,5 +1,11 @@ -# checking that a file is haddocky +# checking that a file is haddocky: +# - checking if it has an export list +# - checking that all exported functions have type signatures +# - checking that the module header is OK + +# changes on files: +# - transforming hard space to ordinary space # limitations: # - does not check that type aliases are put in the export list @@ -8,6 +14,17 @@ $operSym = qr/[\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]+/; $funSym = qr/[a-z]\w*\'*/; +sub check_headerline { + my ($title, $regexp) = @_; + if (s/^-- $title *: +(.+?) *\n//s) { + $name = $1; + print " > Incorrect ".lcfirst $title.": $name\n" unless $name =~ $regexp; + } else { + print " > Header missing".lcfirst $title."\n"; + } +} + + for $file (@ARGV) { $file =~ s/\.hs//; @@ -15,7 +32,22 @@ for $file (@ARGV) { $_ = join "", ; close F; - # print "- $file\n"; + print "-- $file\n"; + + # the module header + s/^(--+\s*\n)+//s; + unless (s/^-- \|\s*\n//s) { + print " > Incorrect module header\n"; + } else { + &check_headerline("Module", qr/^[A-Z]\w*$/); + &check_headerline("Maintainer", qr/^[\wåäöÅÄÖüÜ\s\@\.]+$/); + &check_headerline("Stability", qr/.*/); + &check_headerline("Portability", qr/.*/); + s/^(--+\s*\n)+//s; + print " > Missing CVS information\n" unless s/^(-- > CVS +\$.*?\$ *\n)+//s; + s/^(--+\s*\n)+//s; + print " > Missing module description\n" unless /^-- +[^\(]/; + } # removing comments s/\{-.*?-\}//gs; @@ -41,25 +73,25 @@ for $file (@ARGV) { $exportlist =~ s/\Q$function\E//; } - # type aliases - while (/\ntype\s+(\w+)/gs) { - $type = $1; - next if $exportlist =~ /\b$type\b/; - printf "%-30s | Type alias not in export list: %s\n", $file, $type; - } - # exported functions without type signatures while ($exportlist =~ /(\b$funSym\b|\($operSym\))/gs) { $function = $1; # print "+ $function\n"; next if $function =~ /^[A-Z]/; next if $function =~ /^\((\.\.|\:\:?|\=|\\|\||\<\-|\-\>|\@|\~|\=\>)\)$/; - printf "%-30s | No type signature for function: %s\n", $file, $function; + print " > No type signature for function: $function\n"; } + # type aliases + # while (/\ntype\s+(\w+)/gs) { + # $type = $1; + # next if $exportlist =~ /\b$type\b/; + # printf "%-30s | Type alias not in export list: %s\n", $file, $type; + # } + } else { # modules without export lists - printf "%-30s | No export list\n", $file; + print " > No export list\n"; } } diff --git a/src/module-structure.txt b/src/module-structure.txt index 678f47d28..31ececcc2 100644 --- a/src/module-structure.txt +++ b/src/module-structure.txt @@ -172,7 +172,7 @@ GF/ IncrementalChart MCFGrammar -> Grammar MCFParserBasic - MCFRange + MCFRange - obsolet ParseCF ParseCFG ParseGFC