parse.patch 7.42 KB
Newer Older
1 2
--- /frontend/parse.icl
+++ /frontend/parse.icl
Camil Staps's avatar
Camil Staps committed
3 4 5 6 7 8 9 10
@@ -294,7 +294,6 @@
 										, ps_flags = if support_generics PS_SupportGenericsMask 0
 										, ps_hash_table = hash_table
 										}
-			  pState				= verify_name mod_name id_name file_name pState
 		  	  (mod_ident, pState)	= stringToIdent mod_name (IC_Module NoQualifiedIdents) pState
 		  	  pState				= check_layout_rule pState
 		  	  (defs, pState)		= want_definitions (SetGlobalContext iclmodule) pState
11
@@ -309,12 +308,12 @@
12 13 14 15 16 17 18 19
 		// otherwise // ~ succ
 		# ({fp_line}, scanState) = getPosition scanState
 		  mod = { mod_ident = file_id,  mod_modification_time = modification_time, mod_type = mod_type, mod_imports = [], mod_imported_objects = [],mod_foreign_exports=[],mod_defs = [] }
-		= (False, False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header",
+		= (False, False, mod, hash_table, error <<< "Error [" <<< file_name <<< ',' <<< fp_line <<< "]: incorrect module header\n",
 			closeScanner scanState files)
 
 	try_module_header :: !Bool !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
 	try_module_header is_icl_mod scanState
-		# (token, scanState) = nextToken GeneralContext scanState
+		# (token, scanState) = skipDocTokens GeneralContext scanState
 		| is_icl_mod
 			| token == ModuleToken
 				# (token, scanState) = nextToken ModuleNameContext scanState
@@ -329,6 +328,12 @@
 		| token == SysModuleToken
 		  	= try_module_token MK_System scanState
 			= (False, MK_None, "", tokenBack scanState)
+	where
+		skipDocTokens context state
+		# (token,state) = nextToken context state
+		| token=:(DocBlockToken _) || token=:(DocLineToken _)
+			= skipDocTokens context state
+			= (token,state)
 
 	try_module_token :: !ModuleKind !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
 	try_module_token mod_type scanState
@@ -387,8 +392,33 @@
40 41 42 43 44 45 46
 
 wantDefinitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
 wantDefinitions parseContext pState
-	= parseList (tryDefinition parseContext) pState
+	= mergeDocumentation (parseList (tryDefinition parseContext) pState)
+where
+	mergeDocumentation :: ([ParsedDefinition], ParseState) -> ([ParsedDefinition], ParseState)
47
+	mergeDocumentation ([PD_Documentation DocBlock doc:f=:PD_Function pos id is_infix args rhs kind:rest], pState)
48
+		= mergeDocumentation ([f:rest], saveDocu id doc pState)
49
+	mergeDocumentation ([PD_Documentation DocBlock doc:f=:PD_TypeSpec pos id prio type specials:rest], pState)
50
+		= mergeDocumentation ([f:rest], saveDocu id doc pState)
51
+	mergeDocumentation ([PD_Documentation DocBlock doc:c=:PD_Class cd pds:rest], pState)
52
+		= mergeDocumentation ([c:rest], saveDocu cd.class_ident doc pState)
53
+	mergeDocumentation ([PD_Documentation DocBlock doc:c=:PD_Type ptd:rest], pState)
54 55 56 57 58 59 60 61 62 63
+		= mergeDocumentation ([c:rest], saveDocu ptd.td_ident doc pState)
+	mergeDocumentation ([PD_Class c pds:rest], pState)
+		# (pds,pState)  = mergeDocumentation (pds, pState)
+		# (rest,pState) = mergeDocumentation (rest, pState)
+		= ([PD_Class c pds:rest], pState)
+	mergeDocumentation ([pd:rest], pState)
+		# (rest,pState) = mergeDocumentation (rest, pState)
+		= ([pd:rest], pState)
+	mergeDocumentation ([], pState)
+		= ([], pState)
64
 
65 66 67 68 69
+	saveDocu :: Ident String ParseState -> ParseState
+	saveDocu {id_info} doc pState=:{ps_hash_table}
+		# (entry,heap) = readPtr id_info ps_hash_table.hte_symbol_heap
+		# ps_hash_table = {ps_hash_table & hte_symbol_heap=writePtr id_info {entry & ste_doc=Yes doc} heap}
+		= {pState & ps_hash_table=ps_hash_table}
70
+
71 72
 cHasPriority 	:== True
 cHasNoPriority	:== False
73 74
 
@@ -396,9 +426,17 @@
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
 tryDefinition parseContext pState
 	# (token, pState)			= nextToken GeneralContext pState
 	  (fname, linenr, pState)	= getFileAndLineNr pState
-	= try_definition parseContext token (LinePos fname linenr) pState
+	| token == NewDefinitionToken && parseContext == ClassDefsContext
+		= tryDefinition parseContext pState // Ugly hack to allow docblocks for class members
+		= try_definition parseContext token (LinePos fname linenr) pState
 where
 	try_definition :: !ParseContext !Token !Position !ParseState -> (!Bool, ParsedDefinition, !ParseState)
+	try_definition parseContext (DocBlockToken doc) pos pState
+		| isGlobalOrClassDefsContext parseContext
+			= (True,PD_Documentation DocBlock doc,wantEndOfDefinition "docblock" pState)
+			= (True,PD_Documentation DocBlock doc,parseWarning "definition" "docblocks only at the global level" pState)
+	try_definition parseContext (DocLineToken doc) pos pState
+		= (True,PD_Documentation DocLine doc,wantEndOfDefinition "docline" pState)
 	try_definition parseContext DoubleColonToken pos pState
 		| ~(isGlobalContext parseContext)
 			= (False,abort "no def(3)",parseError "definition" No "type definitions only at the global level" (tokenBack pState))
93
@@ -2394,8 +2432,10 @@
94 95 96 97 98 99 100 101 102 103 104
 								_
 									-> parseErrorSimple pc_cons_ident.id_name "arity of an infix constructor should be 2" pState
 		  (pc_context,pState) = optional_constructor_context pState
+		  (doc,pState) = tryDocLine pState
 		  cons = {	pc_cons_ident = pc_cons_ident, pc_arg_types = atypes_from_satypes pc_arg_types, pc_args_strictness=strictness_from_satypes pc_arg_types,
-					pc_context = pc_context, pc_cons_arity = length pc_arg_types, pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos}
+					pc_context = pc_context, pc_cons_arity = length pc_arg_types, pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos,
+					pc_doc = doc}
 		= (cons,pState)
 
 	want_newtype_constructor :: ![ATypeVar] !Token !ParseState -> (.ParsedConstructor,!ParseState)
105
@@ -2404,7 +2444,7 @@
106 107 108 109 110 111 112 113
 		  (pc_cons_ident,  pc_cons_prio, pc_cons_pos, pState) = want_cons_name_and_prio token pState
 		  (succ, pc_arg_type, pState) = trySimpleType TA_Anonymous pState
 		  cons = {	pc_cons_ident = pc_cons_ident, pc_arg_types = [pc_arg_type], pc_args_strictness = NotStrict,
-		  			pc_context = [], pc_cons_arity = 1, pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos}
+		  			pc_context = [], pc_cons_arity = 1, pc_cons_prio = pc_cons_prio, pc_exi_vars = exi_vars, pc_cons_pos = pc_cons_pos, pc_doc = No}
 		| succ
 			= (cons,pState)
 			= (cons,parseError "newtype definition" No "type" pState)
114
@@ -2552,9 +2592,11 @@
115 116 117 118 119 120 121 122 123 124 125 126
 			  pState          				= wantToken TypeContext "record field" DoubleColonToken pState
 //			  (ps_field_type, pState)  		= want pState // wantAType
 			  (annotation,ps_field_type, pState) = wantAnnotatedAType pState
+			  (doc, pState)					= tryDocLine pState
 			= ({ ps_field_ident = ps_field_ident, ps_selector_ident = ps_selector_ident, ps_field_type = ps_field_type,
 					ps_field_annotation = annotation,
-					ps_field_var = ps_field_var, ps_field_pos = LinePos fname linenr}, pState)
+					ps_field_var = ps_field_var, ps_field_pos = LinePos fname linenr,
+					ps_doc = doc}, pState)
 
 :: SAType = {s_annotation::!Annotation,s_type::!AType}
 
127
@@ -5317,6 +5359,16 @@
128 129 130 131 132 133 134 135 136 137 138 139 140 141
 isDefinesFieldToken CommaToken      = True
 isDefinesFieldToken token           = False
 
+tryDocBlock :: !ParseState -> (!OptionalDoc, !ParseState)
+tryDocBlock pState = case nextToken GeneralContext pState of
+	(DocBlockToken doc,pState)	-> (Yes doc,pState)
+	(_,pState)					-> (No,tokenBack pState)
+
+tryDocLine :: !ParseState -> (!OptionalDoc, !ParseState)
+tryDocLine pState = case nextToken GeneralContext pState of
+	(DocLineToken doc,pState)	-> (Yes doc,pState)
+	(_,pState)					-> (No,tokenBack pState)
+
   //---------------//
142
  //--- Tracing ---//
143
 //---------------//