forked from GitHub/gf-core
"Committed_by_peb"
This commit is contained in:
@@ -50,9 +50,11 @@ prCFFun' profs (CFFun (t, p)) = prt_ t ++ pp p where
|
|||||||
prCFCat :: CFCat -> String
|
prCFCat :: CFCat -> String
|
||||||
prCFCat (CFCat (c,l)) = prt_ c ++ "-" ++ prt_ l ----
|
prCFCat (CFCat (c,l)) = prt_ c ++ "-" ++ prt_ l ----
|
||||||
|
|
||||||
|
prCFItem :: CFItem -> String
|
||||||
prCFItem (CFNonterm c) = prCFCat c
|
prCFItem (CFNonterm c) = prCFCat c
|
||||||
prCFItem (CFTerm a) = prRegExp a
|
prCFItem (CFTerm a) = prRegExp a
|
||||||
|
|
||||||
|
prRegExp :: RegExp -> String
|
||||||
prRegExp (RegAlts tt) = case tt of
|
prRegExp (RegAlts tt) = case tt of
|
||||||
[t] -> prQuotedString t
|
[t] -> prQuotedString t
|
||||||
_ -> prParenth (prTList " | " (map prQuotedString tt))
|
_ -> prParenth (prTList " | " (map prQuotedString tt))
|
||||||
|
|||||||
@@ -58,6 +58,7 @@ canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules where
|
|||||||
grammar2canon :: CanonGrammar -> Canon
|
grammar2canon :: CanonGrammar -> Canon
|
||||||
grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules
|
grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules
|
||||||
|
|
||||||
|
info2mod :: (Ident, M.ModInfo Ident Flag Info) -> Module
|
||||||
info2mod m = case m of
|
info2mod m = case m of
|
||||||
(a, M.ModMod (M.Module mt _ flags me os defs)) ->
|
(a, M.ModMod (M.Module mt _ flags me os defs)) ->
|
||||||
let defs' = map info2def $ tree2list defs
|
let defs' = map info2def $ tree2list defs
|
||||||
@@ -93,6 +94,7 @@ trCont cont = [(x,trExp t) | Decl x t <- cont]
|
|||||||
|
|
||||||
trFs = map trQIdent
|
trFs = map trQIdent
|
||||||
|
|
||||||
|
trExp :: Exp -> A.Term
|
||||||
trExp t = case t of
|
trExp t = case t of
|
||||||
EProd x a b -> A.Prod x (trExp a) (trExp b)
|
EProd x a b -> A.Prod x (trExp a) (trExp b)
|
||||||
EAbs x b -> A.Abs x (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
|
rtFs = map rtQIdent
|
||||||
|
|
||||||
|
rtExp :: A.Term -> Exp
|
||||||
rtExp t = case t of
|
rtExp t = case t of
|
||||||
A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b)
|
A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b)
|
||||||
A.Abs x b -> EAbs (rtIdent x) (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
|
_ -> error $ "MkGFC.rt not defined for" +++ show p
|
||||||
|
|
||||||
|
|
||||||
|
rtQIdent :: (Ident, Ident) -> CIdent
|
||||||
rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
|
rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
|
||||||
rtIdent x
|
rtIdent x
|
||||||
| isWildIdent x = identC "h_" --- needed in declarations
|
| isWildIdent x = identC "h_" --- needed in declarations
|
||||||
|
|||||||
@@ -102,6 +102,7 @@ isZeroTok t = case t of
|
|||||||
strTok :: Ss -> [(Ss,[String])] -> Str
|
strTok :: Ss -> [(Ss,[String])] -> Str
|
||||||
strTok ds vs = Str [TN ds vs]
|
strTok ds vs = Str [TN ds vs]
|
||||||
|
|
||||||
|
prStr :: Str -> String
|
||||||
prStr = prQuotedString . sstr
|
prStr = prQuotedString . sstr
|
||||||
|
|
||||||
plusStr :: Str -> Str -> Str
|
plusStr :: Str -> Str -> Str
|
||||||
|
|||||||
@@ -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])
|
newtype Trie a b = Trie (Map a (Trie a b), [b])
|
||||||
|
|
||||||
emptyTrieT = TrieT ([],[])
|
emptyTrieT = TrieT ([],[])
|
||||||
|
|
||||||
|
emptyTrie :: Trie a b
|
||||||
emptyTrie = Trie (empty,[])
|
emptyTrie = Trie (empty,[])
|
||||||
|
|
||||||
optimize :: (Ord a,Eq b) => TrieT a b -> Trie a b
|
optimize :: (Ord a,Eq b) => TrieT a b -> Trie a b
|
||||||
|
|||||||
@@ -161,12 +161,19 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
|
|||||||
CSRead -> gfcFile
|
CSRead -> gfcFile
|
||||||
CSRes -> gfrFile
|
CSRes -> gfrFile
|
||||||
|
|
||||||
|
isGFC :: FilePath -> Bool
|
||||||
isGFC = (== "gfc") . fileSuffix
|
isGFC = (== "gfc") . fileSuffix
|
||||||
|
|
||||||
|
gfcFile :: FilePath -> FilePath
|
||||||
gfcFile = suffixFile "gfc"
|
gfcFile = suffixFile "gfc"
|
||||||
|
|
||||||
|
gfrFile :: FilePath -> FilePath
|
||||||
gfrFile = suffixFile "gfr"
|
gfrFile = suffixFile "gfr"
|
||||||
|
|
||||||
|
gfFile :: FilePath -> FilePath
|
||||||
gfFile = suffixFile "gf"
|
gfFile = suffixFile "gf"
|
||||||
|
|
||||||
|
resModName :: ModName -> ModName
|
||||||
resModName = ('#':)
|
resModName = ('#':)
|
||||||
|
|
||||||
-- to get imports without parsing the whole files
|
-- to get imports without parsing the whole files
|
||||||
@@ -306,6 +313,7 @@ isOldFile f = do
|
|||||||
|
|
||||||
|
|
||||||
-- old GF tolerated newlines in quotes. No more supported!
|
-- old GF tolerated newlines in quotes. No more supported!
|
||||||
|
fixNewlines :: String -> String
|
||||||
fixNewlines s = case s of
|
fixNewlines s = case s of
|
||||||
'"':cs -> '"':mk cs
|
'"':cs -> '"':mk cs
|
||||||
c :cs -> c:fixNewlines cs
|
c :cs -> c:fixNewlines cs
|
||||||
|
|||||||
@@ -31,6 +31,7 @@ import ExtraDiacritics (mkExtraDiacritics)
|
|||||||
|
|
||||||
import Char
|
import Char
|
||||||
|
|
||||||
|
mkUnicode :: String -> String
|
||||||
mkUnicode s = case s of
|
mkUnicode s = case s of
|
||||||
'/':'/':cs -> treat [] mkGreek unic ++ mkUnicode rest
|
'/':'/':cs -> treat [] mkGreek unic ++ mkUnicode rest
|
||||||
'/':'+':cs -> mkHebrew unic ++ mkUnicode rest
|
'/':'+':cs -> mkHebrew unic ++ mkUnicode rest
|
||||||
|
|||||||
@@ -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:
|
# limitations:
|
||||||
# - does not check that type aliases are put in the export list
|
# - does not check that type aliases are put in the export list
|
||||||
@@ -8,6 +14,17 @@
|
|||||||
$operSym = qr/[\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]+/;
|
$operSym = qr/[\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]+/;
|
||||||
$funSym = qr/[a-z]\w*\'*/;
|
$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) {
|
for $file (@ARGV) {
|
||||||
$file =~ s/\.hs//;
|
$file =~ s/\.hs//;
|
||||||
|
|
||||||
@@ -15,7 +32,22 @@ for $file (@ARGV) {
|
|||||||
$_ = join "", <F>;
|
$_ = join "", <F>;
|
||||||
close F;
|
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
|
# removing comments
|
||||||
s/\{-.*?-\}//gs;
|
s/\{-.*?-\}//gs;
|
||||||
@@ -41,25 +73,25 @@ for $file (@ARGV) {
|
|||||||
$exportlist =~ s/\Q$function\E//;
|
$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
|
# exported functions without type signatures
|
||||||
while ($exportlist =~ /(\b$funSym\b|\($operSym\))/gs) {
|
while ($exportlist =~ /(\b$funSym\b|\($operSym\))/gs) {
|
||||||
$function = $1;
|
$function = $1;
|
||||||
# print "+ $function\n";
|
# print "+ $function\n";
|
||||||
next if $function =~ /^[A-Z]/;
|
next if $function =~ /^[A-Z]/;
|
||||||
next if $function =~ /^\((\.\.|\:\:?|\=|\\|\||\<\-|\-\>|\@|\~|\=\>)\)$/;
|
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 {
|
} else {
|
||||||
# modules without export lists
|
# modules without export lists
|
||||||
printf "%-30s | No export list\n", $file;
|
print " > No export list\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -172,7 +172,7 @@ GF/
|
|||||||
IncrementalChart
|
IncrementalChart
|
||||||
MCFGrammar -> Grammar
|
MCFGrammar -> Grammar
|
||||||
MCFParserBasic
|
MCFParserBasic
|
||||||
MCFRange
|
MCFRange - obsolet
|
||||||
ParseCF
|
ParseCF
|
||||||
ParseCFG
|
ParseCFG
|
||||||
ParseGFC
|
ParseGFC
|
||||||
|
|||||||
Reference in New Issue
Block a user