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
f736c783
Commit
f736c783
authored
Apr 12, 2007
by
John van Groningen
Browse files
implement {# and {! in array comprehensions that create a new array
parent
cc1c5c8d
Changes
8
Hide whitespace changes
Inline
Side-by-side
frontend/checkFunctionBodies.icl
View file @
f736c783
...
...
@@ -1199,6 +1199,29 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
*/
=
(
generic_defs
,
{
e_state
&
es_generic_heap
=
es_generic_heap
})
checkExpression
free_vars
(
PE_TypeSignature
array_kind
expr
)
e_input
e_state
e_info
cs
#
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
=
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
predef_array_index
=
case
array_kind
of
UnboxedArray
->
PD_UnboxedArrayType
StrictArray
->
PD_StrictArrayType
({
pds_module
,
pds_def
},
cs
)
=
cs
!
cs_predef_symbols
.[
predef_array_index
]
#!
strict_array_ident
=
predefined_idents
.[
predef_array_index
]
#
type_prop
=
{
tsp_sign
=
BottomSignClass
,
tsp_propagation
=
NoPropClass
,
tsp_coercible
=
True
}
strict_array_type_symb_ident
=
{
type_ident
=
strict_array_ident
,
type_arity
=
1
,
type_index
={
glob_module
=
pds_module
,
glob_object
=
pds_def
},
type_prop
=
type_prop
}
expr
=
TypeSignature
(
make_fresh_strict_array_type
strict_array_type_symb_ident
)
expr
=
(
expr
,
free_vars
,
e_state
,
e_info
,
cs
)
where
make_fresh_strict_array_type
strict_array_type_symb_ident
var_store
attr_store
#
element_type_var
=
TempV
var_store
var_store
=
var_store
+1
element_type_attr_var
=
TA_TempVar
attr_store
attr_store
=
attr_store
+1
array_type_attr_var
=
TA_TempVar
attr_store
attr_store
=
attr_store
+1
element_type
=
{
at_attribute
=
element_type_attr_var
,
at_type
=
element_type_var
}
strict_array_type
=
{
at_attribute
=
array_type_attr_var
,
at_type
=
TA
strict_array_type_symb_ident
[
element_type
]}
=
(
strict_array_type
,
var_store
,
attr_store
)
checkExpression
free_vars
expr
e_input
e_state
e_info
cs
=
abort
"checkExpression (checkFunctionBodies.icl)"
// <<- expr
...
...
frontend/overloading.icl
View file @
f736c783
...
...
@@ -1521,6 +1521,8 @@ where
updateExpression
group_index
(
TupleSelect
symbol
argn_nr
expr
)
ui
#
(
expr
,
ui
)
=
updateExpression
group_index
expr
ui
=
(
TupleSelect
symbol
argn_nr
expr
,
ui
)
updateExpression
group_index
(
TypeSignature
_
expr
)
ui
=
updateExpression
group_index
expr
ui
updateExpression
group_index
expr
ui
=
(
expr
,
ui
)
...
...
frontend/parse.icl
View file @
f736c783
...
...
@@ -3145,10 +3145,10 @@ tail_strict_cons_and_nil_symbol_index HeadUnboxed = (PD_cons_uts,PD_nil_uts)
(List and Array) Comprehensions
*/
wantArrayComprehension :: !ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
wantArrayComprehension exp pState
wantArrayComprehension ::
!ArrayKind
!ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
wantArrayComprehension
array_kind
exp pState
# (qualifiers, pState) = wantQualifiers pState
= (PE_ArrayCompr exp qualifiers, wantToken FunctionContext "array comprehension" CurlyCloseToken pState)
= (PE_ArrayCompr
array_kind
exp qualifiers, wantToken FunctionContext "array comprehension" CurlyCloseToken pState)
wantListComprehension :: !Int !ParsedExpr !ParseState -> (!ParsedExpr, !ParseState)
wantListComprehension head_strictness exp pState
...
...
@@ -3322,8 +3322,8 @@ buildNodeDef lhsExpr rhsExpr
wantRecordOrArrayExp :: !Bool !ParseState -> (ParsedExpr, !ParseState)
wantRecordOrArrayExp is_pattern pState
# (token, pState) = nextToken FunctionContext pState
| is_pattern
# (token, pState) = nextToken FunctionContext pState
| token == SquareOpenToken
# (elems, pState) = want_array_assignments cIsAPattern pState
= (PE_ArrayPattern elems, wantToken FunctionContext "array selections in pattern" CurlyCloseToken pState)
...
...
@@ -3332,41 +3332,61 @@ wantRecordOrArrayExp is_pattern pState
// otherwise // is_pattern && token <> SquareOpenToken
= want_record_pattern token pState
// otherwise // ~ is_pattern
| token == CurlyCloseToken
= (PE_ArrayDenot [], pState)
# (opt_type, pState) = try_type_specification token pState
= case opt_type of
NoRecordName
# (succ, field, pState) = try_field_assignment token pState
| succ
# (token, pState) = nextToken FunctionContext pState
| token == CommaToken
# pState=appScanState setNoNewOffsideForSeqLetBit pState
# (token, pState) = nextToken FunctionContext pState
# pState=appScanState clearNoNewOffsideForSeqLetBit pState
= case token of
ExclamationToken
-> want_array_elems StrictArray pState
SeqLetToken False
-> want_array_elems UnboxedArray pState
CurlyCloseToken
-> (PE_ArrayDenot OverloadedArray [], pState)
_
# (opt_type, pState) = try_type_specification token pState
-> case opt_type of
NoRecordName
# (succ, field, pState) = try_field_assignment token pState
| succ
# (token, pState) = nextToken FunctionContext pState
(fields, pState) = want_field_assignments cIsNotAPattern token pState
-> (PE_Record PE_Empty NoRecordName [ field : fields ], wantToken FunctionContext "record or array" CurlyCloseToken pState)
| token == CurlyCloseToken
-> (PE_Record PE_Empty NoRecordName [ field ], pState)
-> (PE_Record PE_Empty NoRecordName [ field ], parseError "record or array" (Yes token) "}" pState)
# (expr, pState) = wantRhsExpressionT token pState
(token, pState) = nextToken FunctionContext pState
| token == AndToken
# (token, pState) = nextToken FunctionContext pState
-> want_record_or_array_update token expr pState
| token == DoubleBackSlashToken
-> wantArrayComprehension expr pState
# (elems, pState) = want_array_elems token pState
-> (PE_ArrayDenot [expr : elems], pState)
opt_type
-> want_record opt_type pState
| token == CommaToken
# (token, pState) = nextToken FunctionContext pState
(fields, pState) = want_field_assignments cIsNotAPattern token pState
-> (PE_Record PE_Empty NoRecordName [ field : fields ], wantToken FunctionContext "record or array" CurlyCloseToken pState)
| token == CurlyCloseToken
-> (PE_Record PE_Empty NoRecordName [ field ], pState)
-> (PE_Record PE_Empty NoRecordName [ field ], parseError "record or array" (Yes token) "}" pState)
# (expr, pState) = wantRhsExpressionT token pState
(token, pState) = nextToken FunctionContext pState
| token == AndToken
# (token, pState) = nextToken FunctionContext pState
-> want_record_or_array_update token expr pState
| token == DoubleBackSlashToken
-> wantArrayComprehension OverloadedArray expr pState
# (elems, pState) = want_more_array_elems token pState
-> (PE_ArrayDenot OverloadedArray [expr : elems], pState)
opt_type
-> want_record opt_type pState
where
want_array_elems CurlyCloseToken pState
want_array_elems array_kind pState
# (token, pState) = nextToken FunctionContext pState
| token == CurlyCloseToken
= (PE_ArrayDenot array_kind [], pState)
# (expr, pState) = wantRhsExpressionT token pState
(token, pState) = nextToken FunctionContext pState
| token == DoubleBackSlashToken
= wantArrayComprehension array_kind expr pState
# (elems, pState) = want_more_array_elems token pState
= (PE_ArrayDenot array_kind [expr:elems], pState)
want_more_array_elems CurlyCloseToken pState
= ([], pState)
want_array_elems CommaToken pState
want_
more_
array_elems CommaToken pState
# (elem, pState) = wantExpression cIsNotAPattern pState
(token, pState) = nextToken FunctionContext pState
(elems, pState) = want_array_elems token pState
(elems, pState) = want_
more_
array_elems token pState
= ([elem : elems], pState)
want_array_elems token pState
want_
more_
array_elems token pState
= ([], parseError "array elements" (Yes token) "<array denotation>" pState)
want_record_pattern (IdentToken name) pState
...
...
frontend/postparse.icl
View file @
f736c783
...
...
@@ -155,19 +155,22 @@ where
collectFunctions
(
PE_ListCompr
predef_cons_index
predef_nil_index
expr
qualifiers
)
icl_module
ca
#
(
compr
,
ca
)
=
transformListComprehension
predef_cons_index
predef_nil_index
expr
qualifiers
ca
=
collectFunctions
compr
icl_module
ca
collectFunctions
(
PE_ArrayCompr
expr
qualifiers
)
icl_module
ca
#
(
compr
,
ca
)
=
transformArrayComprehension
expr
qualifiers
ca
collectFunctions
(
PE_ArrayCompr
array_kind
expr
qualifiers
)
icl_module
ca
#
(
compr
,
ca
)
=
transformArrayComprehension
array_kind
expr
qualifiers
ca
=
collectFunctions
compr
icl_module
ca
collectFunctions
(
PE_UpdateComprehension
expr
updateExpr
identExpr
qualifiers
)
icl_module
ca
#
(
compr
,
ca
)
=
transformUpdateComprehension
[
expr
]
[
updateExpr
]
[
identExpr
]
identExpr
qualifiers
ca
=
collectFunctions
compr
icl_module
ca
collectFunctions
(
PE_Sequ
sequence
)
icl_module
ca
=
collectFunctions
(
transformSequence
sequence
)
icl_module
ca
collectFunctions
(
PE_ArrayDenot
exprs
)
icl_module
ca
=
collectFunctions
(
transformArrayDenot
exprs
)
icl_module
ca
collectFunctions
(
PE_ArrayDenot
array_kind
exprs
)
icl_module
ca
=
collectFunctions
(
transformArrayDenot
array_kind
exprs
)
icl_module
ca
collectFunctions
(
PE_Dynamic
exprs
opt_dyn_type
)
icl_module
ca
#
(
exprs
,
ca
)
=
collectFunctions
exprs
icl_module
ca
=
(
PE_Dynamic
exprs
opt_dyn_type
,
ca
)
collectFunctions
(
PE_TypeSignature
array_kind
expr
)
icl_module
ca
#
(
expr
,
ca
)
=
collectFunctions
expr
icl_module
ca
=
(
PE_TypeSignature
array_kind
expr
,
ca
)
collectFunctions
expr
icl_module
ca
=
(
expr
,
ca
)
...
...
@@ -753,7 +756,7 @@ transformUpdateQualifier :: [ParsedExpr] [ParsedExpr] Qualifier *CollectAdmin ->
transformUpdateQualifier
array
callArray
{
qual_generators
,
qual_let_defs
,
qual_filter
,
qual_position
,
qual_filename
}
ca
#
(
transformedGenerators
,
index_generator
,
ca
)
=
transformGenerators
qual_generators
qual_filename
No
ca
=
CreateTransformedQualifierFromTransformedGenerators
transformedGenerators
array
callArray
qual_let_defs
qual_filter
qual_position
qual_filename
ca
CreateTransformedQualifierFromTransformedGenerators
transformedGenerators
array
callArray
qual_let_defs
qual_filter
qual_position
qual_filename
ca
#
(
qual_fun_id
,
ca
)
=
prefixAndPositionToIdent
"cu"
qual_position
ca
=
({
tq_generators
=
transformedGenerators
...
...
@@ -781,13 +784,13 @@ transformListComprehension predef_cons_index predef_nil_index expr qualifiers ca
]
=
makeComprehensions
transformed_qualifiers
success
[]
ca
transformArrayComprehension
::
ParsedExpr
[
Qualifier
]
*
CollectAdmin
->
(
ParsedExpr
,
*
CollectAdmin
)
transformArrayComprehension
expr
qualifiers
ca
transformArrayComprehension
::
ArrayKind
ParsedExpr
[
Qualifier
]
*
CollectAdmin
->
(
ParsedExpr
,
*
CollectAdmin
)
transformArrayComprehension
array_kind
expr
qualifiers
ca
#
[
hd_qualifier
:_]
=
qualifiers
qual_position
=
hd_qualifier
.
qual_position
(
c_i_ident_exp
,
ca
)
=
prefixAndPositionToIdentExp
"c_i"
qual_position
ca
(
c_a_ident_exp
,
ca
)
=
prefixAndPositionToIdentExp
"c_a"
qual_position
ca
create_array
=
get_
predef_id
PD__CreateArrayFun
create_array
_expr
=
predef_id
ent_expr
PD__CreateArrayFun
|
same_index_for_update_and_array_generators
qualifiers
#
index_generator
=
{
gen_kind
=
IsListGenerator
,
gen_pattern
=
c_i_ident_exp
,
gen_expr
=
PE_Sequ
(
SQ_From
PD_From
(
PE_Basic
(
BVInt
0
))),
gen_position
=
qual_position
}
#
update
=
PE_Update
c_a_ident_exp
[
PS_Array
c_i_ident_exp
]
expr
...
...
@@ -795,17 +798,20 @@ transformArrayComprehension expr qualifiers ca
#
{
qual_generators
,
qual_let_defs
,
qual_filter
,
qual_position
,
qual_filename
}
=
hd_qualifier
#
qual_generators
=
[
index_generator
:
qual_generators
]
#
(
transformedGenerators
,
index_generator
,
size_exp
,
ca
)
=
transformGeneratorsAndReturnSize
qual_generators
qual_filename
No
PE_Empty
ca
#
new_array
=
PE_List
[
PE_Ident
create_array
,
size_exp
]
#
new_array
=
PE_List
[
create_array_expr
,
size_exp
]
new_array
=
cast_array_kind
array_kind
new_array
#
(
transformed_qualifier
,
ca
)
=
CreateTransformedQualifierFromTransformedGenerators
transformedGenerators
[
c_a_ident_exp
]
[
new_array
]
qual_let_defs
qual_filter
qual_position
qual_filename
ca
=
makeUpdateComprehensionFromTransFormedQualifiers
[
update
]
[
c_a_ident_exp
]
c_a_ident_exp
[
transformed_qualifier
]
ca
#
(
length
,
ca
)
=
computeSize
qualifiers
qual_position
hd_qualifier
.
qual_filename
ca
#
new_array
=
PE_List
[
PE_Ident
create_array
,
length
]
#
new_array
=
PE_List
[
create_array_expr
,
length
]
new_array
=
cast_array_kind
array_kind
new_array
qualifiers
=
[{
hd_qualifier
&
qual_generators
=
[
index_generator
:
hd_qualifier
.
qual_generators
]
}]
=
transformUpdateComprehension
[
new_array
]
[
update
]
[
c_a_ident_exp
]
c_a_ident_exp
qualifiers
ca
#
(
length
,
ca
)
=
computeSize
qualifiers
qual_position
hd_qualifier
.
qual_filename
ca
#
new_array
=
PE_List
[
PE_Ident
create_array
,
length
]
#
new_array
=
PE_List
[
create_array_expr
,
length
]
new_array
=
cast_array_kind
array_kind
new_array
#
inc
=
get_predef_id
PD_IncFun
new_array_and_index
=
[
new_array
,
PE_Basic
(
BVInt
0
)]
update
=
[
PE_Update
c_a_ident_exp
[
PS_Array
c_i_ident_exp
]
expr
,
PE_List
[
PE_Ident
inc
,
c_i_ident_exp
]]
...
...
@@ -993,12 +999,16 @@ transformArrayUpdate expr updates
update
updateIdent
{
bind_src
=
value
,
bind_dst
=
index
}
expr
=
updateIdent
`
expr
`
index
`
value
transformArrayDenot
::
[
ParsedExpr
]
->
ParsedExpr
transformArrayDenot
exprs
transformArrayDenot
::
ArrayKind
[
ParsedExpr
]
->
ParsedExpr
transformArrayDenot
array_kind
exprs
#
create_array_call
=
cast_array_kind
array_kind
(
predef_ident_expr
PD__CreateArrayFun
`
length
exprs
)
=
transformArrayUpdate
(
predef_ident_expr
PD__CreateArrayFun
`
length
exprs
)
create_array_call
[{
bind_dst
=
toParsedExpr
i
,
bind_src
=
expr
}
\\
expr
<-
exprs
&
i
<-
[
0
..]]
cast_array_kind
OverloadedArray
array_expr
=
array_expr
cast_array_kind
array_kind
array_expr
=
PE_TypeSignature
array_kind
array_expr
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
)
...
...
frontend/syntax.dcl
View file @
f736c783
...
...
@@ -1179,14 +1179,14 @@ instance toString KindInfo
|
PE_Record
!
ParsedExpr
!
OptionalRecordName
![
FieldAssignment
]
|
PE_ArrayPattern
![
ElemAssignment
]
|
PE_UpdateComprehension
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
![
Qualifier
]
|
PE_ArrayDenot
![
ParsedExpr
]
|
PE_ArrayDenot
!
ArrayKind
![
ParsedExpr
]
|
PE_Selection
!
ParsedSelectorKind
!
ParsedExpr
![
ParsedSelection
]
|
PE_Update
!
ParsedExpr
[
ParsedSelection
]
ParsedExpr
|
PE_Case
!
Ident
!
ParsedExpr
[
CaseAlt
]
|
PE_If
!
Ident
!
ParsedExpr
!
ParsedExpr
!
ParsedExpr
|
PE_Let
!
Bool
!
LocalDefs
!
ParsedExpr
|
PE_ListCompr
/*predef_cons_index:*/
!
Int
/*predef_nil_index:*/
!
Int
!
ParsedExpr
![
Qualifier
]
|
PE_ArrayCompr
!
ParsedExpr
![
Qualifier
]
|
PE_ArrayCompr
!
ArrayKind
!
ParsedExpr
![
Qualifier
]
|
PE_Sequ
Sequence
|
PE_WildCard
|
PE_Field
!
ParsedExpr
!(
Global
FieldSymbol
)
/* Auxiliary, used during checking */
...
...
@@ -1199,7 +1199,10 @@ instance toString KindInfo
|
PE_DynamicPattern
!
ParsedExpr
!
DynamicType
|
PE_Dynamic
!
ParsedExpr
!(
Optional
DynamicType
)
|
PE_Generic
!
Ident
!
TypeKind
/* AA: For generics, kind indexed identifier */
|
PE_Generic
!
Ident
!
TypeKind
/* AA: For generics, kind indexed identifier */
|
PE_TypeSignature
!
ArrayKind
!
ParsedExpr
|
PE_Empty
::
ParsedSelection
=
PS_Record
!
Ident
!
OptionalRecordName
...
...
@@ -1214,6 +1217,8 @@ instance toString KindInfo
::
ModuleIdent
:==
Ident
::
ArrayKind
=
OverloadedArray
|
StrictArray
|
UnboxedArray
;
::
GeneratorKind
=
IsListGenerator
|
IsOverloadedListGenerator
|
IsArrayGenerator
::
LineAndColumn
=
{
lc_line
::
!
Int
,
lc_column
::
!
Int
}
...
...
@@ -1278,6 +1283,8 @@ cIsNotStrict :== False
|
DynamicExpr
!
DynamicExpr
|
TypeCodeExpression
!
TypeCodeExpression
|
TypeSignature
!(
Int
Int
->
(
AType
,
Int
,
Int
))
!
Expression
|
EE
|
NoBind
ExprInfoPtr
/* auxiliary, to store fields that are not specified in a record expression */
|
FailExpr
!
Ident
// only allowed on (case) root positions
...
...
frontend/syntax.icl
View file @
f736c783
...
...
@@ -397,6 +397,7 @@ where
(<<<)
file
(
ClassVariable
info_ptr
)
=
file
<<<
"ClassVariable "
<<<
info_ptr
(<<<)
file
(
FailExpr
_)
=
file
<<<
"** FAIL **"
(<<<)
file
(
TypeSignature
array_kind
expr
)
=
file
<<<
"TypeSignature "
<<<
'('
<<<
expr
<<<
')'
(<<<)
file
expr
=
abort
(
"<<< (Expression) [line 1290]"
)
//<<- expr)
instance
<<<
LetBind
...
...
@@ -480,7 +481,7 @@ where
(<<<)
file
(
PE_Record
PE_Empty
_
fields
)
=
file
<<<
'{'
<<<
fields
<<<
'}'
(<<<)
file
(
PE_Record
rec
_
fields
)
=
file
<<<
'{'
<<<
rec
<<<
" & "
<<<
fields
<<<
'}'
(<<<)
file
(
PE_ListCompr
_
_
expr
quals
)
=
file
<<<
'['
<<<
expr
<<<
"
\\
"
<<<
quals
<<<
']'
(<<<)
file
(
PE_ArrayCompr
expr
quals
)
=
file
<<<
'{'
<<<
expr
<<<
"
\\
"
<<<
quals
<<<
'}'
(<<<)
file
(
PE_ArrayCompr
_
expr
quals
)
=
file
<<<
'{'
<<<
expr
<<<
"
\\
"
<<<
quals
<<<
'}'
(<<<)
file
(
PE_Sequ
seq
)
=
file
<<<
'['
<<<
seq
<<<
']'
(<<<)
file
PE_Empty
=
file
<<<
"** E **"
(<<<)
file
(
PE_Ident
symb
)
=
file
<<<
symb
...
...
frontend/transform.icl
View file @
f736c783
...
...
@@ -7,7 +7,7 @@ import syntax, check, StdCompare, utilities, mergecases; //, RWSDebug
,
ls_x
::
!.
LiftStateX
,
ls_expr_heap
::
!.
ExpressionHeap
}
::
LiftStateX
=
{
x_fun_defs
::
!.{#
FunDef
},
x_macro_defs
::
!.{#.{#
FunDef
}},
...
...
@@ -86,6 +86,9 @@ where
lift
(
DynamicExpr
expr
)
ls
#
(
expr
,
ls
)
=
lift
expr
ls
=
(
DynamicExpr
expr
,
ls
)
lift
(
TypeSignature
type_function
expr
)
ls
#
(
expr
,
ls
)
=
lift
expr
ls
=
(
TypeSignature
type_function
expr
,
ls
)
lift
expr
ls
=
(
expr
,
ls
)
...
...
@@ -432,6 +435,9 @@ where
unfold
(
DynamicExpr
expr
)
ui
us
#
(
expr
,
us
)
=
unfold
expr
ui
us
=
(
DynamicExpr
expr
,
us
)
unfold
(
TypeSignature
type_function
expr
)
ui
us
#
(
expr
,
us
)
=
unfold
expr
ui
us
=
(
TypeSignature
type_function
expr
,
us
)
unfold
expr
ui
us
=
(
expr
,
us
)
...
...
@@ -469,6 +475,7 @@ where
unfold
fv
=:{
fv_info_ptr
,
fv_ident
}
ui
us
=:{
us_var_heap
}
#
(
new_info_ptr
,
us_var_heap
)
=
newPtr
VI_Empty
us_var_heap
=
({
fv
&
fv_info_ptr
=
new_info_ptr
},
{
us
&
us_var_heap
=
writePtr
fv_info_ptr
(
VI_Variable
fv_ident
new_info_ptr
)
us_var_heap
})
instance
unfold
App
where
unfold
app
=:{
app_symb
={
symb_kind
},
app_args
,
app_info_ptr
}
ui
us
...
...
@@ -1234,6 +1241,8 @@ where
=
has_no_curried_macro_Expression
expr
has_no_curried_macro_Expression
(
MatchExpr
cons_ident
expr
)
=
has_no_curried_macro_Expression
expr
has_no_curried_macro_Expression
(
TypeSignature
_
expr
)
=
has_no_curried_macro_Expression
expr
has_no_curried_macro_Expression
expr
=
True
...
...
@@ -1609,6 +1618,9 @@ where
expand
(
DynamicExpr
dyn
)
ei
#
(
dyn
,
ei
)
=
expand
dyn
ei
=
(
DynamicExpr
dyn
,
ei
)
expand
(
TypeSignature
type_function
expr
)
ei
#
(
expr
,
ei
)
=
expand
expr
ei
=
(
TypeSignature
type_function
expr
,
ei
)
expand
expr
ei
=
(
expr
,
ei
)
...
...
@@ -2011,6 +2023,9 @@ where
collectVariables
(
DynamicExpr
dynamic_expr
)
free_vars
dynamics
cos
#
(
dynamic_expr
,
free_vars
,
dynamics
,
cos
)
=
collectVariables
dynamic_expr
free_vars
dynamics
cos
=
(
DynamicExpr
dynamic_expr
,
free_vars
,
dynamics
,
cos
);
collectVariables
(
TypeSignature
type_function
expr
)
free_vars
dynamics
cos
#
(
expr
,
free_vars
,
dynamics
,
cos
)
=
collectVariables
expr
free_vars
dynamics
cos
=
(
TypeSignature
type_function
expr
,
free_vars
,
dynamics
,
cos
);
collectVariables
expr
free_vars
dynamics
cos
=
(
expr
,
free_vars
,
dynamics
,
cos
)
...
...
frontend/type.icl
View file @
f736c783
...
...
@@ -1758,6 +1758,15 @@ where
requirements
_
(
ABCCodeExpr
_
_)
(
reqs
,
ts
)
#
(
fresh_v
,
ts
)
=
freshAttributedVariable
ts
=
(
fresh_v
,
No
,
(
reqs
,
ts
))
requirements
ti
(
TypeSignature
make_fresh_type_function
expr
)
(
reqs
,
ts
)
#
{
ts_var_store
,
ts_attr_store
}
=
ts
(
type
,
ts_var_store
,
ts_attr_store
)
=
make_fresh_type_function
ts_var_store
ts_attr_store
ts
=
{
ts
&
ts_var_store
=
ts_var_store
,
ts_attr_store
=
ts_attr_store
}
(
e_type
,
opt_expr_ptr
,
(
reqs
,
ts
))
=
requirements
ti
expr
(
reqs
,
ts
)
new_coercion
=
{
tc_demanded
=
type
,
tc_offered
=
e_type
,
tc_position
=
CP_Expression
expr
,
tc_coercible
=
True
}
reqs
=
{
reqs
&
req_type_coercions
=
[
new_coercion
:
reqs
.
req_type_coercions
]
}
ts
=
{
ts
&
ts_expr_heap
=
storeAttribute
opt_expr_ptr
type
.
at_attribute
ts
.
ts_expr_heap
}
=
(
type
,
No
,
(
reqs
,
ts
))
requirements
_
expr
reqs_ts
=
(
abort
(
"Error in requirements
\n
"
--->
expr
),
No
,
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