Add SyntaxResults

CloogleDB.dcl

@@ -29,6 +29,7 @@ from TypeTree import :: TypeTree
 	, core         :: ![Index]
 	, apps         :: ![Index]
 	, builtins     :: ![Index]
+	, syntax       :: ![Index]
 	, library_map  :: !Map Name [Index]
 	, module_map   :: !Map Name [Index]
 	}
@@ -140,6 +141,7 @@ derive JSONDecode CloogleEntry
  */
 :: SyntaxEntry =
 	{ syntax_title         :: String //* The name of the construct
+	, syntax_patterns      :: [String] //* Patterns to search for the construct
 	, syntax_code          :: [String] //* Strings describing the construct, as short as possible
 	, syntax_description   :: String //* A description for documentation
 	, syntax_doc_locations :: [CleanLangReportLocation] //* Where to find documentation on the construct

CloogleDB.icl

@@ -37,7 +37,7 @@ import Type
 
 import Cloogle
 
-from DB import :: DB, :: Index, :: Entry{..}, :: IndexSearchMode(..),
+from DB import :: DB, :: Index, :: Entry{..}, :: SearchMode(..),
 	instance == Index, instance < Index
 import qualified DB
 import Doc
@@ -225,13 +225,14 @@ syncDB :: !Int !*CloogleDB -> *CloogleDB
 syncDB _ db = db
 
 saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
-saveDB wrapper=:{db,name_ngrams,types,core,apps,builtins,library_map,module_map} f
+saveDB wrapper=:{db,name_ngrams,types,core,apps,builtins,syntax,library_map,module_map} f
 # (db,f) = 'DB'.saveDB db f
 # f = write name_ngrams f
 # f = write types f
 # f = write core f
 # f = write apps f
 # f = write builtins f
+# f = write syntax f
 # f = write library_map f
 # f = write module_map f
 = ({wrapper & db=db}, f)
@@ -253,6 +254,8 @@ openDB f
 | not ok = (Nothing, f)
 # ((ok,builtins),f) = appFst isJustU $ read f
 | not ok = (Nothing, f)
+# ((ok,syntax),f) = appFst isJustU $ read f
+| not ok = (Nothing, f)
 # ((ok,library_map),f) = appFst isJustU $ read f
 | not ok = (Nothing, f)
 # ((ok,module_map),f) = appFst isJustU $ read f
@@ -264,6 +267,7 @@ openDB f
 	, core=fromJust core
 	, apps=fromJust apps
 	, builtins=fromJust builtins
+	, syntax=fromJust syntax
 	, library_map=fromJust library_map
 	, module_map=fromJust module_map
 	}, f)
@@ -286,7 +290,7 @@ getIndices idxs wrap=:{db}
 = (es, {wrap & db=db})
 
 filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
-filterDB f db = {db & db = 'DB'.search (\v -> (f v, [])) db.db}
+filterDB f db = {db & db = 'DB'.search Intersect (\v -> (f v, [])) db.db}
 
 excludeCore :: !*CloogleDB -> *CloogleDB
 excludeCore wrap=:{db,core}
@@ -323,12 +327,34 @@ where
 	idxs = foldr merge [] $ catMaybes $ map (flip get module_map) ss
 
 filterName :: !String !*CloogleDB -> *CloogleDB
-filterName s wrap=:{db,name_ngrams}
+filterName s wrap=:{db,name_ngrams,syntax}
 # db = 'DB'.searchIndices Intersect indices db
+# db = 'DB'.searchWithIndices syntaxSearch syntax db
 = {wrap & db=db}
 where
 	indices = [(i,[(MatchingNGrams,IntAnnot n)]) \\ (i,n) <- 'NGrams'.search s name_ngrams]
 
