Skip to content
GitLab
Commit 0469f825 authored by John van Groningen's avatar John van Groningen
Browse files

add qualified import of a module, for functions, macros, constructors, types and classes

parent 11e4b162
Hide whitespace changes
Inline Side-by-side
frontend/hashtable.dcl
View file @ 0469f825
......@@ -18,7 +18,7 @@ set_hte_mark :: !Int !*HashTable -> *HashTable
| IC_Type
| IC_TypeAttr
| IC_Class
| IC_Module
| IC_Module !QualifiedIdents
| IC_Field !Ident
| IC_Selector
| IC_Instance ![Type]
......@@ -26,9 +26,15 @@ set_hte_mark :: !Int !*HashTable -> *HashTable
| IC_GenericCase !Type
| IC_Unknown
:: QualifiedIdents = QualifiedIdents !Ident !IdentClass !QualifiedIdents
| NoQualifiedIdents;
:: BoxedIdent = {boxed_ident::!Ident}
putIdentInHashTable :: !String !IdentClass !*HashTable -> (!BoxedIdent, !*HashTable)
putQualifiedIdentInHashTable :: !String !BoxedIdent !IdentClass !*HashTable -> (!BoxedIdent, !*HashTable)
putPredefinedIdentInHashTable :: !Ident !IdentClass !*HashTable -> *HashTable
get_qualified_idents_from_hash_table :: !Ident !*HashTable -> (!QualifiedIdents,!*HashTable)
remove_icl_symbols_from_hash_table :: !*HashTable -> *HashTable
frontend/hashtable.icl
View file @ 0469f825
......@@ -16,7 +16,7 @@ import predef, syntax, StdCompare, compare_constructor
| IC_Type
| IC_TypeAttr
| IC_Class
| IC_Module
| IC_Module !QualifiedIdents
| IC_Field !Ident
| IC_Selector
| IC_Instance ![Type]
......@@ -24,6 +24,9 @@ import predef, syntax, StdCompare, compare_constructor
| IC_GenericCase !Type
| IC_Unknown
:: QualifiedIdents = QualifiedIdents !Ident !IdentClass !QualifiedIdents
| NoQualifiedIdents;
:: BoxedIdent = {boxed_ident::!Ident}
newHashTable :: !*SymbolTable -> *HashTable
......@@ -89,7 +92,7 @@ putIdentInHashTable name ident_class {hte_symbol_heap,hte_entries,hte_mark}
# hash_val = hashValue name
(entries,hte_entries) = replace hte_entries hash_val HTE_Empty
(ident, hte_symbol_heap, entries) = insert name ident_class hte_mark hte_symbol_heap entries
hte_entries = update hte_entries hash_val entries
hte_entries = {hte_entries & [hash_val]=entries}
= (ident, { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries,hte_mark=hte_mark })
where
insert :: !String !IdentClass !Int !*SymbolTable *HashTableEntry -> (!BoxedIdent, !*SymbolTable, !*HashTableEntry)
......@@ -98,7 +101,7 @@ where
# ident = { id_name = name, id_info = hte_symbol_ptr}
# boxed_ident={boxed_ident=ident}
= (boxed_ident, hte_symbol_heap, HTE_Ident boxed_ident ident_class hte_mark0 HTE_Empty HTE_Empty)
insert name ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{boxed_ident={id_name,id_info}} hte_class hte_mark hte_left hte_right)
insert name ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{boxed_ident={id_name}} hte_class hte_mark hte_left hte_right)
# cmp = (name,ident_class) =< (id_name,hte_class)
| cmp == Equal
= (hte_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class (hte_mark bitand hte_mark0) hte_left hte_right)
......@@ -108,6 +111,33 @@ where
#! (boxed_ident, hte_symbol_heap, hte_right) = insert name ident_class hte_mark0 hte_symbol_heap hte_right
= (boxed_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
putQualifiedIdentInHashTable :: !String !BoxedIdent !IdentClass !*HashTable -> (!BoxedIdent, !*HashTable)
putQualifiedIdentInHashTable module_name ident ident_class {hte_symbol_heap,hte_entries,hte_mark}
# hash_val = hashValue module_name
(entries,hte_entries) = replace hte_entries hash_val HTE_Empty
(ident, hte_symbol_heap, entries) = insert module_name ident ident_class (IC_Module NoQualifiedIdents) hte_mark hte_symbol_heap entries
hte_entries = update hte_entries hash_val entries
= (ident, { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries,hte_mark=hte_mark })
where
insert :: !String !BoxedIdent !IdentClass !IdentClass !Int !*SymbolTable *HashTableEntry -> (!BoxedIdent, !*SymbolTable, !*HashTableEntry)
insert module_name ident ident_class module_ident_class hte_mark0 hte_symbol_heap HTE_Empty
# (hte_symbol_ptr, hte_symbol_heap) = newPtr EmptySymbolTableEntry hte_symbol_heap
# module_ident = { id_name = module_name, id_info = hte_symbol_ptr}
# boxed_module_ident={boxed_ident=module_ident}
# ident_class = IC_Module (QualifiedIdents ident.boxed_ident ident_class NoQualifiedIdents)
= (boxed_module_ident, hte_symbol_heap, HTE_Ident boxed_module_ident ident_class hte_mark0 HTE_Empty HTE_Empty)
insert module_name ident ident_class module_ident_class hte_mark0 hte_symbol_heap (HTE_Ident hte_ident=:{boxed_ident={id_name}} hte_class hte_mark hte_left hte_right)
# cmp = (module_name,module_ident_class) =< (id_name,hte_class)
| cmp == Equal
# (IC_Module qualified_idents) = hte_class
qualified_idents = QualifiedIdents ident.boxed_ident ident_class qualified_idents
= (hte_ident, hte_symbol_heap, HTE_Ident hte_ident (IC_Module qualified_idents) (hte_mark bitand hte_mark0) hte_left hte_right)
| cmp == Smaller
#! (boxed_ident, hte_symbol_heap, hte_left) = insert module_name ident ident_class module_ident_class hte_mark0 hte_symbol_heap hte_left
= (boxed_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
#! (boxed_ident, hte_symbol_heap, hte_right) = insert module_name ident ident_class module_ident_class hte_mark0 hte_symbol_heap hte_right
= (boxed_ident, hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
putPredefinedIdentInHashTable :: !Ident !IdentClass !*HashTable -> *HashTable
putPredefinedIdentInHashTable predefined_ident=:{id_name} ident_class {hte_symbol_heap,hte_entries,hte_mark}
# hash_val = hashValue id_name
......@@ -131,6 +161,26 @@ where
#! (hte_symbol_heap, hte_right) = insert name ident_class hte_mark0 hte_symbol_heap hte_right
= (hte_symbol_heap, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
get_qualified_idents_from_hash_table :: !Ident !*HashTable -> (!QualifiedIdents,!*HashTable)
get_qualified_idents_from_hash_table module_ident=:{id_name} hash_table=:{hte_entries}
# hash_val = hashValue id_name
(entries,hte_entries) = replace hte_entries hash_val HTE_Empty
(qualified_idents, entries) = find_qualified_idents id_name (IC_Module NoQualifiedIdents) entries
hte_entries = update hte_entries hash_val entries
= (qualified_idents, {hash_table & hte_entries = hte_entries})
where
find_qualified_idents :: !String !IdentClass *HashTableEntry -> (!QualifiedIdents, !*HashTableEntry)
find_qualified_idents module_name module_ident_class hte=:(HTE_Ident hte_ident=:{boxed_ident={id_name}} hte_class hte_mark hte_left hte_right)
# cmp = (module_name,module_ident_class) =< (id_name,hte_class)
| cmp == Equal
# (IC_Module qualified_idents) = hte_class
= (qualified_idents, hte)
| cmp == Smaller
#! (qualified_idents, hte_left) = find_qualified_idents module_name module_ident_class hte_left
= (qualified_idents, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
#! (qualified_idents, hte_right) = find_qualified_idents module_name module_ident_class hte_right
= (qualified_idents, HTE_Ident hte_ident hte_class hte_mark hte_left hte_right)
remove_icl_symbols_from_hash_table :: !*HashTable -> *HashTable
remove_icl_symbols_from_hash_table hash_table=:{hte_entries}
# hte_entries=remove_icl_symbols_from_array 0 hte_entries
......
frontend/parse.icl
View file @ 0469f825
......@@ -116,6 +116,16 @@ makeTupleTypeSymbol form_arity act_arity
class try a :: !Token !*ParseState -> (!Optional a, !*ParseState)
class want a :: !*ParseState -> (!a, !*ParseState)
stringToQualifiedModuleIdent module_name ident_name ident_class pState :== (ident,parse_state)
where
({boxed_ident=ident},parse_state) = stringToQualifiedModuleBoxedIdent module_name ident_name ident_class pState
stringToQualifiedModuleBoxedIdent :: !String !String !IdentClass !*ParseState -> (!BoxedIdent, !*ParseState)
stringToQualifiedModuleBoxedIdent module_name ident_name ident_class pState=:{ps_hash_table}
# (ident, ps_hash_table) = putIdentInHashTable ident_name ident_class ps_hash_table
# (module_ident, ps_hash_table) = putQualifiedIdentInHashTable module_name ident ident_class ps_hash_table
= (module_ident, {pState & ps_hash_table = ps_hash_table})
stringToIdent s i p :== (ident,parse_state)
where
({boxed_ident=ident},parse_state) = stringToBoxedIdent s i p
......@@ -209,16 +219,6 @@ wantList msg try_fun pState :== want_list msg pState // try_fun +
# (token, pState) = nextToken GeneralContext pState
= ([tree], parseError ("wantList of "+msg) (Yes token) msg pState)
wantModuleIdents :: !ScanContext !IdentClass !ParseState -> (![Ident], !ParseState)
wantModuleIdents scanContext ident_class pState
# (first_name, pState) = wantModuleName pState
(first_ident, pState) = stringToIdent first_name ident_class pState
(token, pState) = nextToken scanContext pState
| token == CommaToken
# (rest, pState) = wantModuleIdents scanContext ident_class pState
= ([first_ident : rest], pState)
= ([first_ident], tokenBack pState)
optionalPriority :: !Bool !Token !ParseState -> (Priority, !ParseState)
optionalPriority isinfix (PriorityToken prio) pState
= (prio, pState)
......@@ -293,7 +293,7 @@ where
, ps_hash_table = hash_table
}
pState = verify_name mod_name id_name file_name pState
(mod_ident, pState) = stringToIdent mod_name IC_Module pState
(mod_ident, pState) = stringToIdent mod_name (IC_Module NoQualifiedIdents) pState
pState = check_layout_rule pState
(defs, pState) = want_definitions (SetGlobalContext iclmodule) pState
{ps_scanState,ps_hash_table,ps_error,ps_flags}
......@@ -628,7 +628,7 @@ where
//# pState = wantToken FunctionContext "type argument" GenericCloseToken pState
# (args, pState) = parseList trySimpleLhsExpression pState
# args = [geninfo_arg : args]
// must be EqualToken or HashToken or ???
//# pState = wantToken FunctionContext "generic definition" EqualToken pState
//# pState = tokenBack pState
......@@ -636,7 +636,7 @@ where
# (ss_useLayout, pState) = accScanState UseLayout pState
# localsExpected = isNotEmpty args || isGlobalContext parseContext || ~ ss_useLayout
# (rhs, _, pState) = wantRhs localsExpected (ruleDefiningRhsSymbol parseContext) pState
# generic_case =
{ gc_ident = ident
, gc_gident = generic_ident
......@@ -1079,17 +1079,27 @@ wantLocals pState
wantImports :: !ParseState -> (![ParsedImport], !ParseState)
wantImports pState
# (names, pState) = wantModuleIdents FunctionContext IC_Module pState
(file_name, line_nr, pState) = getFileAndLineNr pState
# (imports, pState) = wantModuleImports FunctionContext (IC_Module NoQualifiedIdents) pState
pState = wantEndOfDefinition "imports" pState
= (imports, pState)
wantModuleImports :: !ScanContext !IdentClass !ParseState -> (![Import], !ParseState)
wantModuleImports scanContext ident_class pState
# (import_qualified, first_name, pState) = wantOptionalQualifiedAndModuleName pState
(first_ident, pState) = stringToIdent first_name ident_class pState
(file_name, line_nr, pState) = getFileAndLineNr pState
position = LinePos file_name line_nr
= ([ { import_module = name, import_symbols = [], import_file_position = position, import_qualified = NotQualified }
\\ name<-names], pState)
module_import = {import_module = first_ident, import_symbols = [], import_file_position = position, import_qualified = import_qualified}
(token, pState) = nextToken scanContext pState
| token == CommaToken
# (rest, pState) = wantModuleImports scanContext ident_class pState
= ([module_import : rest], pState)
= ([module_import], tokenBack pState)
wantFromImports :: !ParseState -> (!ParsedImport, !ParseState)
wantFromImports pState
# (mod_name, pState) = wantModuleName pState
(mod_ident, pState) = stringToIdent mod_name IC_Module pState
(mod_ident, pState) = stringToIdent mod_name (IC_Module NoQualifiedIdents) pState
pState = wantToken GeneralContext "from imports" ImportToken pState
(file_name, line_nr, pState) = getFileAndLineNr pState
(token, pState) = nextToken GeneralContext pState
......@@ -1323,15 +1333,7 @@ wantInstanceDeclaration parseContext pi_pos pState
(pi_class, pState) = stringToIdent class_name IC_Class pState
((pi_types, pi_context), pState) = want_instance_type pState
(pi_ident, pState) = stringToIdent class_name (IC_Instance pi_types) pState
// AA..
# (token, pState) = nextToken TypeContext pState
/*
| token == GenericToken
# pState = wantEndOfDefinition "generic instance declaration" pState
= (PD_Instance {pi_class = pi_class, pi_ident = pi_ident, pi_types = pi_types, pi_context = pi_context,
pi_members = [], pi_specials = SP_None, pi_pos = pi_pos}, pState)
*/
// ..AA
| isIclContext parseContext
# pState = want_begin_group token pState
(pi_members, pState) = wantDefinitions (SetClassOrInstanceDefsContext parseContext) pState
......@@ -1344,7 +1346,6 @@ wantInstanceDeclaration parseContext pi_pos pState
# (pi_types_and_contexts, pState) = want_instance_types pState
(idents, pState) = seqList [stringToIdent class_name (IC_Instance type) \\ (type,context) <- pi_types_and_contexts] pState
= (PD_Instances
// [ { pi_class = pi_class, pi_ident = pi_ident, pi_types = type, pi_context = context // voor martin
[ { pi_class = pi_class, pi_ident = ident, pi_types = type, pi_context = context
, pi_members = [], pi_specials = SP_None, pi_pos = pi_pos}
\\ (type,context) <- [ (pi_types, pi_context) : pi_types_and_contexts ]
......@@ -1379,7 +1380,6 @@ where
want_instance_type pState
# (pi_types, pState) = wantList "instance types" tryBrackType pState
// # (pi_types, pState) = wantList "instance types" tryType pState // This accepts 1.3 syntax, but is wrong for multiparameter classes
(pi_context, pState) = optionalContext pState
= ((pi_types, pi_context), pState)
want_instance_types pState
......@@ -1457,7 +1457,7 @@ where
# class_global_ds = { glob_object = MakeDefinedSymbol ident NoIndex (-1), glob_module = NoIndex }
-> (True, TCClass class_global_ds, pState)
QualifiedIdentToken module_name ident_name
# (module_ident, pState) = stringToIdent module_name IC_Module pState
# (module_ident, pState) = stringToQualifiedModuleIdent module_name ident_name IC_Class pState
-> (True, TCQualifiedIdent module_ident ident_name, pState)
_
-> (False, abort "no tc_class", tokenBack pState)
......@@ -1564,6 +1564,7 @@ where
= case token of
IdentToken name -> (name, pState)
_ -> ("", parseError "Generic Definition" (Yes token) "<identifier>" pState)
want_derive_types :: String !*ParseState -> ([GenericCaseDef], !*ParseState)
want_derive_types name pState
# (derive_def, pState) = want_derive_type name pState
......@@ -1572,7 +1573,7 @@ where
# (derive_defs, pState) = want_derive_types name pState
= ([derive_def:derive_defs], pState)
= ([derive_def], pState)
want_derive_type :: String !*ParseState -> (GenericCaseDef, !*ParseState)
want_derive_type name pState
# (type, pState) = wantType pState
......@@ -1653,7 +1654,7 @@ where
want_type_lhs pos pState
# (_, annot, attr, pState) = optionalAnnotAndAttr pState
(name, pState) = wantConstructorName "Type name" pState
(ident, pState) = stringToIdent name IC_Type pState // -->> ("Type name",name)
(ident, pState) = stringToIdent name IC_Type pState
(args, pState) = parseList tryAttributedTypeVar pState
= (MakeTypeDef ident args (ConsList []) attr pos, annot, pState)
......@@ -2450,7 +2451,7 @@ trySimpleTypeT StringTypeToken attr pState
= (True, {at_attribute = attr, at_type = type}, pState)
trySimpleTypeT (QualifiedIdentToken module_name ident_name) attr pState
| not (isLowerCaseName ident_name)
# (module_id, pState) = stringToIdent module_name IC_Module pState
# (module_id, pState) = stringToQualifiedModuleIdent module_name ident_name IC_Type pState
# type = TQualifiedIdent module_id ident_name []
= (True, {at_attribute = attr, at_type = type}, pState)
trySimpleTypeT token attr pState
......@@ -2729,9 +2730,9 @@ where
want_selector (QualifiedIdentToken module_name ident_name) pState
| isUpperCaseName ident_name
# pState = wantToken FunctionContext "record selector" DotToken pState
(module_id, pState) = stringToIdent module_name IC_Module pState
(module_id, pState) = stringToQualifiedModuleIdent module_name ident_name IC_Type pState
= want_field_after_record_type (RecordNameQualifiedIdent module_id ident_name) pState
# (module_id, pState) = stringToIdent module_name IC_Module pState
# (module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState
= ([PS_QualifiedRecord module_id ident_name NoRecordName], pState)
want_selector token pState
= ([PS_Erroneous], parseError "simple RHS expression" (Yes token) "<selector>" pState)
......@@ -2745,7 +2746,7 @@ where
-> ([PS_Record selector_id record_name], pState)
QualifiedIdentToken module_name field_name
| isLowerCaseName field_name
# (module_id, pState) = stringToIdent module_name IC_Module pState
# (module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState
-> ([PS_QualifiedRecord module_id field_name record_name], pState)
_
-> ([PS_Erroneous], parseError "record field" (Yes token) "lower case ident" pState)
......@@ -2851,7 +2852,7 @@ trySimpleExpressionT (RealToken real) is_pattern pState
= (True, PE_Basic (BVR real), pState)
trySimpleExpressionT (QualifiedIdentToken module_name ident_name) is_pattern pState
| not is_pattern || not (isLowerCaseName ident_name)
# (module_id, pState) = stringToIdent module_name IC_Module pState
# (module_id, pState) = stringToQualifiedModuleIdent module_name ident_name IC_Expression pState
= (True, PE_QualifiedIdent module_id ident_name, pState)
trySimpleExpressionT token is_pattern pState
| is_pattern
......@@ -3419,7 +3420,7 @@ where
want_record_pattern (QualifiedIdentToken module_name record_name) pState
| isUpperCaseName record_name
# pState = wantToken FunctionContext "record pattern" BarToken pState
(module_id, pState) = stringToIdent module_name IC_Module pState
(module_id, pState) = stringToQualifiedModuleIdent module_name record_name IC_Type pState
(token, pState) = nextToken FunctionContext pState
(fields, pState) = want_field_assignments cIsAPattern token pState
= (PE_Record PE_Empty (RecordNameQualifiedIdent module_id record_name) fields, wantToken FunctionContext "record pattern" CurlyCloseToken pState)
......@@ -3439,7 +3440,7 @@ where
| isUpperCaseName record_name || isFunnyIdName record_name
# (token, pState) = nextToken FunctionContext pState
| token == BarToken
# (module_ident, pState) = stringToIdent module_name IC_Module pState
# (module_ident, pState) = stringToQualifiedModuleIdent module_name record_name IC_Type pState
= (RecordNameQualifiedIdent module_ident record_name, pState)
= (NoRecordName, tokenBack pState)
= (NoRecordName, pState)
......@@ -3656,7 +3657,7 @@ want_field_assignments is_pattern token=:(IdentToken field_name) pState
= want_more_field_assignments (FieldName field_id) is_pattern pState
want_field_assignments is_pattern token=:(QualifiedIdentToken module_name field_name) pState
| isLowerCaseName field_name
# (module_id, pState) = stringToIdent module_name IC_Module pState
# (module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState
= want_more_field_assignments (QualifiedFieldName module_id field_name) is_pattern pState
want_field_assignments is_pattern token pState
= ([], parseError "record or array field assignments" (Yes token) "field name" pState)
......@@ -3685,7 +3686,7 @@ try_field_assignment (QualifiedIdentToken module_name field_name) pState
# (token, pState) = nextToken FunctionContext pState
| token == EqualToken
# (field_expr, pState) = wantExpression cIsNotAPattern pState
(module_id, pState) = stringToIdent module_name IC_Module pState
(module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState
= (True, { bind_src = field_expr, bind_dst = QualifiedFieldName module_id field_name}, pState)
= (False, abort "no field", tokenBack pState)
= (False, abort "no field", pState)
......@@ -4180,6 +4181,30 @@ wantModuleName pState
UnderscoreIdentToken name -> (name, pState)
_ -> ("", parseError "String" (Yes token) "module name" pState)
wantOptionalQualifiedAndModuleName :: !*ParseState -> (!ImportQualified,!{#Char},!*ParseState)
wantOptionalQualifiedAndModuleName pState
# (token, pState) = nextToken GeneralContext pState
= case token of
IdentToken name1=:"qualified"
# (token, pState) = nextToken GeneralContext pState
-> case token of
IdentToken name
-> (Qualified, name, pState)
UnderscoreIdentToken name
-> (Qualified, name, pState)
QualifiedIdentToken module_dname module_fname
-> (Qualified, module_dname+++"."+++module_fname, pState)
_
-> (NotQualified, name1, tokenBack pState)
IdentToken name
-> (NotQualified, name, pState)
UnderscoreIdentToken name
-> (NotQualified, name, pState)
QualifiedIdentToken module_dname module_fname
-> (NotQualified, module_dname+++"."+++module_fname, pState)
_
-> (NotQualified, "", parseError "String" (Yes token) "module name" pState)
tryTypeVar :: !ParseState -> (!Bool, TypeVar, !ParseState)
tryTypeVar pState
# (token, pState) = nextToken TypeContext pState
......
frontend/postparse.icl
View file @ 0469f825
......@@ -94,13 +94,10 @@ where
addFunctionsRange :: [FunDef] *CollectAdmin -> (IndexRange, *CollectAdmin)
addFunctionsRange fun_defs ca
# (frm, ca)
= ca!ca_fun_count
ca
= foldSt add_function fun_defs ca
(to, ca)
= ca!ca_fun_count
= ({ir_from = frm, ir_to = to}, ca)
# (frm, ca) = ca!ca_fun_count
ca = foldSt add_function fun_defs ca
(to, ca) = ca!ca_fun_count
= ({ir_from = frm, ir_to = to}, ca)
where
add_function :: FunDef !*CollectAdmin -> *CollectAdmin
add_function fun_def ca=:{ca_fun_count, ca_rev_fun_defs}
......@@ -964,24 +961,6 @@ makeComprehensions [{tq_generators,tq_let_defs,tq_filter, tq_end, tq_call, tq_lh
, {calt_pattern = PE_WildCard, calt_rhs = exprToRhs default_rhs, calt_position=NoPos}
])
/* +++ remove code duplication (bug in 2.0 with nested cases)
case_end :: TransformedGenerator Rhs -> Rhs
case_end {tg_case1, tg_case_end_expr, tg_case_end_pattern} rhs
= single_case tg_case1 tg_case_end_expr tg_case_end_pattern rhs
case_pattern :: TransformedGenerator Rhs -> Rhs
case_pattern {tg_case2, tg_element, tg_pattern} rhs
= single_case tg_case2 tg_element tg_pattern rhs
*/
/*
single_case :: Ident ParsedExpr ParsedExpr Rhs -> Rhs
single_case case_ident expr pattern rhs
= exprToRhs (PE_Case case_ident expr
[ {calt_pattern = pattern, calt_rhs = rhs}
])
*/
transformSequence :: Sequence -> ParsedExpr
transformSequence (SQ_FromThen pd_from_then frm then)
= predef_ident_expr pd_from_then ` frm ` then
......@@ -1450,6 +1429,8 @@ reorganiseDefinitions icl_module [PD_Derive derive_defs : defs] cons_count sel_c
#! c_defs = { c_defs & def_generic_cases = derive_defs ++ c_defs.def_generic_cases}
= (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca)
reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_count mem_count type_count ca
# (new_imports,hash_table) = make_implicit_qualified_imports_explicit new_imports ca.ca_hash_table
# ca = {ca & ca_hash_table=hash_table}
# (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca
= (fun_defs, c_defs, new_imports ++ imports, imported_objects,foreign_exports, ca)
reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count type_count ca
......@@ -1465,6 +1446,31 @@ reorganiseDefinitions icl_module [] _ _ _ _ ca
def_instances = [], def_funtypes = [],
def_generics = [], def_generic_cases = []}, [], [], [], ca)
make_implicit_qualified_imports_explicit [import_=:{import_qualified=Qualified,import_symbols=[],import_module,import_file_position}:imports] hash_table
# (qualified_idents,hash_table) = get_qualified_idents_from_hash_table import_module hash_table
# import_declarations = qualified_idents_to_import_declarations qualified_idents
# (imports,hash_table) = make_implicit_qualified_imports_explicit imports hash_table
= ([{import_ & import_symbols=import_declarations}:imports],hash_table)
make_implicit_qualified_imports_explicit [import_:imports] hash_table
# (imports,hash_table) = make_implicit_qualified_imports_explicit imports hash_table
= ([import_:imports],hash_table)
make_implicit_qualified_imports_explicit [] hash_table
= ([],hash_table)
qualified_idents_to_import_declarations (QualifiedIdents ident ident_class qualified_idents)
= [qualified_ident_to_import_declaration ident_class ident : qualified_idents_to_import_declarations qualified_idents]
qualified_idents_to_import_declarations NoQualifiedIdents
= []
qualified_ident_to_import_declaration IC_Expression ident
= ID_Function ident
qualified_ident_to_import_declaration IC_Type ident
= ID_Type ident No
qualified_ident_to_import_declaration IC_Class ident
= ID_Class ident No
qualified_ident_to_import_declaration IC_Selector ident
= abort "qualified_ident_to_import_declaration IC_Selector not yet implemented"
reorganiseDefinitionsAndAddTypes mod_ident support_dynamics icl_module defs ca
| support_dynamics
# clean_types_module_ident
......
frontend/predef.icl
View file @ 0469f825
......@@ -188,7 +188,6 @@ predefined_idents
[PD_Start] = i "Start",
[PD_FromS]= i "_from_s",
[PD_FromTS]= i "_from_ts",
[PD_FromSTS]= i "_from_sts",
......@@ -305,9 +304,9 @@ where
fill_table_with_hashing hash_table
# hash_table = hash_table
<<- (local_predefined_idents, IC_Module, PD_StdArray)
<<- (local_predefined_idents, IC_Module, PD_StdEnum)
<<- (local_predefined_idents, IC_Module, PD_StdBool)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdArray)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdEnum)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdBool)
<<- (local_predefined_idents, IC_Expression, PD_AndOp)
<<- (local_predefined_idents, IC_Expression, PD_OrOp)
<<- (local_predefined_idents, IC_Class, PD_ArrayClass)
......@@ -320,7 +319,7 @@ where
<<- (local_predefined_idents, IC_Expression, PD_ArraySizeFun)
<<- (local_predefined_idents, IC_Expression, PD_UnqArraySizeFun)
<<- (local_predefined_idents, IC_Module, PD_StdStrictLists)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdStrictLists)
# hash_table = put_predefined_idents_in_hash_table PD_cons PD_nil_uts IC_Expression local_predefined_idents hash_table
<<- (local_predefined_idents, IC_Class, PD_ListClass)
<<- (local_predefined_idents, IC_Class, PD_UListClass)
......@@ -338,7 +337,7 @@ where
<<- (local_predefined_idents, IC_Class, PD_TypeCodeClass)
<<- (local_predefined_idents, IC_Module, PD_StdDynamic)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdDynamic)
<<- (local_predefined_idents, IC_Type, PD_Dyn_DynamicTemp)
<<- (local_predefined_idents, IC_Type, PD_Dyn_TypeCode)
......@@ -346,7 +345,7 @@ where
# hash_table = put_predefined_idents_in_hash_table PD_Dyn_TypeScheme PD_Dyn_TypeCodeConstructor_UnboxedArray IC_Expression local_predefined_idents hash_table
<<- (local_predefined_idents, IC_Expression, PD_Dyn__to_TypeCodeConstructor)
<<- (local_predefined_idents, IC_Module, PD_StdGeneric)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdGeneric)
# hash_table = put_predefined_idents_in_hash_table PD_TypeBimap PD_TypeGenericDict IC_Type local_predefined_idents hash_table
# hash_table = put_predefined_idents_in_hash_table PD_ConsBimap PD_bimapId IC_Expression local_predefined_idents hash_table
<<- (local_predefined_idents, IC_Generic, PD_GenericBimap)
......@@ -355,12 +354,12 @@ where
<<- (local_predefined_idents, IC_Field bimap_type, PD_map_to)
<<- (local_predefined_idents, IC_Field bimap_type, PD_map_from)
<<- (local_predefined_idents, IC_Module, PD_StdMisc)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_StdMisc)
<<- (local_predefined_idents, IC_Expression, PD_abort)
<<- (local_predefined_idents, IC_Expression, PD_undef)
<<- (local_predefined_idents, IC_Module, PD_CleanTypes)
<<- (local_predefined_idents, IC_Module NoQualifiedIdents, PD_CleanTypes)
<<- (local_predefined_idents, IC_Type, PD_CTTypeDef)
<<- (local_predefined_idents, IC_Expression, PD_CTAlgType)
......@@ -483,13 +482,13 @@ where
tc_member_name = predefined_idents.[PD_TypeCodeMember]
class_var = MakeTypeVar type_var_ident
me_type = { st_vars = [], st_args = [], st_args_strictness=NotStrict, st_arity = 0,
st_result = { at_attribute = TA_None, at_type = TV class_var },
st_context = [ {tc_class = TCClass {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name, ds_arity = 1, ds_index = NoIndex }},
tc_types = [ TV class_var ], tc_var = nilPtr}],
st_attr_vars = [], st_attr_env = [] }
tc_member_def = { me_ident = tc_member_name, me_type = me_type, me_pos = NoPos, me_priority = NoPrio,
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
......
main/compile.icl
View file @ 0469f825
......@@ -262,7 +262,7 @@ compileModule options backendArgs cache=:{dcl_modules,functions_and_macros,prede
= (False, cache, files)
# (io, files)
= stdio files
# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName IC_Module hash_table
# ({boxed_ident=moduleIdent}, hash_table) = putIdentInHashTable options.moduleName (IC_Module NoQualifiedIdents) hash_table
# list_inferred_types
= if (options.listTypes.lto_listTypesKind == ListTypesInferred)
(Yes options.listTypes.lto_showAttributes)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment