aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/check.dcl2
-rw-r--r--frontend/check.icl16
-rw-r--r--frontend/checksupport.dcl4
-rw-r--r--frontend/parse.icl23
-rw-r--r--frontend/postparse.icl6
-rw-r--r--frontend/syntax.dcl13
6 files changed, 46 insertions, 18 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl
index c46be57..f45ddb7 100644
--- a/frontend/check.dcl
+++ b/frontend/check.dcl
@@ -11,7 +11,7 @@ checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo
checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
-checkForeignExportedFunctionTypes :: !*ErrorAdmin ![Int] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
+checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin
-> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin)
diff --git a/frontend/check.icl b/frontend/check.icl
index 9e0f4a4..6ffd88f 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -2522,7 +2522,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional
fill_macro_def_array i [dcl_macro_defs:macro_defs] a
= fill_macro_def_array (i+1) macro_defs {a & [i]=dcl_macro_defs}
-check_module2 :: Bool Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [IdentPos] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int
+check_module2 :: Bool Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [ParsedForeignExport] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int
(Optional (Module a)) [Declaration] *{#FunDef} *{#*{#FunDef}} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange)
*{#.Int} *Heaps *CheckState
-> (!Bool,.IclModule,!.{#DclModule},.{!Group},!*{#*{#FunDef}},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File,[String]);
@@ -2855,8 +2855,8 @@ check_module2 support_dynamics mod_ident mod_modification_time mod_imported_obje
-> ( popErrorAdmin cs_error, type_heaps)
= (icl_functions, type_heaps, cs_error)
-checkForeignExports :: [IdentPos] [IndexRange] *{#FunDef} *CheckState -> (![Int],!*{#FunDef},!*CheckState)
-checkForeignExports [ident_pos=:{ip_ident={id_name,id_info}}:foreign_exports] icl_global_functions_ranges fun_defs cs
+checkForeignExports :: [ParsedForeignExport] [IndexRange] *{#FunDef} *CheckState -> (![ForeignExport],!*{#FunDef},!*CheckState)
+checkForeignExports [{pfe_ident=pfe_ident=:{id_name,id_info},pfe_line,pfe_file,pfe_stdcall}:foreign_exports] icl_global_functions_ranges fun_defs cs
# ({ste_kind,ste_index},cs_symbol_table) = readPtr id_info cs.cs_symbol_table
# cs = { cs & cs_symbol_table = cs_symbol_table }
# (foreign_export_fundef_index,fun_defs,cs) = check_foreign_export ste_kind icl_global_functions_ranges fun_defs cs
@@ -2872,20 +2872,22 @@ checkForeignExports [ident_pos=:{ip_ident={id_name,id_info}}:foreign_exports] ic
-> ([],{cs & cs_error = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in type of foreign exported function (context not allowed)" cs.cs_error})
| not (first_n_are_strict st_arity st_args_strictness)
-> ([],{cs & cs_error = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in type of foreign exported function (strictness annotation missing)" cs.cs_error})
- -> ([ste_index],cs)
+ -> ([{fe_fd_index=ste_index,fe_stdcall=pfe_stdcall}],cs)
= (foreign_export_fundef_index,fun_defs,cs)
check_foreign_export (STE_FunctionOrMacro _) [_,{ir_from, ir_to}:_] fun_defs cs
| ste_index>=ir_from && ste_index<ir_to
+ # ident_pos = { ip_ident=pfe_ident,ip_line=pfe_line,ip_file=pfe_file }
= ([],fun_defs,{cs & cs_error = checkErrorWithIdentPos ident_pos "has not been exported" cs.cs_error})
check_foreign_export _ _ fun_defs cs
+ # ident_pos = { ip_ident=pfe_ident,ip_line=pfe_line,ip_file=pfe_file }
= ([],fun_defs,{cs & cs_error = checkErrorWithIdentPos ident_pos "has not been declared" cs.cs_error})
# (foreign_export_fundef_indexes,fun_defs,cs) = checkForeignExports foreign_exports icl_global_functions_ranges fun_defs cs
= (foreign_export_fundef_index++foreign_export_fundef_indexes,fun_defs,cs)
checkForeignExports [] icl_global_functions_ranges fun_defs cs
= ([],fun_defs,cs)
-checkForeignExportedFunctionTypes :: !*ErrorAdmin ![Int] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
-checkForeignExportedFunctionTypes error_admin [fun_def_index:icl_foreign_exports] fun_defs
+checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
+checkForeignExportedFunctionTypes error_admin [{fe_fd_index}:icl_foreign_exports] fun_defs
# error_admin = if (check_foreign_export_type st_result.at_type)
error_admin
(checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in result type for foreign exported function" error_admin)
@@ -2894,7 +2896,7 @@ checkForeignExportedFunctionTypes error_admin [fun_def_index:icl_foreign_exports
(checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in argument type for foreign exported function" error_admin)
= checkForeignExportedFunctionTypes error_admin icl_foreign_exports fun_defs2
where
- ({fun_type=Yes {st_args,st_result},fun_ident,fun_pos},fun_defs2) = fun_defs![fun_def_index]
+ ({fun_type=Yes {st_args,st_result},fun_ident,fun_pos},fun_defs2) = fun_defs![fe_fd_index]
check_foreign_export_types [{at_type}:argument_types]
= check_foreign_export_type at_type && check_foreign_export_types argument_types
diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl
index 260ec66..6bcb119 100644
--- a/frontend/checksupport.dcl
+++ b/frontend/checksupport.dcl
@@ -100,12 +100,14 @@ cConversionTableSize :== 10
, icl_common :: !.CommonDefs
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject]
- , icl_foreign_exports :: ![FunDefIndex]
+ , icl_foreign_exports :: ![ForeignExport]
, icl_used_module_numbers :: !NumberSet
, icl_copied_from_dcl :: !CopiedDefinitions
, icl_modification_time :: !{#Char}
}
+:: ForeignExport = {fe_fd_index :: !FunDefIndex, fe_stdcall :: !Bool}
+
:: DclModule =
{ dcl_name :: !Ident
, dcl_functions :: !{# FunType }
diff --git a/frontend/parse.icl b/frontend/parse.icl
index 1204a1e..b124307 100644
--- a/frontend/parse.icl
+++ b/frontend/parse.icl
@@ -676,11 +676,28 @@ where
# (token, pState) = nextToken FunctionContext pState
-> case token of
IdentToken function_name
- # pState = wantEndOfDefinition "foreign export" pState
- # (ident,pState) = stringToIdent function_name IC_Expression pState
- -> (True,PD_ForeignExport ident file_name line_nr,pState)
+ | function_name=="ccall"
+ # (token2, pState) = nextToken FunctionContext pState
+ -> case token2 of
+ IdentToken function_name
+ -> accept_foreign_export function_name line_nr False pState
+ _
+ -> accept_foreign_export function_name line_nr False (tokenBack pState)
+ | function_name=="stdcall"
+ # (token2, pState) = nextToken FunctionContext pState
+ -> case token2 of
+ IdentToken function_name
+ -> accept_foreign_export function_name line_nr True pState
+ _
+ -> accept_foreign_export function_name line_nr False (tokenBack pState)
+ -> accept_foreign_export function_name line_nr False pState
_
-> foreign_export_error "function name" pState
+ where
+ accept_foreign_export function_name line_nr stdcall pState
+ # pState = wantEndOfDefinition "foreign export" pState
+ # (ident,pState) = stringToIdent function_name IC_Expression pState
+ = (True,PD_ForeignExport ident file_name line_nr stdcall,pState)
_
-> foreign_export_error "export" pState
where
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index ef762ff..85d5d91 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -1241,7 +1241,7 @@ where
# (strictness_index,strictness,strictness_list) = add_next_not_strict strictness_index strictness strictness_list
= add_strictness_for_arguments fields strictness_index strictness strictness_list
-reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject],![IdentPos],!*CollectAdmin)
+reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject],![ParsedForeignExport],!*CollectAdmin)
reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count type_count ca
# prio = if is_infix (Prio NoAssoc 9) NoPrio
fun_arity = length args
@@ -1457,9 +1457,9 @@ reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_c
reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count type_count ca
# (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, imports, new_imported_objects ++ imported_objects,foreign_exports, ca)
-reorganiseDefinitions icl_module [PD_ForeignExport new_foreign_export file_name line_n : defs] cons_count sel_count mem_count type_count ca
+reorganiseDefinitions icl_module [PD_ForeignExport new_foreign_export file_name line_n stdcall : defs] cons_count sel_count mem_count type_count ca
# (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, imports, imported_objects,[{ip_ident=new_foreign_export,ip_file=file_name,ip_line=line_n}:foreign_exports], ca)
+ = (fun_defs, c_defs, imports, imported_objects,[{pfe_ident=new_foreign_export,pfe_file=file_name,pfe_line=line_n,pfe_stdcall=stdcall}:foreign_exports], ca)
reorganiseDefinitions icl_module [def:defs] _ _ _ _ ca
= abort ("reorganiseDefinitions does not match" ---> def)
reorganiseDefinitions icl_module [] _ _ _ _ ca
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 41eb1dd..e28c750 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -96,10 +96,17 @@ instance == FunctionOrMacroIndex
, mod_type :: !ModuleKind
, mod_imports :: ![ParsedImport]
, mod_imported_objects :: ![ImportedObject]
- , mod_foreign_exports :: ![IdentPos]
+ , mod_foreign_exports :: ![ParsedForeignExport]
, mod_defs :: !defs
}
+:: ParsedForeignExport =
+ { pfe_ident :: !Ident
+ , pfe_line :: !Int
+ , pfe_file :: !FileName
+ , pfe_stdcall :: !Bool
+ }
+
:: ParsedModule :== Module [ParsedDefinition]
:: ScannedModule :== Module (CollectedDefinitions (ParsedInstance FunDef) IndexRange)
@@ -175,7 +182,7 @@ cIsNotAFunction :== False
| PD_Instances [ParsedInstance ParsedDefinition]
| PD_Import [ParsedImport]
| PD_ImportedObjects [ImportedObject]
- | PD_ForeignExport !Ident !{#Char} !Int
+ | PD_ForeignExport !Ident !{#Char} !Int !Bool /* if stdcall */
| PD_Generic GenericDef // AA
| PD_GenericCase GenericCaseDef // AA
| PD_Derive [GenericCaseDef] // AA
@@ -1327,7 +1334,7 @@ instance == OverloadedListType
= CP_Expression !Expression
| CP_FunArg !Ident !Int // Function symbol, argument position (>=1)
| CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
-
+
:: IdentPos =
{ ip_ident :: !Ident
, ip_line :: !Int
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 23:00:16 +0000