+	syntaxSearch :: CloogleEntry -> (Bool, [a])
+	syntaxSearch (SyntaxEntry se) = (any (flip patternMatches s) se.syntax_patterns, [])
+	syntaxSearch _ = (False, [])
+
+	patternMatches :: SyntaxPattern String -> Bool
+	patternMatches p s = m [c \\ c <-: p] [c \\ c <-: s]
+	where
+		// %:  any character
+		// *:  any number of characters (inefficient!)
+		// \w: a word character (a-zA-Z_`)
+		// \e: a word or digit character (a-zA-Z0-9_`)
+		// other characters are matched literally
+		m :: [Char] [Char] -> Bool
+		m []           []    = True
+		m ['%':p]      [_:s] = m p s
+		m ['*':p]      s     = any (m p) (tails s)
+		m ['\\':'w':p] [x:s] = (isAlpha x || x == '_' || x == '`') && m p s
+		m ['\\':'e':p] [x:s] = (isAlpha x || isDigit x || x == '_' || x == '`') && m p s
+		m [c:p]        [x:s] = c == x && m p s
+		m _            _     = False
+
 filterUnifying :: !Type !*CloogleDB -> *CloogleDB
 filterUnifying t wrap=:{db,types}
 # db = 'DB'.searchIndices Intersect idxs db

CloogleDBFactory.icl

@@ -69,7 +69,8 @@ from NGramIndex import :: NGramIndex, newNGramIndex, index
 from TypeTree import :: TypeTree, instance zero (TypeTree v), addType
 from CloogleDB import
 	:: CloogleDB{..}, :: Annotation, :: AnnotationKey,
-	:: Location(Location,NoLocation),
+	:: Location(Location,Builtin,NoLocation),
+	:: CleanLangReportLocation,
 	:: CloogleEntry(..),
 	:: ModuleEntry{me_loc,me_is_core,me_is_app,me_documentation},
 	:: FunctionEntry{fe_loc,fe_type,fe_kind,fe_generic_vars,fe_priority,fe_representation,fe_documentation,fe_class},
@@ -114,8 +115,8 @@ newTemporaryDb
 finaliseDb :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB
 finaliseDb extra tdb
 # db = newDB entries
-# (names,db) = collectNames db
-# name_ngrams = foldr (uncurry index) (newNGramIndex 3 True) names
+# name_ngrams = foldr (uncurry index) (newNGramIndex 3 True)
+	[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
 =
 	{ db = db
 	, name_ngrams = name_ngrams
@@ -124,15 +125,12 @@ finaliseDb extra tdb
 			\\ (i,FunctionEntry fe) <- entridxs, Just t <- [fe.fe_type <|> (docType =<< fe.fe_documentation)]]
 	, core = coreidxs
 	, apps = appidxs
-	, builtins = []
+	, builtins = builtinidxs
+	, syntax = idxfilter \e -> e=:(SyntaxEntry _)
 	, library_map = libmap
 	, module_map = modmap
 	}
 where
-	collectNames = 'DB'.scan (\i v ivs -> case 'CDB'.getLocation v of
-		Nothing  -> ivs
-		Just loc -> [('CDB'.getName loc, i):ivs]) []
-
 	entries =
 		extra ++
 		[FunctionEntry fun \\ funs <- tdb.temp_functions, fun <- funs] ++
@@ -176,6 +174,9 @@ where
 			_                -> False
 	where
 		appmods = [(fromJust $ 'CDB'.getLibrary me.me_loc, fromJust $ 'CDB'.getModule me.me_loc) \\ me <- tdb.temp_modules | me.me_is_app]
+	builtinidxs = idxfilter \e -> case 'CDB'.getLocation e of
+		Just (Builtin _ _) -> True
+		_                  -> False
 
 	libmap = 'M'.fromList
 		[(l,idxfilter \e -> case 'CDB'.getLocation e >>= 'CDB'.getLibrary of

DB.dcl

@@ -33,6 +33,13 @@ derive JSONDecode Index
 instance == Index
 instance < Index
 
+/**
+ * Two search modes are available.
+ */
+:: SearchMode
+	= Intersect   //* Only consider included entries (i.e., an AND with previous searches)
+	| AddExcluded //* Re-include matching entries but don't remove non-matching entries (i.e., an OR with previous searches)
+
 /**
  * Create a new database from a list of entries.
  */
@@ -68,26 +75,24 @@ mapInPlace :: (v -> v) *(DB v ak a) -> *(DB v ak a)
  * should be included and which annotations should be added (if any). Excluded
  * entries are ignored.
  */
-search :: (v -> (Bool, [(ak, a)])) *(DB v ak a) -> *DB v ak a | ==, < ak
-
-/**
- * When searching on specific indices, two modes are available.
- * `Intersect` behaves like {{`search`}}.
- */
-:: IndexSearchMode
-	= Intersect   //* Only consider included entries
-	| AddExcluded //* Re-include matching entries; don't remove non-matching entries
+search :: !SearchMode (v -> (Bool, [(ak, a)])) *(DB v ak a) -> *DB v ak a | ==, < ak
 
 /**
  * Like {{`search`}}, but search for specific indices.
  */
-searchIndices :: !IndexSearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
+searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
 
 /**
  * Exclude a list of indices.
  */
 unsearchIndices :: ![Index] !*(DB v ak a) -> *DB v ak a
 
+/**
+ * Like {{`searchIndices`}}, but also check on some property.
+ * This search always uses the {{`AddExcluded`}} {{`SearchMode`}}.
+ */
+searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(DB v ak a) -> *DB v ak a | ==, < ak
+
 /**
  * Get an entry and its annotations.
  * Also see {{`getIndices`}}.

DB.icl

@@ -96,24 +96,38 @@ where
 	# (e,es) = es![i]
 	= upd (i-1) {es & [i]={e & value=f e.value}}
 
-search :: (v -> (Bool, [(ak, a)])) *(DB v ak a) -> *DB v ak a | ==, < ak
-search f (DB db)
+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)
 where
-	//upd :: !Int !*{!Entry v ak a} -> *{!Entry v ak a} | ==, < ak
-	upd -1 es = es
-	upd i  es
+	//upd :: (!Int !*{!Entry v ak a} -> *{!Entry v ak a}) | ==, < ak
+	upd = case mode of
+		Intersect   -> intersect
+		AddExcluded -> addExcluded
+
+	intersect -1 es = es
+	intersect i  es
 	# (e,es) = es![i]
-	| not e.included = upd (i-1) es
+	| not e.included = intersect (i-1) es
 	# (include,annotations) = f e.value
-	= upd (i-1) {es & [i]=
+	= intersect (i-1) {es & [i]=
 		{ e
 		& included=include
 		, annotations=foldr (uncurry put) e.annotations annotations
 		}}
 
-searchIndices :: !IndexSearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
+	addExcluded -1 es = es
+	addExcluded i  es
+	# (e,es) = es![i]
+	# (include,annotations) = f e.value
+	= addExcluded (i-1) {es & [i]=
+		{ e
+		& included=e.included || include
+		, annotations=foldr (uncurry put) e.annotations annotations
+		}}
+
+searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(DB v ak a) -> *DB v ak a | ==, < ak
 searchIndices mode idxs (DB db)
 # (s,db) = usize db
 # db = upd 0 (s-1) idxs db
@@ -123,8 +137,9 @@ where
 	upd i s _  es
 		| i > s = es
 	upd i s [] es
+		| mode=:AddExcluded = es
 		# (e,es) = es![i]
-		= upd (i+1) s [] {es & [i]={e & included=mode=:AddExcluded}}
+		= upd (i+1) s [] {es & [i]={e & included=False}}
 	upd i s allidxs=:[match=:(Index idx,annots):idxs] es
 		# (e,es) = es![i]
 		# e & included = case mode of
@@ -146,6 +161,19 @@ where
 	# (e,es) = es![i]
 	= upd is {es & [i].included=False}
 
+searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(DB v ak a) -> *DB v ak a | ==, < ak
+searchWithIndices prop idxs (DB db)
+# db = upd idxs db
+= (DB db)
+where
+	upd [] es = es
+	upd [Index i:is] es
+	# (e,es) = es![i]
+	# e = case prop e.value of
+		(False, _)     -> {e & included=False}
+		(True, annots) -> {e & included=True, annotations=foldr (uncurry put) e.annotations annots}
+	= upd is {es & [i]=e}
+
 getIndex :: !Index !*(DB v ak a) -> *(!Entry v ak a, !*(DB v ak a))
 getIndex (Index n) (DB db)
 # (e,db) = db![n]

Search.icl

@@ -150,6 +150,17 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
 				\\ {value=InstanceEntry ie} <- ies]
 		, class_derivations = [] // TODO
 		}), db)
+| entry =: (SyntaxEntry _)
+	# (SyntaxEntry se) = entry
+	= (SyntaxResult (
+		{ general
+		& distance = 0
+		},
+		{ SyntaxResultExtras
+		| syntax_title    = se.SyntaxEntry.syntax_title
+		, syntax_code     = se.SyntaxEntry.syntax_code
+		, syntax_examples = se.SyntaxEntry.syntax_examples
+		}), db)
 	// TODO
 where
 	mbLoc = getLocation entry