Skip to content
GitLab
Commit 6af73849 authored by John van Groningen's avatar John van Groningen
Browse files

implement qualified explicit imports

parent 30a9c9a8
Expand all Hide whitespace changes
Inline Side-by-side
frontend/check.icl
View file @ 6af73849
This diff is collapsed.
frontend/checkFunctionBodies.icl
View file @ 6af73849
This diff is collapsed.
frontend/checksupport.dcl
View file @ 6af73849
......@@ -103,6 +103,7 @@ cConversionTableSize :== 10
, icl_function_indices :: !IclFunctionIndices
, icl_common :: !.CommonDefs
, icl_import :: !{!Declaration}
, icl_qualified_imports :: ![([Declaration], ModuleN, Position)]
, icl_imported_objects :: ![ImportedObject]
, icl_foreign_exports :: ![ForeignExport]
, icl_used_module_numbers :: !NumberSet
......
frontend/checksupport.icl
View file @ 6af73849
......@@ -362,8 +362,8 @@ where
# ({ste_kind,ste_previous}, symbol_table)
= readPtr id_info symbol_table
= case ste_kind of
STE_Field field_id
# symbol_table = removeFieldFromSelectorDefinition field_id NoIndex decl_index symbol_table
STE_Field selector_id
# symbol_table = removeFieldFromSelectorDefinition selector_id NoIndex decl_index symbol_table
| ste_previous.ste_def_level == scope
-> symbol_table <:= (id_info, ste_previous.ste_previous)
-> symbol_table <:= (id_info, ste_previous)
......
frontend/checktypes.icl
View file @ 6af73849
......@@ -4,6 +4,7 @@ import StdEnv
import syntax, checksupport, check, typesupport, utilities,
compilerSwitches // , RWSDebug
import genericsupport
from explicitimports import search_qualified_ident,::NameSpaceN,TypeNameSpaceN,ClassNameSpaceN
:: TypeSymbols =
{ ts_type_defs :: !.{# CheckedTypeDef}
......@@ -100,16 +101,35 @@ where
retrieveTypeDefinition :: SymbolPtr !Index !*SymbolTable ![SymbolPtr] -> ((!Index, !Index), !*SymbolTable, ![SymbolPtr])
retrieveTypeDefinition type_ptr mod_index symbol_table used_types
# (entry, symbol_table) = readPtr type_ptr symbol_table
= case entry of
({ste_kind = this_kind =: STE_Imported STE_Type decl_index, ste_def_level, ste_index})
-> ((ste_index, decl_index), symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType decl_index this_kind }), [type_ptr : used_types])
({ste_kind = this_kind =: STE_Type, ste_def_level, ste_index})
# (entry=:{ste_kind,ste_def_level,ste_index}, symbol_table) = readPtr type_ptr symbol_table
= case ste_kind of
this_kind=:(STE_Imported STE_Type ste_mod_index)
-> ((ste_index, ste_mod_index), symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType ste_mod_index this_kind }), [type_ptr : used_types])
this_kind=:STE_Type
| ste_def_level == cGlobalScope
-> ((ste_index, mod_index), symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType mod_index this_kind }), [type_ptr : used_types])
-> ((NotFound, mod_index), symbol_table, used_types)
({ste_kind = STE_UsedType mod_index _, ste_def_level, ste_index})
STE_UsedType mod_index _
-> ((ste_index, mod_index), symbol_table, used_types)
this_kind=:(STE_UsedQualifiedType uqt_mod_index uqt_index orig_kind)
| uqt_mod_index==mod_index && uqt_index==ste_index
-> ((ste_index, mod_index),symbol_table, used_types)
-> retrieve_type_definition orig_kind
with
retrieve_type_definition (STE_UsedQualifiedType uqt_mod_index uqt_index orig_kind)
| uqt_mod_index==mod_index && uqt_index==ste_index
= ((ste_index, mod_index),symbol_table, used_types)
= retrieve_type_definition orig_kind
retrieve_type_definition (STE_Imported STE_Type ste_mod_index)
= ((ste_index, ste_mod_index), symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType ste_mod_index this_kind }), used_types)
retrieve_type_definition STE_Type
| ste_def_level == cGlobalScope
= ((ste_index, mod_index), symbol_table <:= (type_ptr, { entry & ste_kind = STE_UsedType mod_index this_kind }), used_types)
= ((NotFound, mod_index), symbol_table, used_types)
retrieve_type_definition (STE_UsedType mod_index _)
= ((ste_index, mod_index), symbol_table, used_types)
retrieve_type_definition _
= ((NotFound, mod_index), symbol_table, used_types)
_
-> ((NotFound, mod_index), symbol_table, used_types)
......@@ -157,25 +177,70 @@ where
# (arg_type, _, ts_ti_cs) = bindTypes cti arg_type ts_ti_cs
(res_type, _, ts_ti_cs) = bindTypes cti res_type ts_ti_cs
= (arg_type --> res_type, TA_Multi, ts_ti_cs)
//AA..
bindTypes cti (TArrow1 type) ts_ti_cs
# (type, _, ts_ti_cs) = bindTypes cti type ts_ti_cs
= (TArrow1 type, TA_Multi, ts_ti_cs)
//..AA
bindTypes cti (CV tv :@: types) ts_ti_cs
# (tv, type_attr, ts_ti_cs) = bindTypes cti tv ts_ti_cs
(types, _, ts_ti_cs) = bindTypes cti types ts_ti_cs
= (CV tv :@: types, type_attr, ts_ti_cs)
// Sjaak 16-08-01
bindTypes cti (TFA vars type) (ts, ti=:{ti_type_heaps}, cs)
# (type_vars, (_, ti_type_heaps, cs)) = addTypeVariablesToSymbolTable cRankTwoScope vars [] ti_type_heaps cs
(type, _, (ts, ti, cs)) = bindTypes cti type (ts, {ti & ti_type_heaps = ti_type_heaps}, cs)
cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cRankTwoScope type_vars cs.cs_symbol_table
= (TFA type_vars type, TA_Multi, (ts, ti, { cs & cs_symbol_table = cs_symbol_table }))
// ... Sjaak
bindTypes cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} type=:(TQualifiedIdent module_id type_name types)
(ts=:{ts_type_defs,ts_modules}, ti, cs)
# (found,{decl_kind,decl_ident=type_ident,decl_index=type_index},cs) = search_qualified_ident module_id type_name TypeNameSpaceN cs
| not found
= (TE, TA_Multi, (ts, ti, cs))
= case decl_kind of
STE_Imported STE_Type type_module
# ({td_arity,td_attribute,td_rhs},type_index,ts_type_defs,ts_modules) = getTypeDef type_index type_module cti_module_index ts_type_defs ts_modules
ts = { ts & ts_type_defs = ts_type_defs, ts_modules = ts_modules }
(cs_symbol_table, ti_used_types) = add_qualified_type_to_used_types type_ident.id_info type_module type_index cs.cs_symbol_table ti.ti_used_types
cs = {cs & cs_symbol_table = cs_symbol_table}
ti = { ti & ti_used_types = ti_used_types }
# type_cons = MakeNewTypeSymbIdent type_ident (length types)
| checkArityOfType type_cons.type_arity td_arity td_rhs
# (types, _, ts_ti_cs) = bindTypes cti types (ts, ti, cs)
| type_module == cti_module_index && cti_type_index == type_index
-> (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types, cti_lhs_attribute, ts_ti_cs)
-> (TA { type_cons & type_index = { glob_object = type_index, glob_module = type_module}} types,
determine_type_attribute td_attribute, ts_ti_cs)
-> (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError type_cons.type_ident "used with wrong arity" cs.cs_error }))
_
-> (TE, TA_Multi, (ts, ti, { cs & cs_error = checkError (module_id.id_name+++"@"+++type_name) "not imported" cs.cs_error}))
where
add_qualified_type_to_used_types symbol_table_ptr type_module type_index symbol_table used_types
# (entry=:{ste_kind,ste_index}, symbol_table) = readPtr symbol_table_ptr symbol_table
= case ste_kind of
STE_UsedQualifiedType mod_index decl_index next_kind
| (mod_index==type_module && decl_index==type_index) || qualified_type_occurs next_kind ste_index type_module type_index
-> (symbol_table, used_types)
# entry = {entry & ste_kind = STE_UsedQualifiedType type_module type_index ste_kind }
-> (writePtr symbol_table_ptr entry symbol_table, used_types)
STE_UsedType ste_module next_kind
| (ste_module==type_module && ste_index==type_index) || qualified_type_occurs next_kind ste_index type_module type_index
-> (symbol_table, used_types)
# entry = {entry & ste_kind = STE_UsedQualifiedType type_module type_index ste_kind }
-> (writePtr symbol_table_ptr entry symbol_table, used_types)
_
# entry = {entry & ste_kind = STE_UsedQualifiedType type_module type_index ste_kind }
-> (writePtr symbol_table_ptr entry symbol_table, [symbol_table_ptr:used_types])
qualified_type_occurs (STE_UsedQualifiedType mod_index decl_index next_kind) ste_index type_module type_index
| mod_index==type_module && decl_index==type_index
= True
= qualified_type_occurs next_kind ste_index type_module type_index
qualified_type_occurs (STE_UsedType ste_module next_kind) ste_index type_module type_index
| ste_module==type_module && ste_index==type_index
= True
= qualified_type_occurs next_kind ste_index type_module type_index
qualified_type_occurs _ _ _ _
= False
bindTypes cti type ts_ti_cs
= (type, TA_Multi, ts_ti_cs)
addToAttributeEnviron :: !TypeAttribute !TypeAttribute ![AttrInequality] !*ErrorAdmin -> (![AttrInequality],!*ErrorAdmin)
addToAttributeEnviron TA_Multi _ attr_env error
......@@ -349,11 +414,21 @@ where
retrieve_used_types symb_ptrs symbol_table
= foldSt retrieve_used_type symb_ptrs ([], symbol_table)
where
where
retrieve_used_type symb_ptr (used_types, symbol_table)
# (ste=:{ste_kind=STE_UsedType decl_index orig_kind,ste_index}, symbol_table) = readPtr symb_ptr symbol_table
= ([{gi_module = decl_index, gi_index = ste_index} : used_types], symbol_table <:= (symb_ptr, { ste & ste_kind = orig_kind }))
# (ste=:{ste_kind,ste_index}, symbol_table) = readPtr symb_ptr symbol_table
# (orig_kind,used_types) = retrieve_used_types_of_ident ste_kind ste_index used_types
= (used_types, symbol_table <:= (symb_ptr, { ste & ste_kind = orig_kind }))
retrieve_used_types_of_ident (STE_UsedType mod_index orig_kind) ste_index used_types
# used_types = [{gi_module = mod_index, gi_index = ste_index} : used_types]
= retrieve_used_types_of_ident orig_kind ste_index used_types
retrieve_used_types_of_ident (STE_UsedQualifiedType mod_index decl_index orig_kind) ste_index used_types
# used_types = [{gi_module = mod_index, gi_index = decl_index} : used_types]
= retrieve_used_types_of_ident orig_kind ste_index used_types
retrieve_used_types_of_ident orig_kind ste_index used_types
= (orig_kind,used_types)
CS_Checked :== 1
CS_Checking :== 0
......@@ -607,7 +682,6 @@ checkOpenAType mod_index scope dem_attr_kind type=:{ at_type=TA type_cons=:{type
ots = { ots & ots_type_defs = ots_type_defs, ots_modules = ots_modules }
| x_check_dynamic_types && checkAbstractType type_module td_rhs
= (type, (ots, oti, {cs & cs_error = checkError type_ident "(abstract type) not permitted in a dynamic type" cs.cs_error}))
| checkArityOfType type_cons.type_arity td_arity td_rhs
# type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }}
(types, (ots, oti, cs)) = check_args_of_type_cons mod_index scope dem_attr_kind types td_args (ots, oti, cs)
......@@ -674,6 +748,27 @@ where
remove_universal_var {atv_variable = {tv_ident}} cs_symbol_table
= removeDefinitionFromSymbolTable cRankTwoScope tv_ident cs_symbol_table
checkOpenAType mod_index scope dem_attr_kind type=:{ at_type=TQualifiedIdent module_id type_name types, at_attribute}
(ots=:{ots_type_defs,ots_modules}, oti, cs=:{cs_symbol_table,cs_x={x_check_dynamic_types}})
# (found,{decl_kind,decl_ident=type_ident,decl_index=type_index},cs) = search_qualified_ident module_id type_name TypeNameSpaceN cs
| not found
= (type, (ots, oti, cs))
= case decl_kind of
STE_Imported STE_Type type_module
# id_name = type_name
# type_cons = MakeNewTypeSymbIdent type_ident (length types)
# ({td_arity,td_args,td_attribute,td_rhs},type_index,ots_type_defs,ots_modules) = getTypeDef type_index type_module mod_index ots_type_defs ots_modules
ots = { ots & ots_type_defs = ots_type_defs, ots_modules = ots_modules }
| x_check_dynamic_types && checkAbstractType type_module td_rhs
-> (type, (ots, oti, {cs & cs_error = checkError type_ident "(abstract type) not permitted in a dynamic type" cs.cs_error}))
| checkArityOfType type_cons.type_arity td_arity td_rhs
# type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }}
(types, (ots, oti, cs)) = check_args_of_type_cons mod_index scope dem_attr_kind types td_args (ots, oti, cs)
(new_attr, oti, cs) = newAttribute (new_demanded_attribute dem_attr_kind td_attribute) id_name at_attribute oti cs
-> ({ type & at_type = TA type_cons types, at_attribute = new_attr } , (ots, oti, cs))
-> (type, (ots, oti, {cs & cs_error = checkError type_ident "used with wrong arity" cs.cs_error}))
_
-> (type, (ots, oti, {cs & cs_error = checkError (module_id.id_name+++"@"+++type_name) "not imported" cs.cs_error}))
checkOpenAType mod_index scope dem_attr type=:{at_attribute} (ots, oti, cs)
# (new_attr, oti, cs) = newAttribute dem_attr "." at_attribute oti cs
= ({ type & at_attribute = new_attr}, (ots, oti, cs))
......@@ -866,15 +961,14 @@ where
checkTypeContext :: !Index !TypeContext !(!v:{# ClassDef}, !u:OpenTypeSymbols, !*OpenTypeInfo, !*CheckState)
-> (!TypeContext,!(!v:{# ClassDef}, !u:OpenTypeSymbols, !*OpenTypeInfo, !*CheckState))
checkTypeContext mod_index tc=:{tc_class, tc_types} (class_defs, ots, oti, cs)
# (tc_class, (class_defs, ots, cs=:{cs_error})) = check_context_class tc_class (class_defs, ots, cs)
# (tc_class, (class_defs, ots, cs=:{cs_error})) = check_context_class tc_class tc_types (class_defs, ots, cs)
| cs_error.ea_ok
# (tc_types, (ots, oti, cs)) = checkOpenTypes mod_index cGlobalScope DAK_Ignore tc_types (ots, oti, cs)
# cs = check_context_types tc_class tc_types cs
= ({tc & tc_class = tc_class, tc_types = tc_types}, (class_defs, ots, oti, cs))
= ({tc & tc_types = []}, (class_defs, ots, oti, cs))
where
check_context_class (TCClass cl) (class_defs, ots, cs)
check_context_class (TCClass cl) tc_types (class_defs, ots, cs)
# (entry, cs_symbol_table) = readPtr cl.glob_object.ds_ident.id_info cs.cs_symbol_table
# cs = { cs & cs_symbol_table = cs_symbol_table }
# (class_index, class_module) = retrieveGlobalDefinition entry STE_Class mod_index
......@@ -882,17 +976,32 @@ where
# (class_def, class_index, class_defs, ots_modules) = getClassDef class_index class_module mod_index class_defs ots.ots_modules
# ots = { ots & ots_modules = ots_modules }
| class_def.class_arity == cl.glob_object.ds_arity
# checked_class =
{ cl
# checked_class =
{ cl
& glob_module = class_module
, glob_object = {cl.glob_object & ds_index = class_index}
}
}
= (TCClass checked_class, (class_defs, ots, cs))
# cs_error = checkError cl.glob_object.ds_ident "class used with wrong arity" cs.cs_error
= (TCClass cl, (class_defs, ots, {cs & cs_error = cs_error}))
# cs_error = checkError cl.glob_object.ds_ident "class undefined" cs.cs_error
= (TCClass cl, (class_defs, ots, {cs & cs_error = cs_error}))
check_context_class (TCGeneric gtc=:{gtc_generic, gtc_kind}) (class_defs, ots, cs)
= (TCClass cl, (class_defs, ots, {cs & cs_error = cs_error}))
check_context_class tc_class=:(TCQualifiedIdent module_id class_name) tc_types (class_defs, ots, cs)
# (found,{decl_kind,decl_ident=type_ident,decl_index=class_index},cs) = search_qualified_ident module_id class_name ClassNameSpaceN cs
| not found
= (tc_class, (class_defs, ots, cs))
= case decl_kind of
STE_Imported STE_Class class_module
# ({class_ident,class_arity}, class_index, class_defs, ots_modules) = getClassDef class_index class_module mod_index class_defs ots.ots_modules
# ots = { ots & ots_modules = ots_modules }
| class_arity == length tc_types
# checked_class = { glob_object = MakeDefinedSymbol class_ident class_index class_arity, glob_module = class_module }
-> (TCClass checked_class, (class_defs, ots, cs))
# cs_error = checkError (module_id.id_name+++"@"+++class_name) "class used with wrong arity" cs.cs_error
-> (tc_class, (class_defs, ots, {cs & cs_error = cs_error}))
_
-> (tc_class, (class_defs, ots, {cs & cs_error = checkError (module_id.id_name+++"@"+++class_name) "class undefined" cs.cs_error}))
check_context_class (TCGeneric gtc=:{gtc_generic, gtc_kind}) tc_types (class_defs, ots, cs)
# gen_ident = gtc_generic.glob_object.ds_ident
# (entry, cs_symbol_table) = readPtr gen_ident.id_info cs.cs_symbol_table
# cs = { cs & cs_symbol_table = cs_symbol_table }
......
frontend/explicitimports.dcl
View file @ 6af73849
......@@ -7,11 +7,18 @@ import syntax, checksupport
, ini_imp_decl :: !ImportDeclaration
}
:: SolvedImports =
{ si_explicit :: ![([Declaration], Position)]
, si_implicit :: ![(Index, Position)] // module indices
:: ExplicitImport = ! {
ei_module_n :: !Int,
ei_position :: !Position,
ei_symbols :: ![ImportNrAndIdents],
ei_qualified:: !Bool
}
:: SolvedImports =
{ si_explicit :: ![([Declaration], Position)]
, si_qualified_explicit :: ![([Declaration], ModuleN, Position)]
, si_implicit :: ![(ModuleN, Position)]
}
markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable)
-> (!.[Ident],!(!{!{!u:ExplImpInfo}},!.SymbolTable))
......@@ -19,10 +26,26 @@ markExplImpSymbols :: !Int !*(!*{!*{!u:ExplImpInfo}}, !*SymbolTable)
updateExplImpForMarkedSymbol :: !Index !Declaration !SymbolTableEntry !u:{#DclModule} !{!{!*ExplImpInfo}} !*SymbolTable
-> (!u:{#DclModule}, !{!{!.ExplImpInfo}}, !.SymbolTable)
solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !{#Int} !Index
solveExplicitImports :: !(IntKeyHashtable [ExplicitImport]) !{#Int} !Index
!*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState)
-> (!.SolvedImports,! (!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState))
checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*ExpressionHeap !*CheckState
-> (!.{#DclModule},!.{#FunDef},!*{#*{#FunDef}},!.ExpressionHeap,!.CheckState)
checkExplicitImportCompleteness :: ![([Declaration], Position)] ![([Declaration], Int, Position)]
!*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*ExpressionHeap !*CheckState
-> (!.{#DclModule},!.{#FunDef},!*{#*{#FunDef}},!.ExpressionHeap,!.CheckState)
store_qualified_explicit_imports_in_symbol_table :: ![([Declaration],Int,Position)] ![(SymbolPtr,STE_Kind)] !*SymbolTable *{#DclModule} -> (![(SymbolPtr,STE_Kind)],!*SymbolTable,!*{#DclModule})
:: NameSpaceN:==Int
ExpressionNameSpaceN:==0
TypeNameSpaceN:==1
ClassNameSpaceN:==2
FieldNameSpaceN:==3
OtherNameSpaceN:==4
search_qualified_ident :: !Ident {#Char} !NameSpaceN !*CheckState -> (!Bool,!DeclarationRecord,!*CheckState)
search_qualified_import :: !String !SortedQualifiedImports !NameSpaceN -> (!Bool,!DeclarationRecord)
search_qualified_imports :: !String !SortedQualifiedImports !NameSpaceN -> [DeclarationRecord]
restore_module_ste_kinds_in_symbol_table :: ![(SymbolPtr,STE_Kind)] !*SymbolTable -> *SymbolTable
frontend/explicitimports.icl
View file @ 6af73849
This diff is collapsed.
frontend/frontend.icl
View file @ 6af73849
......@@ -65,7 +65,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m
select_and_remove_icl_functions_from_record :: !*IclModule -> (!.{#FunDef},!.IclModule)
select_and_remove_icl_functions_from_record icl_mod=:{icl_functions} = (icl_functions,{icl_mod & icl_functions={}})
# { icl_common,icl_function_indices,icl_name,icl_import,icl_imported_objects,
# { icl_common,icl_function_indices,icl_name,icl_import,icl_qualified_imports,icl_imported_objects,
icl_foreign_exports,icl_used_module_numbers,icl_copied_from_dcl } = icl_mod
/*
(_,f,files) = fopen "components" FWriteText files
......@@ -167,7 +167,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m
= (No,{},{},main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
# (ok, fun_defs, array_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out)
= typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs icl_function_indices.ifi_specials_indices list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out dcl_mods
= typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs icl_function_indices.ifi_specials_indices list_inferred_types icl_common icl_import icl_qualified_imports dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out
| not ok
= (No,{},{},main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps)
......@@ -289,8 +289,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules cached_dcl_m
# heaps = {hp_var_heap = var_heap, hp_expression_heap=expression_heap, hp_type_heaps=type_heaps,hp_generic_heap=heaps.hp_generic_heap}
# fe ={ fe_icl = {icl_functions=fun_defs, icl_function_indices=icl_function_indices, icl_common=icl_common,
icl_import=icl_import, icl_imported_objects=icl_imported_objects, icl_foreign_exports=icl_foreign_exports,
icl_name=icl_name,icl_used_module_numbers=icl_used_module_numbers,
icl_import=icl_import, icl_qualified_imports=icl_qualified_imports, icl_imported_objects=icl_imported_objects,
icl_foreign_exports=icl_foreign_exports,icl_name=icl_name,icl_used_module_numbers=icl_used_module_numbers,
icl_copied_from_dcl=icl_copied_from_dcl,icl_modification_time=icl_mod.icl_modification_time }
, fe_dcls = dcl_mods
, fe_components = components
......
frontend/parse.icl
View file @ 6af73849
This diff is collapsed.
frontend/postparse.icl
View file @ 6af73849
......@@ -349,6 +349,11 @@ where
collectFunctions e icl_module ca
= (e, ca)
instance collectFunctions FieldNameOrQualifiedFieldName
where
collectFunctions e icl_module ca
= (e, ca)
instance collectFunctions (ParsedInstance a) | collectFunctions a where
collectFunctions inst=:{pi_members} icl_module ca
# (pi_members, ca) = collectFunctions pi_members icl_module ca
......@@ -997,7 +1002,7 @@ transformArrayDenot exprs
scanModules :: [ParsedImport] [ScannedModule] [Ident] SearchPaths Bool Bool (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin)
scanModules [] parsed_modules cached_modules searchPaths support_generics support_dynamics modtimefunction files ca
= (True, parsed_modules,files, ca)
scanModules [{import_module,import_symbols,import_file_position} : mods] parsed_modules cached_modules searchPaths support_generics support_dynamics modtimefunction files ca
scanModules [{import_module,import_file_position} : mods] parsed_modules cached_modules searchPaths support_generics support_dynamics modtimefunction files ca
| in_cache import_module cached_modules
= scanModules mods parsed_modules cached_modules searchPaths support_generics support_dynamics modtimefunction files ca
# (found_module,mod_type) = try_to_find import_module parsed_modules
......@@ -1454,6 +1459,7 @@ reorganiseDefinitionsAndAddTypes mod_ident support_dynamics icl_module defs ca
{ import_module = clean_types_module_ident
, import_symbols = []
, import_file_position = NoPos
, import_qualified = False
}
# imports = if (mod_ident == clean_types_module_ident) [] [clean_types_module]
= reorganiseDefinitions icl_module [PD_Import imports : defs] 0 0 0 0 ca
......
frontend/scanner.dcl
View file @ 6af73849
......@@ -23,6 +23,7 @@ instance <<< FilePosition
:: Token
= IdentToken !.String // an identifier
| UnderscoreIdentToken !.String// an identifier that starts with a '_'
| QualifiedIdentToken !String !.String // a qualified identifier
| IntToken !.String // an integer
| RealToken !.String // a real
| StringToken !.String // a string
......
frontend/scanner.icl
View file @ 6af73849
......@@ -110,6 +110,7 @@ ScanOptionNoNewOffsideForSeqLetBit:==4;
:: Token
= IdentToken ! .String // an identifier
| UnderscoreIdentToken !.String// an identifier that starts with a '_'
| QualifiedIdentToken !String !.String // a qualified identifier
| IntToken !.String // an integer
| RealToken !.String // a real
| StringToken !.String // a string
......@@ -773,32 +774,75 @@ new_exp_char c = isSpace c
ScanIdentFast :: !Int !Input !ScanContext -> (!Token, !Input)
ScanIdentFast n input=:{inp_stream=OldLine i line stream,inp_pos} co
# end_i = ScanIdentCharsInString i line co
# (end_i,qualified) = ScanIdentCharsInString i line co
with
ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> Int
ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> (!Int,!Bool)
ScanIdentCharsInString i line co
| i<size line && IsIdentChar line.[i] co
= ScanIdentCharsInString (i+1) line co
= i
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= CheckReserved co (line % (i-n,end_i-1)) input
| i<size line
| IsIdentChar line.[i] co
= ScanIdentCharsInString (i+1) line co
= (i,line.[i]=='@')
= (i,False)
| not qualified
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= CheckReservedIdent co (line % (i-n,end_i-1)) input
# i2=end_i+1
| i2==size line
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= CheckReservedIdent co (line % (i-n,end_i-1)) input
# c=line.[i2]
| IsIdentChar c co
# module_name = line % (i-n,end_i-1)
# end_i = ScanIdentCharsInString (i2+1) line co
with
ScanIdentCharsInString :: !Int !{#Char} !ScanContext -> Int
ScanIdentCharsInString i line co
| i<size line && IsIdentChar line.[i] co
= ScanIdentCharsInString (i+1) line co
= i
# ident_name = line % (i2,end_i-1)
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= (QualifiedIdentToken module_name ident_name,input)
| isSpecialChar c
# module_name = line % (i-n,end_i-1)
# end_i = ScanSpecialCharsInString (i2+1) line
with
ScanSpecialCharsInString :: !Int !{#Char} -> Int
ScanSpecialCharsInString i line
| i<size line && isSpecialChar line.[i]
= ScanSpecialCharsInString (i+1) line
= i
# ident_name = line % (i2,end_i-1)
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= (QualifiedIdentToken module_name ident_name,input)
# pos = {inp_pos & fp_col = inp_pos.fp_col + (end_i-i)}
# input = {input & inp_stream=OldLine end_i line stream,inp_pos=pos}
= CheckReservedIdent co (line % (i-n,end_i-1)) input
ScanOperator :: !Int !Input ![Char] !ScanContext -> (!Token, !Input)
ScanOperator n input token co
# (eof, c, input) = ReadNormalChar input
| eof = CheckReserved co (revCharListToString n token) input
| eof = CheckReservedOperator (revCharListToString n token) input
| isSpecialChar c = ScanOperator (n + 1) input [c:token] co
= CheckReserved co (revCharListToString n token) (charBack input)
= CheckReservedOperator (revCharListToString n token) (charBack input)
CheckReservedIdent :: !ScanContext !String !Input -> (!Token, !Input)
CheckReservedIdent GeneralContext s i = CheckGeneralContext s i
CheckReservedIdent TypeContext s i = CheckTypeContext s i
CheckReservedIdent FunctionContext s i = CheckFunctContext s i
CheckReservedIdent CodeContext s i = CheckCodeContext s i
CheckReservedIdent GenericContext s i = CheckGenericContext s i
CheckReserved :: !ScanContext !String !Input -> (!Token, !Input)
CheckReserved GeneralContext s i = CheckGeneralContext s i
CheckReserved TypeContext s i = CheckTypeContext s i
CheckReserved FunctionContext s i = CheckFunctContext s i
CheckReserved CodeContext s i = CheckCodeContext s i
CheckReserved GenericContext s i = CheckGenericContext s i
CheckReservedOperator :: !String !Input -> (!Token, !Input)
CheckReservedOperator "!" input = (ExclamationToken, input)
CheckReservedOperator "*/" input = (ErrorToken "Unexpected end of comment, */", input)
CheckReservedOperator s input = (IdentToken s, input)
CheckGeneralContext :: !String !Input -> (!Token, !Input)
CheckGeneralContext :: !String !Input -> (!Token, !Input)
CheckGeneralContext s input
= case s of
"module" -> (ModuleToken , input)
......@@ -819,8 +863,6 @@ CheckEveryContext s input
"generic" -> (GenericToken , input)
"derive" -> (DeriveToken , input)
"otherwise" -> (OtherwiseToken , input)
"!" -> (ExclamationToken , input)
"*/" -> (ErrorToken "Unexpected end of comment, */", input)
"infixr" # (error, n, input) = GetPrio input
-> case error of
Yes err -> (ErrorToken err , input) //-->> ("Error token generated: "+err)
......@@ -1424,6 +1466,8 @@ where
toString EndOfFileToken = "end of file"
toString (ErrorToken id) = "Scanner error: " + id
toString (QualifiedIdentToken module_name ident_name) = module_name+++"@"+++ident_name
toString GenericToken = "generic"
toString DeriveToken = "derive"
toString GenericOpenToken = "{|"
......@@ -1451,6 +1495,8 @@ where
equal_args_of_tokens (LetToken l1) (LetToken l2) = l1 == l2
equal_args_of_tokens (SeqLetToken l1) (SeqLetToken l2) = l1 == l2
equal_args_of_tokens (ErrorToken id1) (ErrorToken id2) = id1 == id2
equal_args_of_tokens (QualifiedIdentToken module_name1 ident_name1) (QualifiedIdentToken module_name2 ident_name2)
= ident_name1==ident_name2 && module_name1==module_name2
equal_args_of_tokens _ _ = True
/* Sjaak ... */
......
frontend/syntax.dcl
View file @ 6af73849
......@@ -48,10 +48,11 @@ instance == FunctionOrMacroIndex
| STE_TypeVariable !TypeVarInfoPtr
| STE_TypeAttribute !AttrVarInfoPtr
| STE_BoundTypeVariable !STE_BoundTypeVariable
| STE_Imported !STE_Kind !Index
| STE_Imported !STE_Kind !ModuleN
| STE_DclFunction
| STE_Module !(Module (CollectedDefinitions ClassInstance IndexRange))
| STE_ClosedModule
| STE_ModuleQualifiedImports !SortedQualifiedImports
| STE_Empty
/* for creating class dictionaries */
| STE_DictType !CheckedTypeDef
......@@ -64,14 +65,19 @@ instance == FunctionOrMacroIndex
the "actual" dcl module.
*/
| STE_BelongingSymbol !Int
| STE_ExplImpSymbolNotImported !ModuleN