Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
compiler
Commits
34dcba46
Commit
34dcba46
authored
Feb 15, 2000
by
Ronny Wichers Schreur
🏢
Browse files
bug fix (unboxed arrrays of records)
parent
1df1341a
Changes
12
Hide whitespace changes
Inline
Side-by-side
frontend/_aconcat.dcl
0 → 100644
View file @
34dcba46
system
module
_aconcat
import
_SystemArray
,
StdInt
,
StdEnum
,
StdList
arrayConcat
a1
a2
:==
r2
where
r2
={
r1
&
[
i
+
s1
]=
a2
.[
i
]
\\
i
<-[
0
..
s2
-1
]}
r1
={
r0
&
[
i
]=
a1
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
(
s1
+
s2
)
s1
=
size
a1
s2
=
size
a2
arrayPlusList
a
l
:==
r2
where
r2
={
r1
&
[
i
+
s1
]=
e
\\
i
<-[
0
..
s2
-1
]
&
e
<-
l
}
r1
={
r0
&
[
i
]=
a
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
(
s1
+
s2
)
s1
=
size
a
s2
=
length
l
arrayPlusRevList
a
l
:==
r2
where
r2
={
r1
&
[
sr
-
i
]=
e
\\
i
<-[
1
..
s2
]
&
e
<-
l
}
r1
={
r0
&
[
i
]=
a
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
sr
sr
=
s1
+
s2
s2
=
length
l
s1
=
size
a
frontend/_aconcat.icl
0 → 100644
View file @
34dcba46
implementation
module
_aconcat
import
_SystemArray
,
StdInt
,
StdEnum
,
StdList
arrayConcat
a1
a2
:==
r2
where
r2
={
r1
&
[
i
+
s1
]=
a2
.[
i
]
\\
i
<-[
0
..
s2
-1
]}
r1
={
r0
&
[
i
]=
a1
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
(
s1
+
s2
)
s1
=
size
a1
s2
=
size
a2
arrayPlusList
a
l
:==
r2
where
r2
={
r1
&
[
i
+
s1
]=
e
\\
i
<-[
0
..
s2
-1
]
&
e
<-
l
}
r1
={
r0
&
[
i
]=
a
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
(
s1
+
s2
)
s1
=
size
a
s2
=
length
l
/*
:== case l of
[]
-> a
_
-> arrayConcat a { x \\ x <- l }
*/
arrayPlusRevList
a
l
:==
r2
where
r2
={
r1
&
[
sr
-
i
]=
e
\\
i
<-[
1
..
s2
]
&
e
<-
l
}
r1
={
r0
&
[
i
]=
a
.[
i
]
\\
i
<-[
0
..
s1
-1
]}
r0
=
_createArrayc
sr
sr
=
s1
+
s2
s1
=
size
a
s2
=
length
l
frontend/check.dcl
View file @
34dcba46
...
...
@@ -18,3 +18,6 @@ convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
determineTypeOfMemberInstance
::
!
SymbolType
![
TypeVar
]
!
InstanceType
!
Specials
!*
TypeHeaps
->
(!
SymbolType
,
!
Specials
,
!*
TypeHeaps
)
arrayFunOffsetToPD_IndexTable
::
!{#
MemberDef
}
!
v
:{#
PredefinedSymbol
}
->
(!{#
Index
},
!{#
MemberDef
},
!
v
:{#
PredefinedSymbol
})
makeElemTypeOfArrayFunctionStrict
::
!
SymbolType
!
Index
!{#
Index
}
->
SymbolType
frontend/check.icl
View file @
34dcba46
...
...
@@ -2708,6 +2708,7 @@ check_needed_modules_are_imported mod_name extension e_info cs=:{cs_needed_modul
cs_error
=
popErrorAdmin
cs_error
=
(
e_info
,
{
cs
&
cs_error
=
cs_error
})
arrayFunOffsetToPD_IndexTable
::
!{#
MemberDef
}
!
v
:{#
PredefinedSymbol
}
->
(!{#
Index
},
!{#
MemberDef
},
!
v
:{#
PredefinedSymbol
})
arrayFunOffsetToPD_IndexTable
member_defs
predef_symbols
#
nr_of_array_functions
=
size
member_defs
=
iFoldSt
offset_to_PD_index
PD_CreateArrayFun
(
PD_CreateArrayFun
+
nr_of_array_functions
)
...
...
@@ -2722,6 +2723,7 @@ elemTypeIsStrict [TA {type_index={glob_object,glob_module}} _ : _] predef_symbol
=
glob_module
==
predef_symbols
.[
PD_PredefinedModule
].
pds_def
&&
(
glob_object
==
predef_symbols
.[
PD_StrictArrayType
].
pds_def
||
glob_object
==
predef_symbols
.[
PD_UnboxedArrayType
].
pds_def
)
makeElemTypeOfArrayFunctionStrict
::
!
SymbolType
!
Index
!{#
Index
}
->
SymbolType
makeElemTypeOfArrayFunctionStrict
st
=:{
st_args
,
st_result
}
me_offset
offset_table
#
array_fun_kind
=
offset_table
.[
me_offset
]
|
array_fun_kind
==
PD_UnqArraySelectFun
...
...
frontend/frontend.dcl
View file @
34dcba46
...
...
@@ -11,7 +11,7 @@ import checksupport, transform, overloading
,
fe_varHeap
::
!.
VarHeap
,
fe_dclIclConversions
::!
Optional
{#
Index
}
,
fe_iclDclConversions
::!
Optional
{#
Index
}
,
fe_arrayInstances
::
!
{!(
Index
,
SymbolType
)}
,
fe_arrayInstances
::
!
Index
Range
}
frontEndInterface
::
!
Ident
!
SearchPaths
!*
PredefinedSymbols
!*
HashTable
!*
Files
!*
File
!*
File
!*
File
->
(!*
PredefinedSymbols
,
!*
HashTable
,
!*
Files
,
!*
File
,
!*
File
,
!*
File
,
!
Optional
*
FrontEndSyntaxTree
)
...
...
frontend/frontend.icl
View file @
34dcba46
...
...
@@ -10,7 +10,7 @@ import RWSDebug
,
fe_varHeap
::
!.
VarHeap
,
fe_dclIclConversions
::!
Optional
{#
Index
}
,
fe_iclDclConversions
::!
Optional
{#
Index
}
,
fe_arrayInstances
::
!
{!(
Index
,
SymbolType
)}
,
fe_arrayInstances
::
!
Index
Range
}
// trace macro
...
...
frontend/syntax.dcl
View file @
34dcba46
...
...
@@ -413,6 +413,7 @@ cIsNonCoercible :== 2
|
TransformedBody
!
TransformedBody
|
Expanding
![
FreeVar
]
// the parameters of the newly generated function
|
BackendBody
![
BackendBody
]
|
NoBody
::
BackendBody
=
{
bb_args
::
![
FunctionPattern
]
...
...
@@ -1148,7 +1149,7 @@ instance == ModuleKind, Ident
instance
<<<
Module
a
|
<<<
a
,
ParsedDefinition
,
InstanceType
,
AttributeVar
,
TypeVar
,
SymbolType
,
Expression
,
Type
,
Ident
,
Global
object
|
<<<
object
,
Position
,
CaseAlt
,
AType
,
FunDef
,
ParsedExpr
,
TypeAttribute
,
Bind
a
b
|
<<<
a
&
<<<
b
,
ParsedConstructor
,
TypeDef
a
|
<<<
a
,
TypeVarInfo
,
BasicValue
,
ATypeVar
,
TypeRhs
,
FunctionPattern
,
(
Import
from_symbol
)
|
<<<
from_symbol
,
ImportDeclaration
,
ImportedIdent
,
CasePatterns
,
Optional
a
|
<<<
a
,
ConsVariable
,
BasicType
,
Annotation
,
Selection
Optional
a
|
<<<
a
,
ConsVariable
,
BasicType
,
Annotation
,
Selection
,
SignClassification
instance
==
TypeAttribute
instance
==
Annotation
...
...
frontend/syntax.icl
View file @
34dcba46
...
...
@@ -370,6 +370,7 @@ cMayBeNonCoercible :== 4
|
TransformedBody
!
TransformedBody
|
Expanding
![
FreeVar
]
// the parameters of the newly generated function
|
BackendBody
![
BackendBody
]
|
NoBody
::
BackendBody
=
{
bb_args
::
![
FunctionPattern
]
...
...
frontend/type.dcl
View file @
34dcba46
...
...
@@ -4,5 +4,5 @@ import StdArray
import
syntax
,
check
typeProgram
::!{!
Group
}
!*{#
FunDef
}
!
IndexRange
!
CommonDefs
![
Declaration
]
!{#
DclModule
}
!*
Heaps
!*
PredefinedSymbols
!*
File
->
(!
Bool
,
!*{#
FunDef
},
!
{!
(!
Index
,
!
SymbolType
)}
,
{!
GlobalTCType
},
!{#
CommonDefs
},
!{#
{#
FunType
}
},
!*
Heaps
,
!*
PredefinedSymbols
,
!*
File
)
->
(!
Bool
,
!*{#
FunDef
},
!
IndexRange
,
{!
GlobalTCType
},
!{#
CommonDefs
},
!{#
{#
FunType
}
},
!*
Heaps
,
!*
PredefinedSymbols
,
!*
File
)
frontend/type.icl
View file @
34dcba46
...
...
@@ -1370,7 +1370,7 @@ addLiftedArgumentsToSymbolType st=:{st_arity,st_args,st_vars,st_attr_vars} nr_of
}
typeProgram
::!{!
Group
}
!*{#
FunDef
}
!
IndexRange
!
CommonDefs
![
Declaration
]
!{#
DclModule
}
!*
Heaps
!*
PredefinedSymbols
!*
File
->
(!
Bool
,
!*{#
FunDef
},
!
{!
(!
Index
,
!
SymbolType
)}
,
{!
GlobalTCType
},
!{#
CommonDefs
},
!{#
{#
FunType
}
},
!*
Heaps
,
!*
PredefinedSymbols
,
!*
File
)
->
(!
Bool
,
!*{#
FunDef
},
!
IndexRange
,
{!
GlobalTCType
},
!{#
CommonDefs
},
!{#
{#
FunType
}
},
!*
Heaps
,
!*
PredefinedSymbols
,
!*
File
)
typeProgram
comps
fun_defs
specials
icl_defs
imports
modules
{
hp_var_heap
,
hp_expression_heap
,
hp_type_heaps
}
predef_symbols
file
#!
fun_env_size
=
size
fun_defs
#
ts_error
=
{
ea_file
=
file
,
ea_loc
=
[],
ea_ok
=
True
}
...
...
@@ -1396,10 +1396,10 @@ typeProgram comps fun_defs specials icl_defs imports modules {hp_var_heap, hp_ex
(
type_error
,
fun_defs
,
predef_symbols
,
special_instances
,
{
ts_fun_env
,
ts_error
,
ts_var_heap
,
ts_expr_heap
,
ts_type_heaps
})
=
type_instances
specials
.
ir_from
specials
.
ir_to
class_instances
ti
(
type_error
,
fun_defs
,
predef_symbols
,
special_instances
,
{
ts
&
ts_fun_env
=
ts_fun_env
})
{
si_array_instances
,
si_next_TC_member_index
,
si_TC_instances
}=
special_instances
(
array_inst_type
s
,
predef_symbols
,
ts_type_heaps
)
=
convert_array_instances
si_array_instances
ti_common_defs
predef_symbols
ts_type_heaps
{
si_array_instances
,
si_next_array_member_index
,
si_next_TC_member_index
,
si_TC_instances
}=
special_instances
(
fun_def
s
,
predef_symbols
,
ts_type_heaps
)
=
convert_array_instances
si_array_instances
ti_common_defs
fun_defs
predef_symbols
ts_type_heaps
type_code_instances
=
{
createArray
si_next_TC_member_index
GTT_Function
&
[
gtci_index
]
=
gtci_type
\\
{
gtci_index
,
gtci_type
}
<-
si_TC_instances
}
=
(
not
type_error
,
fun_defs
,
{
array_inst_type
\\
array_inst_type
<-
array_inst_types
},
type_code_instances
,
ti_common_defs
,
ti_functions
,
=
(
not
type_error
,
fun_defs
,
{
ir_from
=
fun_env_size
,
ir_to
=
si_next_array_member_index
},
type_code_instances
,
ti_common_defs
,
ti_functions
,
{
hp_var_heap
=
ts_var_heap
,
hp_expression_heap
=
ts_expr_heap
,
hp_type_heaps
=
ts_type_heaps
},
predef_symbols
,
ts_error
.
ea_file
)
where
...
...
@@ -1704,25 +1704,41 @@ where
type_of
(
UncheckedType
tst
)
=
tst
type_of
(
SpecifiedType
_
_
tst
)
=
tst
convert_array_instances
si_array_instances
common_defs
predef_symbols
type_heaps
convert_array_instances
si_array_instances
common_defs
fun_defs
predef_symbols
type_heaps
|
isEmpty
si_array_instances
=
(
[]
,
predef_symbols
,
type_heaps
)
=
(
fun_defs
,
predef_symbols
,
type_heaps
)
#
({
pds_ident
,
pds_module
,
pds_def
},
predef_symbols
)
=
predef_symbols
![
PD_UnboxedArrayType
]
unboxed_array_type
=
TA
(
MakeTypeSymbIdent
{
glob_object
=
pds_def
,
glob_module
=
pds_module
}
pds_ident
0
)
[]
({
pds_module
,
pds_def
},
predef_symbols
)
=
predef_symbols
![
PD_ArrayClass
]
{
class_members
}
=
common_defs
.[
pds_module
].
com_class_defs
.[
pds_def
]
array_members
=
common_defs
.[
pds_module
].
com_member_defs
(
rev_instances
,
type_heaps
)
=
foldSt
(
convert_array_instance
class_members
array_members
unboxed_array_type
)
si_array_instances
([],
type_heaps
)
=
(
reverse
rev_instances
,
predef_symbols
,
type_heaps
)
(
offset_table
,
_,
predef_symbols
)
=
arrayFunOffsetToPD_IndexTable
array_members
predef_symbols
(
rev_instances
,
type_heaps
)
=
foldSt
(
convert_array_instance
class_members
array_members
unboxed_array_type
offset_table
)
si_array_instances
([],
type_heaps
)
=
(
arrayPlusRevList
fun_defs
rev_instances
,
predef_symbols
,
type_heaps
)
where
convert_array_instance
class_members
array_members
unboxed_array_type
{
ai_record
}
type
s_and_heaps
=
iFoldSt
(
create_instance_type
class_members
array_members
unboxed_array_type
(
TA
ai_record
[]))
0
(
size
class_members
)
type
s_and_heaps
convert_array_instance
class_members
array_members
unboxed_array_type
offset_table
{
ai_record
}
fun
s_and_heaps
=
iFoldSt
(
create_instance_type
class_members
array_members
unboxed_array_type
offset_table
(
TA
ai_record
[]))
0
(
size
class_members
)
fun
s_and_heaps
create_instance_type
members
array_members
unboxed_array_type
record_type
member_index
(
inst_type
s
,
type_heaps
)
#
{
me_type
,
me_class_vars
}
=
array_members
.[
members
.[
member_index
].
ds_index
]
#
(
instance_type
,
_,
type_heaps
)
=
determineTypeOfMemberInstance
me_type
me_class_vars
{
it_vars
=
[],
it_attr_vars
=
[],
it_context
=
[],
create_instance_type
members
array_members
unboxed_array_type
offset_table
record_type
member_index
(
array_def
s
,
type_heaps
)
#
{
me_type
,
me_
symb
,
me_
class_vars
,
me_pos
}
=
array_members
.[
members
.[
member_index
].
ds_index
]
(
instance_type
,
_,
type_heaps
)
=
determineTypeOfMemberInstance
me_type
me_class_vars
{
it_vars
=
[],
it_attr_vars
=
[],
it_context
=
[],
it_types
=
[
unboxed_array_type
,
record_type
]}
SP_None
type_heaps
=
([(
member_index
,
instance_type
)
:
inst_types
],
type_heaps
)
instance_type
=
makeElemTypeOfArrayFunctionStrict
instance_type
member_index
offset_table
fun
=
{
fun_symb
=
me_symb
,
fun_arity
=
me_type
.
st_arity
,
fun_priority
=
NoPrio
,
fun_body
=
NoBody
,
fun_type
=
Yes
instance_type
,
fun_pos
=
me_pos
,
fun_index
=
member_index
,
fun_kind
=
FK_Unknown
,
fun_lifted
=
0
,
fun_info
=
EmptyFunInfo
}
=
([
fun
:
array_defs
],
type_heaps
)
create_erroneous_function_types
group
ts
=
foldSt
create_erroneous_function_type
group
ts
...
...
frontend/utilities.dcl
View file @
34dcba46
...
...
@@ -4,6 +4,8 @@ from StdString import String
from
StdEnv
import
Eq
,
not
,
Ord
,
IncDec
import
StdMisc
,
general
import
_aconcat
/*
For Strings
*/
...
...
frontend/utilities.icl
View file @
34dcba46
implementation
module
utilities
import
StdEnv
,
general
from
_aconcat
import
arrayConcat
/*
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment