WIP on comments

src/libraries/OS-Independent/Clean/Parse/Comments.icl

@@ -270,12 +270,14 @@ collectComments comments pm
 # (_,_,coll) = collect comments Nothing pm.mod_defs coll
 = coll
 
+import Debug.Trace
 collect :: ![CleanComment] !(Maybe CleanComment) ![a] !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments) | pos, singleLineAbove, commentIndex, children a
 collect cc prev [] coll = (cc, prev, coll)
 collect [] (Just prev) [pd:pds] coll = ([], Nothing, putCC pd prev coll)
 collect [] Nothing _ coll = ([], Nothing, coll)
 collect [{content}:cs] prev pds coll | not (startsWith "*" content) = collect cs prev pds coll
-collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll = case c canBelongTo pd of
+collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll =
+	let (_,_,b) = trace_stdout (c.line,commentIndex pd,c canBelongTo pd) in case b of
 	Nothing -> collect allcmnts prev pds coll
 	Just True -> case prev of
 		Just prev | not (singleLineAbove pd) && not c.multiline
@@ -288,8 +290,12 @@ collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll = case c canBelongTo pd of
 		# coll = case prev of
 			Nothing -> coll
 			Just cmnt -> putCC pd cmnt coll
-		# (allcmnts,prev,coll) = recurse allcmnts Nothing (children pd) coll
-		-> collect allcmnts prev pds coll
+		-> case trace_stdout (pd before c) of
+			Just False
+				# (allcmnts,prev,coll) = recurse allcmnts Nothing (children pd) coll
+				-> collect allcmnts prev pds coll
+			_
+				-> collect allcmnts prev pds coll
 where
 	// Compiler cannot figure out the overloading if we call collect from collect directly
 	recurse :: ![CleanComment] !(Maybe CleanComment) !Children !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments)
@@ -331,6 +337,21 @@ where
 			= a==b || a+1==b
 			= a==b
 
+(before) elem {line,column,multiline} = case trace_stdout elem_line of
+	Nothing
+		-> Nothing
+	Just elem_line
+		| multiline
+			-> Just (line <= elem_line)
+		| singleLineAbove elem
+			-> Just (line <= elem_line)
+			-> Just (line <  elem_line)
+where
+	elem_line = case pos elem of
+		Just (FunPos _ ln _) -> Just ln
+		Just (LinePos _ ln) -> Just ln
+		_ -> Nothing
+
 // If true, single-line documentation should be given above the element.
 class singleLineAbove a :: !a -> Bool
 instance singleLineAbove ParsedDefinition  where singleLineAbove _ = True

tests/linux64/commentstest.dcl

@@ -8,6 +8,8 @@ definition module commentstest
 import syntax
 import Clean.Parse.Comments
 
+:: NT =: NT Int //* Should be ignored (see clean-test-properties#11)
+
 //* A documentation entry
 :: Entry =
 	{ kind  :: !String //* the kind of thing that is documented

tests/linux64/commentstest.icl

@@ -32,6 +32,7 @@ Start w
 expected :: [Entry]
 expected =
 	[ {kind="module",   name="commentstest",   value=Just "*\n * This module is used to test the Clean documentation parser in Clean.Parse.Comments.\n * The documentation here is written obscurely on purpose!\n "}
+	, {kind="type",     name="NT",             value=Nothing}
 	, {kind="type",     name="Entry",          value=Just "* A documentation entry\n"}
 	, {kind="selector",    name="kind",        value=Just "* the kind of thing that is documented\n"}
 	, {kind="selector",    name="name",        value=Just "* the name of the documented thing\n"}