Verified Commit d49fc61e authored by Camil Staps's avatar Camil Staps 🚀

Separate documentation scanning from the compiler

parent 011c4de3
definition module Clean.Parse
/**
* A small wrapper around the parser of the Clean compiler.
* You will need to have the source of the Clean compiler available in your path.
*/
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from hashtable import :: HashTable
from Heap import :: Heap
from syntax import :: Module, :: ParsedDefinition, :: ParsedModule
/**
* Parse a Clean module.
*
* @param The path to the file to parse
* @result
* The parsed module and the corresponding hash table.
* When the result is an {{`Error`}}, there is a descriptive error message.
*/
readModule :: !FilePath !*World -> *(!MaybeError String (ParsedModule, HashTable), !*World)
implementation module Clean.Parse
// NOTE: be VERY restrictive with adding imports here, because this may break
// the module when the compiler changes.
import StdFile
import Data.Error
import Data.Maybe
import System.File
import System.FilePath
from Text import class Text(endsWith), instance Text String
from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable,
:: IdentClass(IC_Module), :: QualifiedIdents(NoQualifiedIdents),
putIdentInHashTable, set_hte_mark, newHashTable
from parse import wantModule
import syntax
readModule :: !FilePath !*World -> *(!MaybeError String (ParsedModule, HashTable), !*World)
readModule filename w
# (s,w) = readFile filename w
| isError s = (Error (toString (fromError s)), w)
# modname = getModuleName (fromString (fromOk s))
# modname = fromMaybe (takeFileName (dropExtension filename)) modname
# ht = newHashTable newHeap
# ht = set_hte_mark (if icl 1 0) ht
# (ok,f,w) = fopen filename FReadText w
| not ok = (Error ("Couldn't open " +++ filename), w)
# (mod_id, ht) = putIdentInHashTable modname (IC_Module NoQualifiedIdents) ht
# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True ht stderr) w
# (ok,w) = fclose f w
| not ok = (Error ("Couldn't close " +++ filename), w)
= (Ok (pm, ht), w)
where
icl = endsWith "icl" filename
wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)
wantModule` f s b1 i p b2 ht io fs
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)
// A reasonably accurate simple scanner to get the module name from the file
getModuleName :: ![Char] -> Maybe String
getModuleName ['definition':c:cs] | isSpace c = justModule cs
getModuleName ['implementation':c:cs] | isSpace c = justModule cs
getModuleName ['system':c:cs] | isSpace c = justModule cs
getModuleName [c:cs] | isSpace c = getModuleName cs
getModuleName ['//':cs] = getModuleName (dropWhile ((<>) '\n') cs)
getModuleName ['/*':cs] = getModuleName (skipMultiLineComment cs)
getModuleName cs = justModule cs
justModule :: ![Char] -> Maybe String
justModule ['module':c:cs] | isSpace c = justModuleName cs
justModule [c:cs] | isSpace c = justModule cs
justModule ['//':cs] = justModule (dropWhile ((<>) '\n') cs)
justModule ['/*':cs] = justModule (skipMultiLineComment cs)
justModule _ = Nothing
justModuleName :: ![Char] -> Maybe String
justModuleName cs
# (_,cs) = span isSpace cs
# (name,_) = span (\c -> c <> '/' && c <> ';' && not (isSpace c)) cs
= case name of
[] -> Nothing
_ -> Just (toString name)
skipMultiLineComment :: ![Char] -> [Char]
skipMultiLineComment ['*/':cs] = cs
skipMultiLineComment ['/*':cs] = skipMultiLineComment (skipMultiLineComment cs)
skipMultiLineComment [c:cs] = skipMultiLineComment cs
skipMultiLineComment [] = []
definition module Clean.Parse.Comments
/**
* This module can combine the AST of the Clean compiler (which can be parsed
* using {{`Clean.Parse`}} with comments scanned by {{`Clean.ScanComments`}}.
*/
from StdFile import class FileSystem
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.File import :: FileError
from System.FilePath import :: FilePath
from syntax import :: Ident, :: Module, :: ParsedDefinition, :: ParsedModule
:: CleanComment =
{ line :: !Int
, column :: !Int
, level :: !Maybe Int
, content :: !String
, multiline :: !Bool
}
scanComments :: !FilePath !*env -> *(!MaybeError FileError [CleanComment], !*env) | FileSystem env
scanCommentsFile :: !*File -> *(!MaybeError FileError [CleanComment], !*File)
:: CollectedComments
emptyCollectedComments :: CollectedComments
getComment :: !Ident !CollectedComments -> Maybe String
collectComments :: ![CleanComment] !ParsedModule -> CollectedComments
This diff is collapsed.
This diff is collapsed.
clean-compiler:
svn checkout -r 2838 https://svn.cs.ru.nl/repos/clean-compiler/branches/itask/ clean-compiler
cd clean-compiler; for f in ../compiler-patch/*.patch; do patch -p1 < "$$f"; done
svn checkout -r 3022 https://svn.cs.ru.nl/repos/clean-compiler/branches/itask/ clean-compiler
$(MAKE) -j -C clean-compiler/main/Unix
$(MAKE) -j -C clean-compiler/backendC/CleanCompilerSources -f Makefile.linux64
ln -s ../../backendC/CleanCompilerSources/backend.a clean-compiler/backend/Clean\ System\ Files/backend_library
--- /frontend/check.icl
+++ /frontend/check.icl
@@ -3627,7 +3627,7 @@
= NoIndex
NewEntry symbol_table symb_ptr def_kind def_index level previous :==
- symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+ symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous, ste_doc = No })
instance <<< AuxiliaryPattern
where
--- /frontend/checkFunctionBodies.icl
+++ /frontend/checkFunctionBodies.icl
@@ -1939,7 +1939,7 @@
checkPatternVariable :: !Level !SymbolTableEntry !Ident !VarInfoPtr !*CheckState -> *CheckState
checkPatternVariable def_level entry=:{ste_def_level,ste_kind} ident=:{id_info} var_info cs=:{cs_symbol_table,cs_error}
| ste_kind == STE_Empty || def_level > ste_def_level
- # entry = {ste_kind = STE_Variable var_info, ste_index = NoIndex, ste_def_level = def_level, ste_previous = entry }
+ # entry = {ste_kind = STE_Variable var_info, ste_index = NoIndex, ste_def_level = def_level, ste_previous = entry, ste_doc = No }
= { cs & cs_symbol_table = cs_symbol_table <:= (id_info,entry)}
= { cs & cs_error = checkError ident "(pattern variable) already defined" cs_error }
--- /frontend/checkgenerics.icl
+++ /frontend/checkgenerics.icl
@@ -503,7 +503,7 @@
= (fun,var_heap)
NewEntry symbol_table symb_ptr def_kind def_index level previous :==
- symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+ symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous, ste_doc = No })
getTypeDef :: !Index !(Global Index) !v:{#CheckedTypeDef} !w:{#DclModule}
-> (!CheckedTypeDef, !v:{#CheckedTypeDef}, !w:{#DclModule})
--- /frontend/checksupport.icl
+++ /frontend/checksupport.icl
@@ -216,13 +216,13 @@
= addLocalDclMacroDefsToSymbolTable level module_index (inc from_index) to_index macro_defs symbol_table error
NewEntry symbol_table symb_ptr def_kind def_index level previous :==
- symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+ symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous, ste_doc = No })
addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin)
addDefToSymbolTable level def_index def_ident=:{id_info} def_kind symbol_table error
# (entry, symbol_table) = readPtr id_info symbol_table
| entry.ste_kind == STE_Empty || entry.ste_def_level <> level
- # entry = {ste_index = def_index, ste_kind = def_kind, ste_def_level = level, ste_previous = entry }
+ # entry = {ste_index = def_index, ste_kind = def_kind, ste_def_level = level, ste_previous = entry, ste_doc = No }
= (symbol_table <:= (id_info,entry), error)
= (symbol_table, checkError def_ident "already defined" error)
@@ -322,9 +322,9 @@
STE_Hidden _ _
-> (False, dcl_modules, cs) // symbol is hidden
STE_Empty
- # previous_entry = {ste_kind=ste_kind2, ste_index=ste_index, ste_def_level=ste_def_level, ste_previous=ste_previous}
+ # previous_entry = {ste_kind=ste_kind2, ste_index=ste_index, ste_def_level=ste_def_level, ste_previous=ste_previous, ste_doc=No}
# decl_kind = add_hidden_declarations first_hidden_ste_kind decl_kind
- # entry = {ste_kind=decl_kind, ste_index=def_index, ste_def_level=cModuleScope, ste_previous=previous_entry}
+ # entry = {ste_kind=decl_kind, ste_index=def_index, ste_def_level=cModuleScope, ste_previous=previous_entry, ste_doc=No}
cs = {cs & cs_symbol_table = writePtr ident.id_info entry cs.cs_symbol_table}
-> case def_kind of
STE_Field selector_id
--- /frontend/checktypes.icl
+++ /frontend/checktypes.icl
@@ -743,7 +743,7 @@
| ste_kind == STE_Empty || ste_def_level == cModuleScope
#! (new_attr_ptr, th_attrs) = newPtr AVI_Empty oti_heaps.th_attrs
# symbol_table = symbol_table <:= (id_info,{ ste_index = NoIndex, ste_kind = STE_TypeAttribute new_attr_ptr,
- ste_def_level = cGlobalScope, ste_previous = entry })
+ ste_def_level = cGlobalScope, ste_previous = entry, ste_doc = No })
new_attr = { attr_var & av_info_ptr = new_attr_ptr}
= (new_attr, { oti & oti_heaps = { oti_heaps & th_attrs = th_attrs }, oti_all_attrs = [new_attr : oti_all_attrs] }, symbol_table)
# (STE_TypeAttribute attr_ptr) = ste_kind
@@ -822,7 +822,7 @@
# (new_attr, oti=:{oti_heaps,oti_all_vars}, cs) = newAttribute dem_attr id_name tv_attr oti {cs & cs_symbol_table = cs_symbol_table}
(new_var_ptr, th_vars) = newPtr (TVI_AttrAndRefCount new_attr 1) oti_heaps.th_vars
new_var = { tv & tv_info_ptr = new_var_ptr }
- entry = {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = entry}
+ entry = {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = entry, ste_doc = No}
cs & cs_symbol_table = writePtr id_info entry cs.cs_symbol_table
= (new_var, new_attr, ({ oti & oti_heaps = { oti_heaps & th_vars = th_vars }, oti_all_vars = [new_var : oti_all_vars]}, cs))
= case ste_kind of
@@ -1058,7 +1058,7 @@
# (new_attr, oti=:{oti_heaps}, cs) = newAttribute DAK_None id_name atv_attribute oti {cs & cs_symbol_table = cs_symbol_table}
(new_var_ptr, th_vars) = newPtr (TVI_AttrAndRefCount new_attr 1) oti_heaps.th_vars
cs = {cs & cs_symbol_table = cs.cs_symbol_table <:= (id_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr,
- ste_def_level = cRankTwoScope, ste_previous = entry})}
+ ste_def_level = cRankTwoScope, ste_previous = entry, ste_doc = No})}
= ({atv & atv_variable = {tv & tv_info_ptr = new_var_ptr}, atv_attribute = new_attr},
({oti & oti_heaps = {oti_heaps & th_vars = th_vars}}, cs))
= (atv, (oti, {cs & cs_error = checkError id_name "type variable already defined" cs_error, cs_symbol_table = cs_symbol_table}))
@@ -1070,7 +1070,7 @@
# (entry=:{ste_kind,ste_def_level},cs_symbol_table) = readPtr id_info cs_symbol_table
| ste_kind == STE_Empty || ste_def_level == cModuleScope
# cs_symbol_table = cs_symbol_table <:= (id_info,
- {ste_index = NoIndex, ste_kind = STE_TypeAttribute av_info_ptr, ste_def_level = cGlobalScope, ste_previous = entry})
+ {ste_index = NoIndex, ste_kind = STE_TypeAttribute av_info_ptr, ste_def_level = cGlobalScope, ste_previous = entry, ste_doc = No})
= add_universal_var_again atv_variable {cs & cs_symbol_table=cs_symbol_table}
= add_universal_var_again atv_variable {cs & cs_symbol_table=cs_symbol_table}
add_universal_var_and_attribute_again {atv_variable} cs
@@ -1080,7 +1080,7 @@
# (entry=:{ste_kind,ste_def_level},cs_symbol_table) = readPtr id_info cs_symbol_table
| ste_kind == STE_Empty || ste_def_level < cRankTwoScope
= {cs & cs_symbol_table = cs_symbol_table <:= (id_info,
- {ste_index = NoIndex, ste_kind = STE_TypeVariable tv_info_ptr, ste_def_level = cRankTwoScope, ste_previous = entry})}
+ {ste_index = NoIndex, ste_kind = STE_TypeVariable tv_info_ptr, ste_def_level = cRankTwoScope, ste_previous = entry, ste_doc = No})}
# cs_error = checkError id_name "type variable already defined" cs.cs_error
= {cs & cs_symbol_table = cs_symbol_table,cs_error=cs_error}
@@ -1305,7 +1305,7 @@
= ([tc : tcs], type_context_vars, type_defs, class_defs, modules, heaps, cs)
NewEntry symbol_table symb_ptr def_kind def_index level previous :==
- symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
+ symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous, ste_doc = No })
checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-> (![TypeVar], ![TypeContext], !u:{#CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
@@ -1700,7 +1700,7 @@
# (entry, symbol_table) = readPtr id_info symbol_table
= ( var_heap <:= (tv_info_ptr, TVI_Empty),
symbol_table <:= (id_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable tv_info_ptr,
- ste_def_level = cModuleScope, ste_previous = entry }))
+ ste_def_level = cModuleScope, ste_previous = entry, ste_doc = No }))
check_global_type_variables_in_dynamics dyn_info_ptrs expr_heap_and_cs
= foldSt check_global_type_variables_in_dynamic dyn_info_ptrs expr_heap_and_cs
@@ -1814,7 +1814,7 @@
| var_entry.ste_kind == STE_Empty || scope < var_entry.ste_def_level
#! (new_var_ptr, type_var_heap) = newPtr TVI_Empty type_var_heap
# cs_symbol_table = cs_symbol_table <:=
- (var_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = var_entry })
+ (var_info, {ste_index = NoIndex, ste_kind = STE_TypeVariable new_var_ptr, ste_def_level = scope, ste_previous = var_entry, ste_doc = No })
= ({atv & atv_attribute = TA_Multi, atv_variable = { atv_variable & tv_info_ptr = new_var_ptr }}, (type_var_heap,
{ cs & cs_symbol_table = cs_symbol_table, cs_error = check_attribute atv_attribute cs_error}))
= (atv, (type_var_heap, { cs & cs_symbol_table = cs_symbol_table, cs_error = checkError tv_ident.id_name "type variable already defined" cs_error }))
@@ -1912,7 +1912,7 @@
atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
(atv_attribute, attr_vars, th_attrs, cs_error) = check_attribute (scope == cRankTwoScope) atv_attribute tv_ident.id_name attr_vars th_attrs cs_error
cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
- stv_info_ptr = tv_info_ptr}, ste_def_level = scope /* cOuterMostLevel */, ste_previous = entry })
+ stv_info_ptr = tv_info_ptr}, ste_def_level = scope /* cOuterMostLevel */, ste_previous = entry, ste_doc = No })
heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs }
= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
(attr_vars, heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }))
@@ -1967,7 +1967,7 @@
atv_variable = { atv_variable & tv_info_ptr = tv_info_ptr }
(atv_attribute, th_attrs, cs_error) = check_attribute atv_attribute root_attr tv_ident.id_name th_attrs cs_error
cs_symbol_table = cs_symbol_table <:= (tv_info, {ste_index = NoIndex, ste_kind = STE_BoundTypeVariable {stv_attribute = atv_attribute,
- stv_info_ptr = tv_info_ptr }, ste_def_level = cGlobalScope /* cOuterMostLevel */, ste_previous = entry })
+ stv_info_ptr = tv_info_ptr }, ste_def_level = cGlobalScope /* cOuterMostLevel */, ste_previous = entry, ste_doc = No })
heaps = { heaps & th_vars = th_vars, th_attrs = th_attrs }
= ({atv & atv_variable = atv_variable, atv_attribute = atv_attribute},
(heaps, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error}))
@@ -2216,9 +2216,9 @@
}
symbol_table = symbol_table <:= (type_id_info, { ste_kind = STE_DictType type_def, ste_index = index_type,
- ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
+ ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry", ste_doc = No })
<:= (cons_id_info, { ste_kind = STE_DictCons cons_def, ste_index = index_cons,
- ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" })
+ ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry", ste_doc = No })
= ({class_defs & [class_index] = {class_def & class_dictionary = class_dictionary}}, modules,
type_id_info, { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector },
@@ -2276,7 +2276,7 @@
}
field = { fs_ident = field_id, fs_var = field_id, fs_index = selector_index }
= (field, var_heap, symbol_table <:= (id_info, { ste_kind = STE_DictField sel_def, ste_index = selector_index,
- ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }))
+ ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry", ste_doc = No }))
size_types :: ![Type] !Int -> Int
size_types [type:types] s = size_types types (size_type type s)
--- /frontend/frontend.icl
+++ /frontend/frontend.icl
@@ -316,7 +316,7 @@
newSymbolTable :: !Int -> *{# SymbolTableEntry}
newSymbolTable size
- = createArray size { ste_index = NoIndex, ste_def_level = -1, ste_kind = STE_Empty, ste_previous = abort "PreviousPlaceholder"}
+ = createArray size { ste_index = NoIndex, ste_def_level = -1, ste_kind = STE_Empty, ste_previous = abort "PreviousPlaceholder", ste_doc = No}
showFunctions :: !IndexRange !*{# FunDef} !*File -> (!*{# FunDef},!*File)
showFunctions {ir_from, ir_to} fun_defs file
--- /frontend/parse.icl
+++ /frontend/parse.icl
@@ -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
@@ -309,12 +308,12 @@
// 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)
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 @@
wantDefinitions :: !ParseContext !ParseState -> (![ParsedDefinition], !ParseState)
wantDefinitions parseContext pState
- = parseList (tryDefinition parseContext) pState
+ = mergeDocumentation (parseList (tryDefinition parseContext) pState)
+where
+ mergeDocumentation :: ([ParsedDefinition], ParseState) -> ([ParsedDefinition], ParseState)
+ mergeDocumentation ([PD_Documentation DocBlock doc:f=:PD_Function pos id is_infix args rhs kind:rest], pState)
+ = mergeDocumentation ([f:rest], saveDocu id doc pState)
+ mergeDocumentation ([PD_Documentation DocBlock doc:f=:PD_TypeSpec pos id prio type specials:rest], pState)
+ = mergeDocumentation ([f:rest], saveDocu id doc pState)
+ mergeDocumentation ([PD_Documentation DocBlock doc:c=:PD_Class cd pds:rest], pState)
+ = mergeDocumentation ([c:rest], saveDocu cd.class_ident doc pState)
+ mergeDocumentation ([PD_Documentation DocBlock doc:c=:PD_Type ptd:rest], pState)
+ = 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)
+ 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}
+
cHasPriority :== True
cHasNoPriority :== False
@@ -396,9 +426,17 @@
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))
@@ -2394,8 +2432,10 @@
_
-> 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)
@@ -2404,7 +2444,7 @@
(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)
@@ -2552,9 +2592,11 @@
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}
@@ -5317,6 +5359,16 @@
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)
+
//---------------//
//--- Tracing ---//
//---------------//
--- /frontend/postparse.icl
+++ /frontend/postparse.icl
@@ -1452,7 +1452,7 @@
cons_arity = new_count - sel_count
pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ]
cons_def = { pc_cons_ident = rec_cons_id, pc_cons_prio = NoPrio, pc_cons_arity = cons_arity, pc_cons_pos = td_pos,
- pc_arg_types = pc_arg_types, pc_args_strictness=strictness_from_fields sel_defs,pc_context=[], pc_exi_vars = exivars }
+ pc_arg_types = pc_arg_types, pc_args_strictness=strictness_from_fields sel_defs,pc_context=[], pc_exi_vars = exivars, pc_doc = No }
type_def = { type_def & td_rhs = RecordType {rt_constructor = { ds_ident = rec_cons_id, ds_arity = cons_arity, ds_index = cons_count },
rt_fields = { sel \\ sel <- sel_syms }, rt_is_boxed_record = is_boxed_record}}
c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = [ParsedConstructorToConsDef cons_def : c_defs.def_constructors],
--- /frontend/predef.icl
+++ /frontend/predef.icl
@@ -422,9 +422,9 @@
(list_def, pre_def_symbols) = make_type_def list_type_pre_def_symbol_index [type_var] (AlgType [cons_ds,nil_symb]) pre_def_symbols
list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_ident 1) [type_var_with_attr])
cons_def = { pc_cons_ident = cons_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type], pc_context = [],
- pc_args_strictness=cons_strictness, pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
+ pc_args_strictness=cons_strictness, pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id, pc_doc=No}
nil_def = { pc_cons_ident = nil_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_context = [],
- pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
+ pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id, pc_doc=No}
= (list_def,ParsedConstructorToConsDef cons_def,ParsedConstructorToConsDef nil_def,pre_def_symbols);
make_unit_definition :: Ident *{#PredefinedSymbol} -> (!TypeDef TypeRhs,!ConsDef,!.{#PredefinedSymbol})
@@ -433,7 +433,7 @@
unit_cons_symb = {ds_ident = unit_cons_ident, ds_arity=0 ,ds_index = PD_UnitConsSymbol-FirstConstructorPredefinedSymbolIndex}
(unit_type_def, pre_def_symbols) = make_type_def PD_UnitType [] (AlgType [unit_cons_symb]) pre_def_symbols
unit_cons_def = {pc_cons_ident = unit_cons_ident, pc_cons_arity = 0, pc_arg_types = [], pc_args_strictness=NotStrict, pc_context = [],
- pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
+ pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id, pc_doc = No}
= (unit_type_def,ParsedConstructorToConsDef unit_cons_def,pre_def_symbols);
buildPredefinedModule :: !Bool !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols)
@@ -496,7 +496,8 @@
tuple_cons_def = { pc_cons_ident = tuple_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id,
pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars],
pc_args_strictness = NotStrict, pc_context = [],
- pc_cons_prio = NoPrio, pc_exi_vars = []}
+ pc_cons_prio = NoPrio, pc_exi_vars = [],
+ pc_doc = No}
= add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [ParsedConstructorToConsDef tuple_cons_def : cons_defs] pre_def_symbols
= (type_defs, cons_defs, pre_def_symbols)
where
--- /frontend/scanner.dcl
+++ /frontend/scanner.dcl
@@ -115,6 +115,9 @@
| ExistsToken // E.
| ForAllToken // A.
+ | DocBlockToken String // /** ... */
+ | DocLineToken String // //*
+
:: ScanContext
= GeneralContext
| TypeContext
--- /frontend/scanner.icl
+++ /frontend/scanner.icl
@@ -203,6 +203,9 @@
| ExistsToken // E.
| ForAllToken // A.
+ | DocBlockToken String // /** ... */
+ | DocLineToken String // //*
+
:: ScanContext
= GeneralContext
| TypeContext
@@ -493,12 +496,32 @@
TryScanComment c1=:'/' input
# (eof,c2, input) = ReadNormalChar input
| eof = (No, c1, input)
- = case c2 of
- '/' -> SkipWhites (SkipToEndOfLine input)
- '*' -> case ScanComment input of
- (No,input) -> SkipWhites input
- (er,input) -> (er, c1, input)
- _ -> (No, c1, charBack input)
+ | c2 == '/'
+ # (eof,c3,input) = ReadChar input
+ | eof = SkipWhites (SkipToEndOfLine (charBack input))
+ | isNewLine c3 = SkipWhites input
+ | c3 <> '*' = SkipWhites (SkipToEndOfLine (charBack input))
+ = (No, c1, charBack (charBack input)) // Docline, starts with //*
+ | c2 <> '*' = (No, c1, charBack input)
+ # (eof,c3,input) = ReadChar input
+ | eof = (No, c1, input)
+ | c3 == '*' // Docblock?
+ # (eof,c4,input) = ReadNormalChar input
+ | eof = (No, c1, charBack (charBack input)) // Docblock, starts with /**<eof>
+ | c4 == '/' = SkipWhites input // Skip over /**/
+ | c4 == ' '
+ # (eof,c5,input) = ReadNormalChar input
+ | eof = (No, c1, charBack (charBack (charBack input))) // Docblock, /** <eof>
+ | c5 == '@' = (No, c1, charBack (charBack (charBack (charBack input)))) // Single-line docblock, /** @
+ = case ScanComment input of
+ (No,input) -> SkipWhites input
+ (er,input) -> (er, c5, input)
+ = case ScanComment input of // Normal comment
+ (No,input) -> SkipWhites input
+ (er,input) -> (er, c4, input)
+ = case ScanComment input of
+ (No,input) -> SkipWhites input
+ (er,input) -> (er, c1, input)
TryScanComment c input
= (No, c, input)
@@ -746,6 +769,21 @@
| eof = (IdentToken "A", input)
| c1 == '.' = (ForAllToken, input)
= ScanIdentFast 1 (charBack input) TypeContext
+
+Scan c0=:'/' input co
+ # (eof, c1, input) = ReadNormalChar input
+ | eof = (IdentToken "/", input)
+ | c1 == '/'
+ # (eof, c2, input) = ReadNormalChar input
+ | eof = (ErrorToken "// before EOF in Scan", input)
+ | c2 <> '*' = (ErrorToken "// in Scan", input)
+ = ScanDocLine 0 input [c2] co
+ | c1 == '*'
+ # (eof, c2, input) = ReadNormalChar input
+ | eof = (ErrorToken "/* before EOF in Scan", input)
+ | c2 <> '*' = (ErrorToken "/* in Scan", input)
+ = ScanDocBlock -1 input [] co
+
Scan c input co
| IsDigit c = ScanNumeral 0 input [c]
| IsIdentChar c co
@@ -802,6 +840,24 @@
| isSpecialChar c = ScanOperator (n + 1) input [c:token] co
= CheckReservedOperator (revCharListToString n token) (charBack input)
+ScanDocBlock :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
+ScanDocBlock n input doc co
+ # (eof, c1, input) = ReadChar input
+ | eof = (ErrorToken "EOF in docblock", input)
+ | c1 <> '*' = ScanDocBlock (n + 1) input [c1:doc] co
+ # (eof, c2, input) = ReadChar input
+ | eof = (ErrorToken "EOF in docblock", input)
+ = case c2 of
+ '/' -> (DocBlockToken (revCharListToString n doc), input)
+ '*' -> ScanDocBlock (n + 1) (charBack input) [c1:doc] co
+ _ -> ScanDocBlock (n + 2) input [c2:c1:doc] co
+
+ScanDocLine :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
+ScanDocLine n input doc co
+ # (eof, c, input) = ReadChar input
+ | eof || isNewLine c = (DocLineToken (revCharListToString n doc), input)
+ = ScanDocLine (n + 1) input [c:doc] co
+
CheckReservedIdent :: !ScanContext !String !Input -> (!Token, !Input)
CheckReservedIdent GeneralContext s i = CheckGeneralContext s i
CheckReservedIdent TypeContext s i = CheckTypeContext s i
@@ -1566,6 +1622,9 @@
toString ExistsToken = "E."
toString ForAllToken = "A."
+ toString (DocBlockToken doc) = "<doc block>"
+ toString (DocLineToken doc) = "<doc line>"
+
toString token = "toString (Token) does not know this token"
instance == Token