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
8bd791fb
Commit
8bd791fb
authored
Dec 13, 2001
by
John van Groningen
Browse files
remove tuple symbol from UniqueSelector (! selector) and MatchExpr
parent
c7018944
Changes
17
Hide whitespace changes
Inline
Side-by-side
backend/backendconvert.icl
View file @
8bd791fb
...
...
@@ -1865,14 +1865,8 @@ where
=
[]
convertExpr
(
TupleSelect
{
ds_arity
}
n
expr
)
=
beTupleSelectNode
ds_arity
n
(
convertExpr
expr
)
convertExpr
(
MatchExpr
optionalTuple
{
glob_module
,
glob_object
={
ds_index
}}
expr
)
=
beMatchNode
(
arity
optionalTuple
)
(
beConstructorSymbol
glob_module
ds_index
)
(
convertExpr
expr
)
where
arity
::
(
Optional
(
Global
DefinedSymbol
))
->
Int
arity
No
=
1
arity
(
Yes
{
glob_object
={
ds_arity
}})
=
ds_arity
convertExpr
(
MatchExpr
{
glob_module
,
glob_object
={
ds_index
,
ds_arity
}}
expr
)
=
beMatchNode
ds_arity
(
beConstructorSymbol
glob_module
ds_index
)
(
convertExpr
expr
)
convertExpr
(
Conditional
{
if_cond
=
cond
,
if_then
,
if_else
=
Yes
else
})
=
beIfNode
(
convertExpr
cond
)
(
convertExpr
if_then
)
(
convertExpr
else
)
...
...
frontend/check.icl
View file @
8bd791fb
...
...
@@ -2959,7 +2959,9 @@ where
|
pre_mod
.
pds_def
==
mod_index
=
(
class_members
,
class_instances
,
fun_types
,
{
cs
&
cs_predef_symbols
=
cs_predef_symbols
}
<=<
adjustPredefSymbolAndCheckIndex
PD_StringType
mod_index
PD_StringTypeIndex
STE_Type
<=<
adjust_predef_symbols
PD_ListType
PD_UnboxedArrayType
mod_index
STE_Type
<=<
adjust_predef_symbols
PD_ListType
PD_OverloadedListType
mod_index
STE_Type
<=<
adjust_predef_symbols_and_check_indices
PD_Arity2TupleType
PD_Arity32TupleType
PD_Arity2TupleTypeIndex
mod_index
STE_Type
<=<
adjust_predef_symbols
PD_LazyArrayType
PD_UnboxedArrayType
mod_index
STE_Type
<=<
adjust_predef_symbols
PD_ConsSymbol
PD_Arity32TupleSymbol
mod_index
STE_Constructor
<=<
adjustPredefSymbol
PD_TypeCodeClass
mod_index
STE_Class
<=<
adjustPredefSymbol
PD_TypeCodeMember
mod_index
STE_Member
...
...
@@ -2989,7 +2991,6 @@ where
<=<
adjustPredefSymbol
PD_DynamicValue
mod_index
(
STE_Field
unused
)
<=<
adjustPredefSymbol
PD_TypeID
mod_index
STE_Type
<=<
adjustPredefSymbol
PD_ModuleID
mod_index
STE_Constructor
)
// AA..
#
(
pre_mod
,
cs_predef_symbols
)
=
cs_predef_symbols
![
PD_StdGeneric
]
#
type_iso_ident
=
predefined_idents
.[
PD_TypeISO
]
|
pre_mod
.
pds_def
==
mod_index
...
...
@@ -3037,6 +3038,13 @@ where
<=<
adjustPredefSymbol
next_symb
mod_index
symb_kind
<=<
adjust_predef_symbols
(
inc
next_symb
)
last_symb
mod_index
symb_kind
adjust_predef_symbols_and_check_indices
next_symb
last_symb
type_index
mod_index
symb_kind
cs
|
next_symb
>
last_symb
=
cs
=
cs
<=<
adjustPredefSymbolAndCheckIndex
next_symb
mod_index
type_index
symb_kind
<=<
adjust_predef_symbols_and_check_indices
(
inc
next_symb
)
last_symb
(
inc
type_index
)
mod_index
symb_kind
count_members
::
!
Index
!{#
ClassInstance
}
!{#
ClassDef
}
!{#
DclModule
}
->
Int
count_members
mod_index
com_instance_defs
com_class_defs
modules
#
(
sum
,
_,
_)
...
...
frontend/checkFunctionBodies.icl
View file @
8bd791fb
...
...
@@ -1027,8 +1027,7 @@ checkExpression free_vars (PE_Selection selector_kind expr selectors) e_input e_
ParsedNormalSelector
->
(
Selection
NormalSelector
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
ParsedUniqueSelector
unique_element
#
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
2
)
PD_PredefinedModule
STE_Type
2
cs
->
(
Selection
(
UniqueSelector
tuple_type
)
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
->
(
Selection
UniqueSelector
expr
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
checkExpression
free_vars
(
PE_Update
expr1
selectors
expr2
)
e_input
e_state
e_info
cs
#
(
expr1
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr1
e_input
e_state
e_info
cs
(
selectors
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkSelectors
cEndWithUpdate
free_vars
selectors
e_input
e_state
e_info
cs
...
...
@@ -1805,13 +1804,12 @@ transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_mo
_
|
ds_arity
==
1
#
(
binds
,
var_store
,
expr_heap
,
e_info
,
cs
)
=
transfromPatternIntoBind
mod_index
def_level
(
hd
args
)
(
MatchExpr
No
cons_symbol
src_expr
)
=
transfromPatternIntoBind
mod_index
def_level
(
hd
args
)
(
MatchExpr
cons_symbol
src_expr
)
position
var_store
expr_heap
e_info
cs
->
(
opt_var_bind
++
binds
,
var_store
,
expr_heap
,
e_info
,
cs
)
#
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
ds_arity
)
PD_PredefinedModule
STE_Type
ds_arity
cs
(
tuple_cons
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleConsIndex
ds_arity
)
PD_PredefinedModule
STE_Constructor
ds_arity
cs
#
(
tuple_cons
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleConsIndex
ds_arity
)
PD_PredefinedModule
STE_Constructor
ds_arity
cs
(
match_var
,
match_bind
,
var_store
,
expr_heap
)
=
bind_match_expr
(
MatchExpr
(
Yes
tuple_type
)
cons_symbol
src_expr
)
opt_var_bind
position
var_store
expr_heap
=
bind_match_expr
(
MatchExpr
cons_symbol
src_expr
)
opt_var_bind
position
var_store
expr_heap
->
transform_sub_patterns
mod_index
def_level
args
tuple_cons
.
glob_object
0
match_var
match_bind
position
var_store
expr_heap
e_info
cs
where
...
...
@@ -2195,8 +2193,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections}
1
#
(
unq_select_symb
,
cs
)
=
getPredefinedGlobalSymbol
PD_UnqArraySelectFun
PD_StdArray
STE_Member
2
cs
->
(
unq_select_symb
,
NormalSelector
,
cs
)
_
#
(
select_symb
,
cs
)
=
getPredefinedGlobalSymbol
PD_ArraySelectFun
PD_StdArray
STE_Member
2
cs
(
tuple_type
,
cs
)
=
getPredefinedGlobalSymbol
(
GetTupleTypeIndex
2
)
PD_PredefinedModule
STE_Type
2
cs
->
(
select_symb
,
UniqueSelector
tuple_type
,
cs
)
->
(
select_symb
,
UniqueSelector
,
cs
)
e_state
=
{
e_state
&
es_var_heap
=
es_var_heap
,
es_expr_heap
=
es_expr_heap
}
(
index_exprs
,
(
free_vars
,
e_state
,
e_info
,
cs
))
...
...
frontend/comparedefimp.icl
View file @
8bd791fb
...
...
@@ -946,10 +946,9 @@ instance e_corresponds Expression where
e_corresponds
(
ABCCodeExpr
dcl_lines
dcl_do_inline
)
(
ABCCodeExpr
icl_lines
icl_do_inline
)
=
equal2
dcl_lines
icl_lines
o`
equal2
dcl_do_inline
icl_do_inline
e_corresponds
(
MatchExpr
dcl_opt_tuple_type
dcl_cons_symbol
dcl_src_expr
)
(
MatchExpr
icl_opt_tuple_type
icl_cons_symbol
icl_src_expr
)
=
e_corresponds
dcl_opt_tuple_type
icl_opt_tuple_type
o`
e_corresponds
dcl_cons_symbol
icl_cons_symbol
e_corresponds
(
MatchExpr
dcl_cons_symbol
dcl_src_expr
)
(
MatchExpr
icl_cons_symbol
icl_src_expr
)
=
e_corresponds
dcl_cons_symbol
icl_cons_symbol
o`
e_corresponds
dcl_src_expr
icl_src_expr
e_corresponds
(
FreeVar
dcl
)
(
FreeVar
icl
)
=
e_corresponds
dcl
icl
...
...
frontend/convertDynamics.icl
View file @
8bd791fb
...
...
@@ -412,9 +412,9 @@ where
=
(
AnyCodeExpr
codeBinding1
codeBinding2
strings
,
ci
)
convertDynamics
_
_
_
(
ABCCodeExpr
strings
bool
)
ci
=
(
ABCCodeExpr
strings
bool
,
ci
)
convertDynamics
cinp
bound_vars
default_expr
(
MatchExpr
opt_symb
symb
expression
)
ci
convertDynamics
cinp
bound_vars
default_expr
(
MatchExpr
symb
expression
)
ci
#
(
expression
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
expression
ci
=
(
MatchExpr
opt_symb
symb
expression
,
ci
)
=
(
MatchExpr
symb
expression
,
ci
)
/* Sjaak ... */
convertDynamics
cinp
bound_vars
default_expr
(
DynamicExpr
{
dyn_expr
,
dyn_info_ptr
,
dyn_type_code
})
ci
=:{
ci_symb_ident
}
#
(
dyn_expr
,
ci
)
=
convertDynamics
cinp
bound_vars
default_expr
dyn_expr
ci
...
...
frontend/convertcases.icl
View file @
8bd791fb
...
...
@@ -211,7 +211,7 @@ where
=
weightedRefCountOfCase
rci
case_expr
case_info
{
rs
&
rcs_expr_heap
=
rcs_expr_heap
}
weightedRefCount
rci
expr
=:(
BasicExpr
_)
rs
=
rs
weightedRefCount
rci
(
MatchExpr
_
constructor
expr
)
rs
weightedRefCount
rci
(
MatchExpr
constructor
expr
)
rs
=
weightedRefCount
rci
expr
rs
weightedRefCount
rci
(
Selection
opt_tuple
expr
selections
)
rs
=
weightedRefCount
rci
(
expr
,
selections
)
rs
...
...
@@ -456,9 +456,9 @@ where
=
(
fun_expr
@
exprs
,
ds
)
distributeLets
depth
expr
=:(
BasicExpr
_)
ds
=
(
expr
,
ds
)
distributeLets
depth
(
MatchExpr
opt_tuple
constructor
expr
)
ds
distributeLets
depth
(
MatchExpr
constructor
expr
)
ds
#
(
expr
,
ds
)
=
distributeLets
depth
expr
ds
=
(
MatchExpr
opt_tuple
constructor
expr
,
ds
)
=
(
MatchExpr
constructor
expr
,
ds
)
distributeLets
depth
(
Selection
opt_tuple
expr
selectors
)
ds
#
(
expr
,
ds
)
=
distributeLets
depth
expr
ds
#
(
selectors
,
ds
)
=
distributeLets
depth
selectors
ds
...
...
@@ -1036,9 +1036,9 @@ where
convertCases
ci
(
Let
lad
)
cs
#
(
lad
,
cs
)
=
convertCases
ci
lad
cs
=
(
Let
lad
,
cs
)
convertCases
ci
(
MatchExpr
opt_tuple
constructor
expr
)
cs
convertCases
ci
(
MatchExpr
constructor
expr
)
cs
#
(
expr
,
cs
)
=
convertCases
ci
expr
cs
=
(
MatchExpr
opt_tuple
constructor
expr
,
cs
)
=
(
MatchExpr
constructor
expr
,
cs
)
convertCases
ci
(
Selection
is_unique
expr
selectors
)
cs
#
(
expr
,
cs
)
=
convertCases
ci
expr
cs
(
selectors
,
cs
)
=
convertCases
ci
selectors
cs
...
...
@@ -1236,9 +1236,9 @@ where
=
(
Conditional
cond
,
cp_info
)
copy
expr
=:(
BasicExpr
_)
cp_info
=
(
expr
,
cp_info
)
copy
(
MatchExpr
opt_tuple
constructor
expr
)
cp_info
copy
(
MatchExpr
constructor
expr
)
cp_info
#
(
expr
,
cp_info
)
=
copy
expr
cp_info
=
(
MatchExpr
opt_tuple
constructor
expr
,
cp_info
)
=
(
MatchExpr
constructor
expr
,
cp_info
)
copy
(
Selection
is_unique
expr
selectors
)
cp_info
#
(
expr
,
cp_info
)
=
copy
expr
cp_info
(
selectors
,
cp_info
)
=
copy
selectors
cp_info
...
...
frontend/explicitimports.icl
View file @
8bd791fb
...
...
@@ -660,7 +660,7 @@ instance check_completeness Expression where
=
ccs
check_completeness
(
ABCCodeExpr
_
_)
_
ccs
=
ccs
check_completeness
(
MatchExpr
_
constructor
expression
)
cci
ccs
check_completeness
(
MatchExpr
constructor
expression
)
cci
ccs
=
check_completeness
expression
cci
(
check_whether_ident_is_imported
constructor
.
glob_object
.
ds_ident
STE_Constructor
cci
ccs
)
check_completeness
(
FreeVar
_)
_
ccs
...
...
frontend/generics.icl
View file @
8bd791fb
...
...
@@ -4038,9 +4038,9 @@ mapExprSt f (Conditional cond=:{if_cond, if_then, if_else}) st
No
->
(
No
,
st
)
=
f
(
Conditional
{
cond
&
if_cond
=
if_cond
,
if_then
=
if_then
,
if_else
=
if_else
})
st
mapExprSt
f
(
MatchExpr
x
y
expr
)
st
mapExprSt
f
(
MatchExpr
y
expr
)
st
#
(
expr
,
st
)
=
mapExprSt
f
expr
st
=
f
(
MatchExpr
x
y
expr
)
st
=
f
(
MatchExpr
y
expr
)
st
mapExprSt
f
(
DynamicExpr
dyn
=:{
dyn_expr
})
st
#
(
dyn_expr
,
st
)
=
mapExprSt
f
dyn_expr
st
...
...
@@ -4145,7 +4145,7 @@ where
collect_expr_calls
(
TupleSelect
ds
i
expr
)
rest
=
collect_expr_calls
expr
rest
//collect_expr_calls (Lambda fvs expr) rest = collect_expr_calls expr rest
collect_expr_calls
(
Conditional
cond
)
rest
=
collect_expr_calls
cond
.
if_cond
(
collect_expr_calls
cond
.
if_then
(
foldOptional
id
collect_expr_calls
cond
.
if_else
rest
))
collect_expr_calls
(
MatchExpr
ogds
gds
expr
)
rest
=
collect_expr_calls
expr
rest
collect_expr_calls
(
MatchExpr
gds
expr
)
rest
=
collect_expr_calls
expr
rest
collect_expr_calls
(
DynamicExpr
dyn
)
rest
=
collect_expr_calls
dyn
.
dyn_expr
(
collect_tce_calls
dyn
.
dyn_type_code
rest
)
//collect_expr_calls (TypeCase tc) rest = collect_expr_calls tc.type_case_dynamic (foldr collect_dp_calls (foldOptional id collect_expr_calls rest) tc.type_case_patterns)
collect_expr_calls
(
TypeCodeExpression
tce
)
rest
=
collect_tce_calls
tce
rest
...
...
frontend/overloading.icl
View file @
8bd791fb
...
...
@@ -1408,9 +1408,9 @@ where
|
isEmpty
uni_vars
=
(
DynamicExpr
{
dyn
&
dyn_expr
=
dyn_expr
,
dyn_type_code
=
type_code
},
ui
)
=
(
DynamicExpr
{
dyn
&
dyn_expr
=
dyn_expr
,
dyn_type_code
=
TCE_UniType
uni_vars
type_code
},
ui
)
updateExpression
group_index
(
MatchExpr
opt_tuple
cons_symbol
expr
)
ui
updateExpression
group_index
(
MatchExpr
cons_symbol
expr
)
ui
#
(
expr
,
ui
)
=
updateExpression
group_index
expr
ui
=
(
MatchExpr
opt_tuple
cons_symbol
expr
,
ui
)
=
(
MatchExpr
cons_symbol
expr
,
ui
)
updateExpression
group_index
(
TupleSelect
symbol
argn_nr
expr
)
ui
#
(
expr
,
ui
)
=
updateExpression
group_index
expr
ui
=
(
TupleSelect
symbol
argn_nr
expr
,
ui
)
...
...
frontend/predef.dcl
View file @
8bd791fb
...
...
@@ -2,10 +2,6 @@ definition module predef
import
syntax
,
hashtable
cPredefinedModuleIndex
:==
1
PD_StringTypeIndex
:==
0
::
PredefinedSymbols
:==
{#
PredefinedSymbol
}
::
PredefinedSymbol
=
{
...
...
@@ -13,6 +9,12 @@ PD_StringTypeIndex :== 0
pds_def
::
!
Index
}
cPredefinedModuleIndex
:==
1
PD_StringTypeIndex
:==
0
PD_Arity2TupleTypeIndex
:==
8
PD_Arity32TupleTypeIndex
:==
38
/* identifiers not present the hastable */
PD_PredefinedModule
:==
0
...
...
frontend/predef.icl
View file @
8bd791fb
...
...
@@ -2,10 +2,6 @@ implementation module predef
import
syntax
,
hashtable
,
type_io_common
cPredefinedModuleIndex
:==
1
PD_StringTypeIndex
:==
0
::
PredefinedSymbols
:==
{#
PredefinedSymbol
}
::
PredefinedSymbol
=
{
...
...
@@ -13,6 +9,12 @@ PD_StringTypeIndex :== 0
pds_def
::
!
Index
}
cPredefinedModuleIndex
:==
1
PD_StringTypeIndex
:==
0
PD_Arity2TupleTypeIndex
:==
8
PD_Arity32TupleTypeIndex
:==
38
/* identifiers not present the hashtable */
PD_PredefinedModule
:==
0
...
...
frontend/refmark.icl
View file @
8bd791fb
...
...
@@ -250,7 +250,7 @@ where
refMark
free_vars
sel
_
(
TupleSelect
_
arg_nr
expr
)
var_heap
=
refMark
free_vars
arg_nr
No
expr
var_heap
refMark
free_vars
sel
_
(
MatchExpr
_
_
expr
)
var_heap
refMark
free_vars
sel
_
(
MatchExpr
_
expr
)
var_heap
=
refMark
free_vars
sel
No
expr
var_heap
refMark
free_vars
sel
_
EE
var_heap
=
var_heap
...
...
frontend/syntax.dcl
View file @
8bd791fb
...
...
@@ -115,7 +115,7 @@ instance == FunctionOrMacroIndex
,
def_macro_indices
::
!
IndexRange
,
def_classes
::
![
ClassDef
]
,
def_members
::
![
MemberDef
]
,
def_generics
::
![
GenericDef
]
// AA
,
def_generics
::
![
GenericDef
]
,
def_funtypes
::
![
FunType
]
,
def_instances
::
![
instance_kind
]
}
...
...
@@ -167,7 +167,7 @@ cIsNotAFunction :== False
|
PD_Type
ParsedTypeDef
|
PD_TypeSpec
Position
Ident
Priority
(
Optional
SymbolType
)
Specials
|
PD_Class
ClassDef
[
ParsedDefinition
]
|
PD_Generic
GenericDef
// AA
|
PD_Generic
GenericDef
|
PD_Instance
(
ParsedInstance
ParsedDefinition
)
|
PD_Instances
[
ParsedInstance
ParsedDefinition
]
|
PD_Import
[
ParsedImport
]
...
...
@@ -1104,7 +1104,6 @@ cIsNotStrict :== False
=
NormalSelector
|
NormalSelectorUniqueElementResult
|
UniqueSelector
// !
(
Global
DefinedSymbol
)
// tuple type
/*
:: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last
...
...
@@ -1128,7 +1127,7 @@ cIsNotStrict :== False
|
AnyCodeExpr
!(
CodeBinding
BoundVar
)
!(
CodeBinding
FreeVar
)
![
String
]
|
ABCCodeExpr
![
String
]
!
Bool
|
MatchExpr
!(
Optional
(
Global
DefinedSymbol
))
!(
Global
DefinedSymbol
)
!
Expression
|
MatchExpr
!(
Global
DefinedSymbol
)
!
Expression
|
FreeVar
FreeVar
|
Constant
!
SymbIdent
!
Int
!
Priority
!
Bool
/* auxiliary clause used during checking */
|
ClassVariable
!
VarInfoPtr
/* auxiliary clause used during overloading */
...
...
@@ -1359,10 +1358,7 @@ ParsedInstanceToClassInstance pi members :==
{
ins_class
=
{
glob_object
=
MakeDefinedSymbol
pi
.
pi_class
NoIndex
(
length
pi
.
pi_types
),
glob_module
=
NoIndex
},
ins_ident
=
pi
.
pi_ident
,
ins_type
=
{
it_vars
=
[],
it_types
=
pi
.
pi_types
,
it_attr_vars
=
[],
it_context
=
pi
.
pi_context
},
ins_members
=
members
,
ins_specials
=
pi
.
pi_specials
,
ins_pos
=
pi
.
pi_pos
,
/*AA*/
ins_is_generic
=
False
,
ins_generate
=
pi
.
pi_generate
,
ins_partial
=
False
,
ins_is_generic
=
False
,
ins_generate
=
pi
.
pi_generate
,
ins_partial
=
False
,
ins_generic
=
{
glob_module
=
NoIndex
,
glob_object
=
NoIndex
}}
MakeTypeDef
name
lhs
rhs
attr
contexts
pos
:==
...
...
frontend/syntax.icl
View file @
8bd791fb
...
...
@@ -1095,7 +1095,6 @@ cIsNotStrict :== False
=
NormalSelector
|
NormalSelectorUniqueElementResult
|
UniqueSelector
// !
(
Global
DefinedSymbol
)
// tuple type
::
Expression
=
Var
!
BoundVar
|
App
!
App
...
...
@@ -1113,7 +1112,7 @@ cIsNotStrict :== False
|
AnyCodeExpr
!(
CodeBinding
BoundVar
)
!(
CodeBinding
FreeVar
)
![
String
]
|
ABCCodeExpr
![
String
]
!
Bool
|
MatchExpr
!(
Optional
(
Global
DefinedSymbol
))
!(
Global
DefinedSymbol
)
!
Expression
|
MatchExpr
!(
Global
DefinedSymbol
)
!
Expression
|
FreeVar
FreeVar
|
Constant
!
SymbIdent
!
Int
!
Priority
!
Bool
/* auxiliary clause used during checking */
|
ClassVariable
!
VarInfoPtr
/* auxiliary clause used during overloading */
...
...
@@ -1592,7 +1591,7 @@ where
(<<<)
file
(
TupleSelect
field
field_nr
expr
)
=
file
<<<
expr
<<<
'.'
<<<
field_nr
// (<<<) file (Lambda vars expr) = file <<< '\\' <<< vars <<< " -> " <<< expr
(<<<)
file
WildCard
=
file
<<<
'_'
(<<<)
file
(
MatchExpr
_
cons
expr
)
=
file
<<<
cons
<<<
" =: "
<<<
expr
(<<<)
file
(
MatchExpr
cons
expr
)
=
file
<<<
cons
<<<
" =: "
<<<
expr
(<<<)
file
EE
=
file
<<<
"** E **"
(<<<)
file
(
NoBind
_)
=
file
<<<
"** NB **"
(<<<)
file
(
DynamicExpr
{
dyn_expr
,
dyn_type_code
})
=
file
<<<
"dynamic "
<<<
dyn_expr
<<<
" :: "
<<<
dyn_type_code
...
...
@@ -1660,7 +1659,7 @@ instance <<< SelectorKind
where
(<<<)
file
NormalSelector
=
file
<<<
"."
(<<<)
file
NormalSelectorUniqueElementResult
=
file
<<<
"!*"
(<<<)
file
(
UniqueSelector
_)
=
file
<<<
"!"
(<<<)
file
UniqueSelector
=
file
<<<
"!"
instance
<<<
Selection
where
...
...
@@ -2056,7 +2055,7 @@ where
=
file
<<<
"argument "
<<<
(
elem_nr
+
1
)
<<<
" of "
<<<
ds_arity
<<<
"-tuple"
show_expression
file
(
BasicExpr
bv
)
=
file
<<<
bv
show_expression
file
(
MatchExpr
_
_
expr
)
show_expression
file
(
MatchExpr
_
expr
)
=
file
<<<
"match expression"
show_expression
file
_
=
file
...
...
frontend/trans.icl
View file @
8bd791fb
...
...
@@ -266,7 +266,7 @@ instance consumerRequirements Expression where
=
consumerRequirements
case_expr
common_defs
ai
consumerRequirements
(
BasicExpr
_)
_
ai
=
(
cPassive
,
False
,
ai
)
consumerRequirements
(
MatchExpr
_
_
expr
)
common_defs
ai
consumerRequirements
(
MatchExpr
_
expr
)
common_defs
ai
=
consumerRequirements
expr
common_defs
ai
consumerRequirements
(
Selection
_
expr
selectors
)
common_defs
ai
#
(
cc
,
_,
ai
)
=
consumerRequirements
expr
common_defs
ai
...
...
@@ -778,9 +778,9 @@ where
transform
(
TupleSelect
a1
arg_nr
expr
)
ro
ti
#
(
expr
,
ti
)
=
transform
expr
ro
ti
=
(
TupleSelect
a1
arg_nr
expr
,
ti
)
transform
(
MatchExpr
a1
a2
expr
)
ro
ti
transform
(
MatchExpr
a1
expr
)
ro
ti
#
(
expr
,
ti
)
=
transform
expr
ro
ti
=
(
MatchExpr
a1
a2
expr
,
ti
)
=
(
MatchExpr
a1
expr
,
ti
)
transform
(
DynamicExpr
dynamic_expr
)
ro
ti
#
(
dynamic_expr
,
ti
)
=
transform
dynamic_expr
ro
ti
=
(
DynamicExpr
dynamic_expr
,
ti
)
...
...
@@ -2976,7 +2976,7 @@ where
=
free_variables_of_fields
fields
var
fvi
freeVariables
(
TupleSelect
_
arg_nr
expr
)
fvi
=
freeVariables
expr
fvi
freeVariables
(
MatchExpr
_
_
expr
)
fvi
freeVariables
(
MatchExpr
_
expr
)
fvi
=
freeVariables
expr
fvi
freeVariables
EE
fvi
=
fvi
...
...
@@ -3278,7 +3278,7 @@ instance producerRequirements Expression where
=
(
False
,
prs
)
producerRequirements
(
ABCCodeExpr
_
_)
prs
=
(
False
,
prs
)
producerRequirements
(
MatchExpr
_
_
_)
prs
producerRequirements
(
MatchExpr
_
_)
prs
// what's this?
=
(
False
,
prs
)
producerRequirements
(
DynamicExpr
_)
prs
...
...
frontend/transform.icl
View file @
8bd791fb
...
...
@@ -80,9 +80,9 @@ where
lift
(
TupleSelect
symbol
argn_nr
expr
)
ls
#
(
expr
,
ls
)
=
lift
expr
ls
=
(
TupleSelect
symbol
argn_nr
expr
,
ls
)
lift
(
MatchExpr
opt_tuple
cons_symb
expr
)
ls
lift
(
MatchExpr
cons_symb
expr
)
ls
#
(
expr
,
ls
)
=
lift
expr
ls
=
(
MatchExpr
opt_tuple
cons_symb
expr
,
ls
)
=
(
MatchExpr
cons_symb
expr
,
ls
)
lift
(
DynamicExpr
expr
)
ls
#
(
expr
,
ls
)
=
lift
expr
ls
=
(
DynamicExpr
expr
,
ls
)
...
...
@@ -426,9 +426,9 @@ where
unfold
(
TupleSelect
symbol
argn_nr
expr
)
ui
us
#
(
expr
,
us
)
=
unfold
expr
ui
us
=
(
TupleSelect
symbol
argn_nr
expr
,
us
)
unfold
(
MatchExpr
opt_tuple
cons_symb
expr
)
ui
us
unfold
(
MatchExpr
cons_symb
expr
)
ui
us
#
(
expr
,
us
)
=
unfold
expr
ui
us
=
(
MatchExpr
opt_tuple
cons_symb
expr
,
us
)
=
(
MatchExpr
cons_symb
expr
,
us
)
unfold
(
DynamicExpr
expr
)
ui
us
#
(
expr
,
us
)
=
unfold
expr
ui
us
=
(
DynamicExpr
expr
,
us
)
...
...
@@ -1257,7 +1257,7 @@ where
=
True
has_no_curried_macro_Expression
(
TupleSelect
symbol
argn_nr
expr
)
=
has_no_curried_macro_Expression
expr
has_no_curried_macro_Expression
(
MatchExpr
opt_tuple
cons_symb
expr
)
has_no_curried_macro_Expression
(
MatchExpr
cons_symb
expr
)
=
has_no_curried_macro_Expression
expr
has_no_curried_macro_Expression
expr
=
True
...
...
@@ -1648,9 +1648,9 @@ where
expand
(
TupleSelect
symbol
argn_nr
expr
)
ei
#
(
expr
,
ei
)
=
expand
expr
ei
=
(
TupleSelect
symbol
argn_nr
expr
,
ei
)
expand
(
MatchExpr
opt_tuple
cons_symb
expr
)
ei
expand
(
MatchExpr
cons_symb
expr
)
ei
#
(
expr
,
ei
)
=
expand
expr
ei
=
(
MatchExpr
opt_tuple
cons_symb
expr
,
ei
)
=
(
MatchExpr
cons_symb
expr
,
ei
)
expand
expr
ei
=
(
expr
,
ei
)
...
...
@@ -1950,9 +1950,9 @@ where
collectVariables
(
TupleSelect
symbol
argn_nr
expr
)
free_vars
cos
#
(
expr
,
free_vars
,
cos
)
=
collectVariables
expr
free_vars
cos
=
(
TupleSelect
symbol
argn_nr
expr
,
free_vars
,
cos
)
collectVariables
(
MatchExpr
opt_tuple
cons_symb
expr
)
free_vars
cos
collectVariables
(
MatchExpr
cons_symb
expr
)
free_vars
cos
#
(
expr
,
free_vars
,
cos
)
=
collectVariables
expr
free_vars
cos
=
(
MatchExpr
opt_tuple
cons_symb
expr
,
free_vars
,
cos
)
=
(
MatchExpr
cons_symb
expr
,
free_vars
,
cos
)
collectVariables
(
DynamicExpr
dynamic_expr
=:{
dyn_expr
/* MV ... */
,
dyn_info_ptr
/* ... MV */
})
free_vars
cos
#!
(
dyn_expr
,
free_vars
,
cos
/* MV ... */
=:{
cos_symbol_heap
}
/* ... MV */
)
=
collectVariables
dyn_expr
free_vars
cos
// MV ...
...
...
frontend/type.icl
View file @
8bd791fb
...
...
@@ -1470,16 +1470,15 @@ where
requirements
ti
(
Selection
selector_kind
expr
selectors
)
reqs_ts
#
(
expr_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
reqs_ts
=
case
selector_kind
of
UniqueSelector
{
glob_object
={
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
UniqueSelector
#
(
var
,
ts
)
=
freshAttributedVariable
ts
(_,
result_type
,
(
reqs
,
ts
))
=
requirementsOfSelectors
ti
No
expr
selectors
False
False
var
expr
(
reqs
,
ts
)
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}
ds_ident
ds_arity
non_unique_type_var
=
{
at_attribute
=
TA_Multi
,
at_annotation
=
AN_None
,
at_type
=
TempV
ts
.
ts_var_store
}
req_type_coercions
=
[
{
tc_demanded
=
non_unique_type_var
,
tc_offered
=
result_type
,
tc_position
=
CP_Expression
expr
,
tc_coercible
=
False
},
{
tc_demanded
=
var
,
tc_offered
=
expr_type
,
tc_position
=
CP_Expression
expr
,
tc_coercible
=
True
}
:
reqs
.
req_type_coercions
]
result_type
=
{
at_type
=
TA
tuple
_t
ype
[
non_unique_type_var
,
var
],
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
}
result_type
=
{
at_type
=
TA
tuple
2T
ype
SymbIdent
[
non_unique_type_var
,
var
],
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
}
->
(
result_type
,
No
,
({
reqs
&
req_type_coercions
=
req_type_coercions
},
{
ts
&
ts_var_store
=
inc
ts
.
ts_var_store
,
ts_expr_heap
=
storeAttribute
opt_expr_ptr
TA_Multi
ts
.
ts_expr_heap
}))
NormalSelectorUniqueElementResult
...
...
@@ -1548,20 +1547,18 @@ where
attributedBasicType
{
box
=
type
}
ts
=:{
ts_attr_store
}
=
({
at_annotation
=
AN_None
,
at_attribute
=
TA_TempVar
ts_attr_store
,
at_type
=
type
},
{
ts
&
ts_attr_store
=
inc
ts_attr_store
})
requirements
ti
(
MatchExpr
opt_tuple_type
{
glob_object
={
ds_arity
,
ds_index
},
glob_module
}
expr
)
(
reqs
,
ts
)
requirements
ti
(
MatchExpr
{
glob_object
={
ds_arity
,
ds_index
},
glob_module
}
expr
)
(
reqs
,
ts
)
#
cp
=
CP_Expression
expr
({
tst_result
,
tst_args
,
tst_attr_env
},
ts
)
=
standardLhsConstructorType
cp
ds_index
glob_module
ds_arity
ti
ts
(
e_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
(
reqs
,
ts
)
reqs
=
{
reqs
&
req_attr_coercions
=
tst_attr_env
++
reqs
.
req_attr_coercions
,
req_type_coercions
=
[{
tc_demanded
=
tst_result
,
tc_offered
=
e_type
,
tc_position
=
cp
,
tc_coercible
=
True
}
:
reqs
.
req_type_coercions
]
}
ts
=
{
ts
&
ts_expr_heap
=
storeAttribute
opt_expr_ptr
tst_result
.
at_attribute
ts
.
ts_expr_heap
}
=
case
opt_tuple_type
of
Yes
{
glob_object
={
ds_ident
,
ds_index
,
ds_arity
},
glob_module
}
#
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
ds_index
,
glob_module
=
glob_module
}
ds_ident
ds_arity
->
({
at_type
=
TA
tuple_type
tst_args
,
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
},
No
,
(
reqs
,
ts
))
No
->
(
hd
tst_args
,
No
,
(
reqs
,
ts
))
|
ds_arity
<>
1
#
tuple_type
=
MakeTypeSymbIdent
{
glob_object
=
PD_Arity2TupleTypeIndex
+(
ds_arity
-2
),
glob_module
=
cPredefinedModuleIndex
}
predefined_idents
.[
PD_Arity2TupleType
+(
ds_arity
-2
)]
ds_arity
=
({
at_type
=
TA
tuple_type
tst_args
,
at_attribute
=
TA_Unique
,
at_annotation
=
AN_None
},
No
,
(
reqs
,
ts
))
=
(
hd
tst_args
,
No
,
(
reqs
,
ts
))
requirements
_
(
AnyCodeExpr
_
_
_)
(
reqs
,
ts
)
#
(
fresh_v
,
ts
)
=
freshAttributedVariable
ts
=
(
fresh_v
,
No
,
(
reqs
,
ts
))
...
...
@@ -1580,6 +1577,8 @@ basicBoolType =: {box=TB BT_Bool}
basicRealType
=:
{
box
=
TB
BT_Real
}
basicStringType
=:
{
box
=
TA
(
MakeTypeSymbIdent
{
glob_object
=
PD_StringTypeIndex
,
glob_module
=
cPredefinedModuleIndex
}
predefined_idents
.[
PD_StringType
]
0
)
[]}
tuple2TypeSymbIdent
=:
MakeTypeSymbIdent
{
glob_object
=
PD_Arity2TupleTypeIndex
,
glob_module
=
cPredefinedModuleIndex
}
predefined_idents
.[
PD_Arity2TupleType
]
2
requirementsOfSelectors
ti
opt_expr
expr
[
selector
]
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
=
requirementsOfSelector
ti
opt_expr
expr
selector
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
requirementsOfSelectors
ti
opt_expr
expr
[
selector
:
selectors
]
tc_coercible
change_uselect
sel_expr_type
sel_expr
reqs_ts
...
...
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