Verified Commit c2bc5849 authored by Camil Staps's avatar Camil Staps
Browse files

Export strictness information

parent 5222f24c
Subproject commit 065c0d26df7930e164e08bda26db895b856c39f9
Subproject commit d5203167663810f98608a0ad75e6257d0b1f3dd8
......@@ -182,7 +182,7 @@ derive JSONDecode CloogleEntry
*/
:: SyntaxPattern :== String
patternMatches :: SyntaxPattern String -> Bool
patternMatches :: !SyntaxPattern !String -> Bool
:: Name :== String
:: Library :== String
......@@ -194,28 +194,28 @@ instance == Location
instance zero FunctionEntry
instance zero ModuleEntry
instance print (Name, FunctionEntry)
instance print (!Name, !FunctionEntry)
class getLocation a :: a -> Maybe Location
class getLocation a :: !a -> Maybe Location
instance getLocation FunctionEntry
instance getLocation TypeDefEntry
instance getLocation ModuleEntry
instance getLocation ClassEntry
instance getLocation CloogleEntry
getLibrary :: Location -> Maybe Name
getModule :: Location -> Maybe Name
getFilename :: Location -> Maybe String
getDclLine :: Location -> Maybe Int
getIclLine :: Location -> Maybe Int
getName :: Location -> Name
setName :: Name Location -> Location
isBuiltin :: Location -> Bool
getLibrary :: !Location -> Maybe Name
getModule :: !Location -> Maybe Name
getFilename :: !Location -> Maybe String
getDclLine :: !Location -> Maybe Int
getIclLine :: !Location -> Maybe Int
getName :: !Location -> Name
setName :: !Name !Location -> Location
isBuiltin :: !Location -> Bool
toTypeDefEntry :: Location TypeDef (Maybe TypeDoc) -> TypeDefEntry
getTypeDef :: TypeDefEntry -> TypeDef
getTypeDefDoc :: TypeDefEntry -> Maybe TypeDoc
mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
toTypeDefEntry :: !Location !TypeDef !(Maybe TypeDoc) -> TypeDefEntry
getTypeDef :: !TypeDefEntry -> TypeDef
getTypeDefDoc :: !TypeDefEntry -> Maybe TypeDoc
mergeTypeDefEntries :: !TypeDefEntry !TypeDefEntry -> TypeDefEntry
/**
* Wrapper around the Class record field to work around name clashes
......@@ -227,10 +227,10 @@ mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
* @param The documentation
* @result A Class record with those data
*/
toClass :: Location [String] Bool TypeContext (Maybe ClassDoc) -> ClassEntry
classContext :: ClassEntry -> [TypeRestriction]
toClass :: !Location ![String] !Bool !TypeContext !(Maybe ClassDoc) -> ClassEntry
classContext :: !ClassEntry -> [TypeRestriction]
saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
saveDB :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
openDB :: !*File -> *(!Maybe *CloogleDB, !*File)
/**
......@@ -259,7 +259,7 @@ filterName :: !String !*CloogleDB -> *CloogleDB
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUsages :: [String] !*CloogleDB -> *CloogleDB
filterUsages :: ![String] !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
......
......@@ -111,7 +111,7 @@ where
, me_usages=[]
}
instance print (Name, FunctionEntry)
instance print (!Name, !FunctionEntry)
where
print b (f, fe)
= gen -- fname -- " " -- prio -- vars -- if (isJust fe.fe_type) (":: " -- fe.fe_type) []
......@@ -128,7 +128,7 @@ where
| fe.fe_kind == RecordField = "." +++ f
| otherwise = f
patternMatches :: SyntaxPattern String -> Bool
patternMatches :: !SyntaxPattern !String -> Bool
patternMatches p s = m [c \\ c <-: p] [c \\ c <-: s]
where
// %: any character
......@@ -145,7 +145,6 @@ where
m [c:p] [x:s] = c == x && m p s
m _ _ = False
class getLocation a :: a -> Maybe Location
instance getLocation FunctionEntry where getLocation fe = Just fe.fe_loc
instance getLocation TypeDefEntry where getLocation tde = Just tde.tde_loc
instance getLocation ModuleEntry where getLocation me = Just me.me_loc
......@@ -158,39 +157,39 @@ where
getLocation (ClassEntry e) = getLocation e
getLocation _ = Nothing
getLibrary :: Location -> Maybe Name
getLibrary :: !Location -> Maybe Name
getLibrary (Location lib _ _ _ _ _) = Just lib
getLibrary _ = Nothing
getModule :: Location -> Maybe Name
getModule :: !Location -> Maybe Name
getModule (Location _ mod _ _ _ _) = Just mod
getModule _ = Nothing
getFilename :: Location -> Maybe String
getFilename :: !Location -> Maybe String
getFilename (Location _ _ fn _ _ _) = Just fn
getFilename _ = Nothing
getDclLine :: Location -> Maybe Int
getDclLine :: !Location -> Maybe Int
getDclLine (Location _ _ _ dcl _ _) = dcl
getDclLine _ = Nothing
getIclLine :: Location -> Maybe Int
getIclLine :: !Location -> Maybe Int
getIclLine (Location _ _ _ _ icl _) = icl
getIclLine _ = Nothing
getName :: Location -> Name
getName :: !Location -> Name
getName (Location _ _ _ _ _ name) = name
getName (Builtin name _) = name
setName :: Name Location -> Location
setName :: !Name !Location -> Location
setName n (Location lib mod fname dcl icl _) = Location lib mod fname dcl icl n
setName n (Builtin _ doc) = Builtin n doc
isBuiltin :: Location -> Bool
isBuiltin :: !Location -> Bool
isBuiltin (Builtin _ _) = True
isBuiltin _ = False
toTypeDefEntry :: Location TypeDef (Maybe TypeDoc) -> TypeDefEntry
toTypeDefEntry :: !Location !TypeDef !(Maybe TypeDoc) -> TypeDefEntry
toTypeDefEntry loc td doc =
{ tde_loc=loc
, tde_typedef=td
......@@ -200,19 +199,19 @@ toTypeDefEntry loc td doc =
, tde_usages=[]
}
getTypeDef :: TypeDefEntry -> TypeDef
getTypeDef :: !TypeDefEntry -> TypeDef
getTypeDef {tde_typedef} = tde_typedef
getTypeDefDoc :: TypeDefEntry -> Maybe TypeDoc
getTypeDefDoc :: !TypeDefEntry -> Maybe TypeDoc
getTypeDefDoc {tde_doc} = tde_doc
mergeTypeDefEntries :: TypeDefEntry TypeDefEntry -> TypeDefEntry
mergeTypeDefEntries :: !TypeDefEntry !TypeDefEntry -> TypeDefEntry
mergeTypeDefEntries a=:{tde_typedef={td_rhs=TDRAbstract Nothing}} b = case b.tde_typedef.td_rhs of
TDRAbstract _ -> a
rhs -> {a & tde_typedef.td_rhs=TDRAbstract (Just rhs)}
mergeTypeDefEntries a b = b
toClass :: Location [String] Bool TypeContext (Maybe ClassDoc) -> ClassEntry
toClass :: !Location ![String] !Bool !TypeContext !(Maybe ClassDoc) -> ClassEntry
toClass loc vs meta cc doc =
{ ce_loc = loc
, ce_vars = vs
......@@ -225,10 +224,10 @@ toClass loc vs meta cc doc =
, ce_usages = []
}
classContext :: ClassEntry -> [TypeRestriction]
classContext :: !ClassEntry -> [TypeRestriction]
classContext ce = ce.ce_context
saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
saveDB :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,
library_map,module_map,derive_map,instance_map,always_unique} f
# (db,f) = 'DB'.saveDB db f
......@@ -450,7 +449,7 @@ where
typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t
typeComplexity (Arrow Nothing) = 5.0
filterUsages :: [String] !*CloogleDB -> *CloogleDB
filterUsages :: ![String] !*CloogleDB -> *CloogleDB
filterUsages names wrap=:{db,name_map}
// For each name, the corresponding entries
# idxss = map (fromMaybe [] o flip get name_map) names
......
......@@ -43,12 +43,12 @@ instance < Index
/**
* Create a new database from a list of entries.
*/
newDB :: [v] -> *DB v ak a
newDB :: ![v] -> *DB v ak a
/**
* Save the database to a file.
*/
saveDB :: *(DB v ak a) *File -> *(*DB v ak a, *File) | JSONEncode{|*|} v
saveDB :: !*(DB v ak a) !*File -> *(!*DB v ak a, !*File) | JSONEncode{|*|} v
/**
* Open a database from a file.
......@@ -63,24 +63,24 @@ resetDB :: !*(DB v ak a) -> *DB v ak a
/**
* Return all entries (whether they have been excluded or not).
*/
allEntries :: *(DB v ak a) -> *([v], *DB v ak a)
allEntries :: !*(DB v ak a) -> *(![v], !*DB v ak a)
/**
* Get all entries that are still included, and their annotations.
*/
getEntries :: *(DB v ak a) -> *([(v, Map ak a)], *DB v ak a)
getEntries :: !*(DB v ak a) -> *(![(v, Map ak a)], !*DB v ak a)
/**
* An in-place map over all entries (also the excluded ones).
*/
mapInPlace :: (Int v -> v) *(DB v ak a) -> *(DB v ak a)
mapInPlace :: !(Int v -> v) !*(DB v ak a) -> *(DB v ak a)
/**
* Linear search for entries. The search function returns whether the entry
* should be included and which annotations should be added (if any). Excluded
* entries are ignored.
*/
search :: !SearchMode (v -> (Bool, [(ak, a)])) *(DB v ak a) -> *DB v ak a | ==, < ak
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(DB v ak a) -> *DB v ak a | ==, < ak
/**
* Like {{`search`}}, but search for specific indices.
......
......@@ -22,10 +22,10 @@ JSONDecode{|Index|} _ l = (Nothing, l)
instance == Index where == (Index a) (Index b) = a == b
instance < Index where < (Index a) (Index b) = a < b
newDB :: [v] -> *DB v ak a
newDB :: ![v] -> *DB v ak a
newDB vs = DB {{value=hyperstrict v,included=True,annotations=newMap} \\ v <- vs}
saveDB :: *(DB v ak a) *File -> *(*DB v ak a, *File) | JSONEncode{|*|} v
saveDB :: !*(DB v ak a) !*File -> *(!*DB v ak a, !*File) | JSONEncode{|*|} v
saveDB (DB db) f
# (s,db) = usize db
# f = f <<< toString s <<< "\n"
......@@ -72,7 +72,7 @@ where
# (e,es) = es![i]
= upd (i-1) {es & [i]={e & included=True}}
allEntries :: *(DB v ak a) -> *([v], *DB v ak a)
allEntries :: !*(DB v ak a) -> *(![v], !*DB v ak a)
allEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
......@@ -85,7 +85,7 @@ where
# (r,es) = collect (i-1) es
= ([e.value:r], es)
getEntries :: *(DB v ak a) -> *([(v, Map ak a)], *DB v ak a)
getEntries :: !*(DB v ak a) -> *(![(v, Map ak a)], !*DB v ak a)
getEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
......@@ -98,7 +98,7 @@ where
# (r,es) = collect (i-1) es
= (if e.included [(e.value,e.annotations):r] r, es)
mapInPlace :: (Int v -> v) *(DB v ak a) -> *(DB v ak a)
mapInPlace :: !(Int v -> v) !*(DB v ak a) -> *(DB v ak a)
mapInPlace f (DB db)
# (s,db) = usize db
= DB (upd 0 s db)
......@@ -110,7 +110,7 @@ where
#! e & value = hyperstrict $ f i e.value
= upd (i+1) s {es & [i]=e}
search :: !SearchMode (v -> (Bool, [(ak, a)])) *(DB v ak a) -> *DB v ak a | ==, < ak
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(DB v ak a) -> *DB v ak a | ==, < ak
search mode f (DB db)
# (s,db) = usize db
= DB (upd (s - 1) db)
......
......@@ -12,15 +12,15 @@ from Data.Maybe import :: Maybe
from TypeDef import :: Type
class docDescription d :: d -> Maybe Description
class docParams d :: d -> [Description]
class docVars d :: d -> [Description]
class docResults d :: d -> [Description]
class docType d :: d -> Maybe Type
class docMembers d :: d -> [Maybe ClassMemberDoc]
class docFields d :: d -> Maybe [Maybe Description]
class docConstructors d :: d -> Maybe [Maybe ConstructorDoc]
class docRepresentation d :: d -> Maybe (Maybe Description)
class docDescription d :: !d -> Maybe Description
class docParams d :: !d -> [Description]
class docVars d :: !d -> [Description]
class docResults d :: !d -> [Description]
class docType d :: !d -> Maybe Type
class docMembers d :: !d -> [Maybe ClassMemberDoc]
class docFields d :: !d -> Maybe [Maybe Description]
class docConstructors d :: !d -> Maybe [Maybe ConstructorDoc]
class docRepresentation d :: !d -> Maybe (Maybe Description)
/**
* Documentation of a Clean module.
......@@ -153,7 +153,7 @@ functionToClassMemberDoc :: FunctionDoc -> ClassMemberDoc
* @param The documentation on the class member
* @result The new ClassDoc
*/
addClassMemberDoc :: ClassDoc (Maybe ClassMemberDoc) -> ClassDoc
addClassMemberDoc :: !ClassDoc !(Maybe ClassMemberDoc) -> ClassDoc
/**
* Parse a single docstring, removing the asterisk and trimming whitespace.
......@@ -179,7 +179,7 @@ parseDoc :: String -> Either ParseError (d, [ParseWarning]) | docBlockToDoc{|*|}
* of the type happens.
* @var The thing to parse
*/
generic docBlockToDoc d :: (Either [String] DocBlock) -> Either ParseError (d, [ParseWarning])
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of d, RECORD
derive docBlockToDoc String, [], Maybe, Type
......@@ -189,9 +189,9 @@ derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
/**
* Trace a list of ParseWarnings like StdDebug might do it
*/
traceParseWarnings :: [ParseWarning] !a -> a
traceParseWarnings :: ![ParseWarning] !a -> a
/**
* Trace a ParseError like StdDebug might do it
*/
traceParseError :: ParseError !a -> a
traceParseError :: !ParseError !a -> a
......@@ -18,6 +18,7 @@ import Data.Generics.GenDefault
import Data.List
import Data.Maybe
import Data.Tuple
import Text.Language
from TypeDef import :: Type, :: TypeRestriction
import qualified TypeParse as T
......@@ -70,7 +71,7 @@ functionToClassMemberDoc d =
, type = d.FunctionDoc.type
}
addClassMemberDoc :: ClassDoc (Maybe ClassMemberDoc) -> ClassDoc
addClassMemberDoc :: !ClassDoc !(Maybe ClassMemberDoc) -> ClassDoc
addClassMemberDoc d m = {d & members=d.members ++ [m]}
parseSingleLineDoc :: (String -> String)
......@@ -79,7 +80,7 @@ parseSingleLineDoc = toString o trim o dropWhile ((==) '*') o fromString
parseDoc :: String -> Either ParseError (d, [ParseWarning]) | docBlockToDoc{|*|} d
parseDoc s = docBlockToDoc{|*|} (Left [s])
generic docBlockToDoc d :: (Either [String] DocBlock) -> Either ParseError (d, [ParseWarning])
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
docBlockToDoc{|String|} (Left []) = Left (UnknownError "no string")
docBlockToDoc{|String|} (Left ss) = Right (toString $ trim $ fromString $ last ss, [])
docBlockToDoc{|[]|} fx (Left ss) = (\vws -> (map fst vws, flatten (map snd vws)) ) <$> mapM fx (map (Left o pure) ss)
......@@ -94,7 +95,7 @@ where
(matches) infix 4 :: String String -> Bool
(matches) k name =
k == name ||
k +++ "s" == name ||
pluralise English k == name ||
k == "return" && name == "result" ||
k == "return" && name == "results"
docBlockToDoc{|RECORD|} fx (Left [s]) = case parseDocBlock s of
......@@ -182,13 +183,13 @@ where
toString (MissingField f) = "Doc error: required field '" +++ f +++ "' was missing"
toString (UnknownError e) = "Doc error: " +++ e
traceParseWarnings :: [ParseWarning] !a -> a
traceParseWarnings :: ![ParseWarning] !a -> a
traceParseWarnings [] x = x
traceParseWarnings [w:ws] x
| trace_tn w = traceParseWarnings ws x
| otherwise = undef
traceParseError :: ParseError !a -> a
traceParseError :: !ParseError !a -> a
traceParseError e x
| trace_tn e = x
| otherwise = undef
......@@ -17,7 +17,7 @@ from syntax import :: ParsedDefinition
= ICExpression
| ICPattern
class idents t :: IdentContext t -> Idents
class idents t :: !IdentContext !t -> Idents
instance idents [t] | idents t
instance idents ParsedDefinition
......@@ -14,9 +14,9 @@ instance zero (TypeTree v)
derive JSONEncode TypeTree
derive JSONDecode TypeTree
typeTreeNodes :: (TypeTree v) -> Int
typeTreeSize :: (TypeTree v) -> Int
typeTreeDepth :: (TypeTree v) -> Int
typeTreeNodes :: !(TypeTree v) -> Int
typeTreeSize :: !(TypeTree v) -> Int
typeTreeDepth :: !(TypeTree v) -> Int
addType :: !Type !v !(TypeTree v) -> TypeTree v
findUnifying :: !Type !(TypeTree v) -> [(Type,Unifier,[v])]
typeTreeToGraphviz :: (TypeTree v) -> Digraph
typeTreeToGraphviz :: !(TypeTree v) -> Digraph
......@@ -32,13 +32,13 @@ instance < Type where < t u = (t =?= u) =: LT
derive JSONEncode TypeTree, Type, TypeRestriction, Location
derive JSONDecode TypeTree, Type, TypeRestriction, Location
typeTreeNodes :: (TypeTree v) -> Int
typeTreeNodes :: !(TypeTree v) -> Int
typeTreeNodes (Node _ _ cs) = 1 + sum (map typeTreeNodes cs)
typeTreeSize :: (TypeTree v) -> Int
typeTreeSize :: !(TypeTree v) -> Int
typeTreeSize (Node _ vs cs) = length vs + sum (map typeTreeSize cs)
typeTreeDepth :: (TypeTree v) -> Int
typeTreeDepth :: !(TypeTree v) -> Int
typeTreeDepth (Node _ _ cs) = maxList [0:map ((+) 1 o typeTreeDepth) cs]
addType :: !Type !v !(TypeTree v) -> TypeTree v
......@@ -66,7 +66,7 @@ allTypes (Node t vs cs) = [(t,vs,cs):concatMap allTypes cs]
allValues :: (TypeTree v) -> [v]
allValues (Node _ ls cs) = ls ++ concatMap allValues cs
typeTreeToGraphviz :: (TypeTree v) -> Digraph
typeTreeToGraphviz :: !(TypeTree v) -> Digraph
typeTreeToGraphviz tree = Digraph
"Type tree"
[GAttRankDir RDLR]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment