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
926a3213
Commit
926a3213
authored
Jun 17, 2002
by
John van Groningen
Browse files
removed ignored !'s
parent
1250249b
Changes
19
Hide whitespace changes
Inline
Side-by-side
frontend/analtypes.icl
View file @
926a3213
...
...
@@ -914,7 +914,7 @@ where
#!
(
kind
,
as_kind_heap
)
=
kindInfoToKind
kind_info
as_kind_heap
=
(
kind
,
{
as
&
as_kind_heap
=
as_kind_heap
,
as_type_var_heap
=
as_type_var_heap
})
check_kinds_of_generic_vars
::
![
TypeKind
]
!*
AnalyseState
->
!
*
AnalyseState
check_kinds_of_generic_vars
::
![
TypeKind
]
!*
AnalyseState
->
*
AnalyseState
check_kinds_of_generic_vars
[
gen_kind
:
gen_kinds
]
as
//| all (\k -> k == gen_kind) gen_kinds
|
all
((==)
KindConst
)
[
gen_kind
:
gen_kinds
]
// forcing all kind variables be of kind star
...
...
@@ -925,7 +925,7 @@ where
as
.
as_error
=
{
as
&
as_error
=
as_error
}
check_kinds_of_gencases
::
!
Index
!{#
GenericCaseDef
}
!*
AnalyseState
->
!
*
AnalyseState
check_kinds_of_gencases
::
!
Index
!{#
GenericCaseDef
}
!*
AnalyseState
->
*
AnalyseState
check_kinds_of_gencases
index
gencases
as
|
index
==
size
gencases
=
as
...
...
frontend/check.icl
View file @
926a3213
...
...
@@ -274,7 +274,7 @@ where
#
(
dcl_mod
,
modules
)
=
modules
![
gi_module
]
=
(
dcl_mod
.
dcl_common
.
com_generic_defs
.[
gi_index
],
generic_defs
,
modules
)
add_case_to_generic
::
!
GenericDef
!
GlobalIndex
!*
Heaps
->
!
*
Heaps
add_case_to_generic
::
!
GenericDef
!
GlobalIndex
!*
Heaps
->
*
Heaps
add_case_to_generic
{
gen_info_ptr
}
index
heaps
=:{
hp_generic_heap
}
#
(
info
=:{
gen_cases
},
hp_generic_heap
)
=
readPtr
gen_info_ptr
hp_generic_heap
#
info
=
{
info
&
gen_cases
=
[
index
:
gen_cases
]}
...
...
frontend/checkFunctionBodies.icl
View file @
926a3213
...
...
@@ -291,7 +291,7 @@ where
transform_pattern_into_cases
(
AP_Empty
name
)
fun_arg
result_expr
pattern_position
var_store
expr_heap
opt_dynamics
cs
=
(
result_expr
,
pattern_position
,
var_store
,
expr_heap
,
opt_dynamics
,
cs
)
transform_pattern_variable
::
!
FreeVar
!(
Optional
!
(
Bind
Ident
VarInfoPtr
))
!
Expression
!*
ExpressionHeap
transform_pattern_variable
::
!
FreeVar
!(
Optional
(
Bind
Ident
VarInfoPtr
))
!
Expression
!*
ExpressionHeap
->
(!
Expression
,
!
Expression
,
!*
ExpressionHeap
)
transform_pattern_variable
{
fv_info_ptr
,
fv_name
}
(
Yes
{
bind_src
,
bind_dst
})
result_expr
expr_heap
|
bind_dst
==
fv_info_ptr
...
...
@@ -1664,7 +1664,7 @@ checkBoundPattern {bind_src,bind_dst} opt_var p_input (var_env, array_patterns)
->
checkPattern
bind_src
(
Yes
{
bind_src
=
bind_dst
,
bind_dst
=
new_info_ptr
})
p_input
(
new_var_env
,
array_patterns
)
ps
e_info
cs
=
checkPattern
bind_src
opt_var
p_input
(
var_env
,
array_patterns
)
ps
e_info
{
cs
&
cs_error
=
checkError
bind_dst
"variable expected"
cs
.
cs_error
}
checkPatternVariable
::
!
Level
!
SymbolTableEntry
!
Ident
!
VarInfoPtr
!*
CheckState
->
!
*
CheckState
checkPatternVariable
::
!
Level
!
SymbolTableEntry
!
Ident
!
VarInfoPtr
!*
CheckState
->
*
CheckState
checkPatternVariable
def_level
entry
=:{
ste_def_level
,
ste_kind
}
ident
=:{
id_info
}
var_info
cs
=:{
cs_symbol_table
,
cs_error
}
|
ste_kind
==
STE_Empty
||
def_level
>
ste_def_level
#
entry
=
{
ste_kind
=
STE_Variable
var_info
,
ste_index
=
NoIndex
,
ste_def_level
=
def_level
,
ste_previous
=
entry
}
...
...
frontend/checktypes.icl
View file @
926a3213
...
...
@@ -297,7 +297,7 @@ where
// ---> ("bind_types_of_constructors", cons_def.cons_symb, exi_vars, cons_type)
where
bind_types_of_cons
::
![
AType
]
!
CurrentTypeInfo
![
TypeVar
]
![
AttrInequality
]
!(!*
TypeSymbols
,
!*
TypeInfo
,
!*
CheckState
)
->
!
(![
AType
],
![[
ATypeVar
]],
![
AttrInequality
],
!(!*
TypeSymbols
,
!*
TypeInfo
,
!*
CheckState
))
->
(![
AType
],
![[
ATypeVar
]],
![
AttrInequality
],
!(!*
TypeSymbols
,
!*
TypeInfo
,
!*
CheckState
))
bind_types_of_cons
[]
cti
free_vars
attr_env
ts_ti_cs
=
([],
[],
attr_env
,
ts_ti_cs
)
bind_types_of_cons
[
type
:
types
]
cti
free_vars
attr_env
ts_ti_cs
...
...
frontend/comparedefimp.icl
View file @
926a3213
...
...
@@ -354,7 +354,7 @@ where
}
::
TypesCorrespondMonad
:==
!
*
TypesCorrespondState
->
*(!
Bool
,
!*
TypesCorrespondState
)
:==
*
TypesCorrespondState
->
*(!
Bool
,
!*
TypesCorrespondState
)
::
ExpressionsCorrespondState
=
{
ec_icl_correspondences
::
!.{#
Int
},
...
...
@@ -369,7 +369,7 @@ where
}
::
ExpressionsCorrespondMonad
:==
!
*
ExpressionsCorrespondState
->
*
ExpressionsCorrespondState
:==
*
ExpressionsCorrespondState
->
*
ExpressionsCorrespondState
::
Conversions
:==
{#
Index
}
...
...
frontend/convertDynamics.dcl
View file @
926a3213
...
...
@@ -6,8 +6,8 @@ definition module convertDynamics
import
syntax
,
transform
,
convertcases
convertDynamicPatternsIntoUnifyAppls
::
{!
GlobalTCType
}
!{#
CommonDefs
}
!
Int
!*{!
Group
}
!*{#
FunDef
}
!*
PredefinedSymbols
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
(
Optional
!
*
File
)
{#
DclModule
}
!
IclModule
/* TD */
[
String
]
->
(!*{!
Group
},
!*{#
FunDef
},
!*
PredefinedSymbols
,
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
,
Optional
!
*
File
)
convertDynamicPatternsIntoUnifyAppls
::
{!
GlobalTCType
}
!{#
CommonDefs
}
!
Int
!*{!
Group
}
!*{#
FunDef
}
!*
PredefinedSymbols
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
(
Optional
*
File
)
{#
DclModule
}
!
IclModule
/* TD */
[
String
]
->
(!*{!
Group
},
!*{#
FunDef
},
!*
PredefinedSymbols
,
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
,
Optional
*
File
)
/*
convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !*{! Group} !*{#FunDef} !*PredefinedSymbols
...
...
frontend/convertDynamics.icl
View file @
926a3213
...
...
@@ -35,7 +35,7 @@ from type_io_common import class toString (..),instance toString GlobalTCType;
,
ci_module_id_symbol
::
Expression
,
ci_internal_type_id
::
Expression
,
ci_module_id
::
Optional
LetBind
,
ci_type_id
::
!
Optional
!
TypeSymbIdent
,
ci_type_id
::
!
Optional
TypeSymbIdent
,
ci_type_constructor_used_in_dynamic_patterns
::
!*{#
Bool
}
}
...
...
@@ -129,8 +129,8 @@ f (Yes tcl_file)
= tcl_file;
0.2*/
convertDynamicPatternsIntoUnifyAppls
::
{!
GlobalTCType
}
!{#
CommonDefs
}
!
Int
!*{!
Group
}
!*{#
FunDef
}
!*
PredefinedSymbols
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
(
Optional
!
*
File
)
{#
DclModule
}
!
IclModule
[
String
]
->
(!*{!
Group
},
!*{#
FunDef
},
!*
PredefinedSymbols
,
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
,
(
Optional
!
*
File
))
convertDynamicPatternsIntoUnifyAppls
::
{!
GlobalTCType
}
!{#
CommonDefs
}
!
Int
!*{!
Group
}
!*{#
FunDef
}
!*
PredefinedSymbols
!*
VarHeap
!*
TypeHeaps
!*
ExpressionHeap
(
Optional
*
File
)
{#
DclModule
}
!
IclModule
[
String
]
->
(!*{!
Group
},
!*{#
FunDef
},
!*
PredefinedSymbols
,
!*{#{#
CheckedTypeDef
}},
!
ImportedConstructors
,
!*
VarHeap
,
!*
TypeHeaps
,
!*
ExpressionHeap
,
(
Optional
*
File
))
convertDynamicPatternsIntoUnifyAppls
global_type_instances
common_defs
main_dcl_module_n
groups
fun_defs
predefined_symbols
var_heap
type_heaps
expr_heap
tcl_file
dcl_mods
icl_mod
directly_imported_dcl_modules
#
({
pds_module
,
pds_def
}
,
predefined_symbols
)
=
predefined_symbols
![
PD_StdDynamic
]
#!
(
dynamic_temp_symb_ident
,
ci_sel_value_field
,
ci_sel_type_field
,
predefined_symbols
)
...
...
frontend/generics1.icl
View file @
926a3213
...
...
@@ -463,7 +463,7 @@ where
build_void
=
abort
"sanity check: no alternatives in a type
\n
"
// build a product of types
buildProductType
::
![
AType
]
!
PredefinedSymbols
->
!
AType
buildProductType
::
![
AType
]
!
PredefinedSymbols
->
AType
buildProductType
types
predefs
=
listToBin
build_pair
build_unit
types
where
...
...
@@ -471,7 +471,7 @@ where
build_unit
=
buildPredefTypeApp
PD_TypeUNIT
[]
predefs
// build a sum of types
buildSumType
::
![
AType
]
!
PredefinedSymbols
->
!
AType
buildSumType
::
![
AType
]
!
PredefinedSymbols
->
AType
buildSumType
types
predefs
=
listToBin
build_either
build_void
types
where
...
...
@@ -487,7 +487,7 @@ listToBin bin tip xs
=
bin
(
listToBin
bin
tip
l
)
(
listToBin
bin
tip
r
)
// build application of a predefined type constructor
buildPredefTypeApp
::
!
Int
[
AType
]
!
PredefinedSymbols
->
!
AType
buildPredefTypeApp
::
!
Int
[
AType
]
!
PredefinedSymbols
->
AType
buildPredefTypeApp
predef_index
args
predefs
#
{
pds_module
,
pds_def
}
=
predefs
.[
predef_index
]
#
pds_ident
=
predefined_idents
.[
predef_index
]
...
...
@@ -1078,7 +1078,7 @@ where
// build kind indexed classes
//****************************************************************************************
buildClasses
::
!*
GenericState
->
!
*
GenericState
buildClasses
::
!*
GenericState
->
*
GenericState
buildClasses
gs
=:{
gs_modules
,
gs_main_module
}
#!
(
common_defs
=:{
com_class_defs
,
com_member_defs
},
gs_modules
)
=
gs_modules
!
[
gs_main_module
]
#!
num_classes
=
size
com_class_defs
...
...
@@ -2032,7 +2032,7 @@ buildGenericCaseBody main_module_index {gc_name,gc_pos} st predefs td_infos modu
// convert generic type contexts into normal type contexts
//****************************************************************************************
convertGenericTypeContexts
::
!*
GenericState
->
!
*
GenericState
convertGenericTypeContexts
::
!*
GenericState
->
*
GenericState
convertGenericTypeContexts
gs
=:{
gs_main_module
,
gs_used_modules
,
gs_predefs
,
gs_funs
,
gs_modules
,
gs_dcl_modules
,
gs_error
,
gs_avarh
,
gs_tvarh
,
gs_exprh
,
gs_varh
,
gs_genh
}
...
...
@@ -2490,10 +2490,10 @@ reportWarning name pos msg error=:{ea_file}
//****************************************************************************************
// Type Helpers
//****************************************************************************************
makeAType
::
!
Type
!
TypeAttribute
->
!
AType
makeAType
::
!
Type
!
TypeAttribute
->
AType
makeAType
type
attr
=
{
at_attribute
=
attr
,
at_type
=
type
}
makeATypeVar
::
!
TypeVar
!
TypeAttribute
->
!
ATypeVar
makeATypeVar
::
!
TypeVar
!
TypeAttribute
->
ATypeVar
makeATypeVar
tv
attr
=
{
atv_variable
=
tv
,
atv_attribute
=
attr
}
//----------------------------------------------------------------------------------------
...
...
@@ -2744,11 +2744,11 @@ where
_
->
abort
(
"freshSymbolType, invalid av_info
\n
"
--->
av_info
)
=
(
av
,
{
th
&
th_attrs
=
th_attrs
})
assertSymbolType
::
!
SymbolType
!*
TypeHeaps
->
!
*
TypeHeaps
assertSymbolType
::
!
SymbolType
!*
TypeHeaps
->
*
TypeHeaps
assertSymbolType
{
st_args
,
st_result
,
st_context
}
th
=
foldType
on_type
on_atype
((
st_args
,
st_result
),
st_context
)
th
where
on_type
::
!
Type
!*
TypeHeaps
->
!
*
TypeHeaps
on_type
::
!
Type
!*
TypeHeaps
->
*
TypeHeaps
on_type
(
TV
tv
)
th
=:{
th_vars
}
#!
(
tv_info
,
th_vars
)
=
readPtr
tv
.
tv_info_ptr
th_vars
#!
th
=
{
th
&
th_vars
=
th_vars
}
...
...
@@ -2778,7 +2778,7 @@ where
_
->
(
abort
"TFA tv_info not empty
\n
"
)
--->(
tv
,
tv_info
)
on_type
_
th
=
th
on_atype
::
!
AType
!*
TypeHeaps
->
!
*
TypeHeaps
on_atype
::
!
AType
!*
TypeHeaps
->
*
TypeHeaps
on_atype
{
at_attribute
=
TA_Var
av
}
th
=:{
th_attrs
}
#!
(
av_info
,
th_attrs
)
=
readPtr
av
.
av_info_ptr
th_attrs
#!
th
=
{
th
&
th_attrs
=
th_attrs
}
...
...
@@ -3024,7 +3024,7 @@ markAttrVarUsed {av_info_ptr} th_attrs
AVI_Used
->
(
True
,
th_attrs
)
simplifyTypeApp
::
!
Type
![
AType
]
->
!
Type
simplifyTypeApp
::
!
Type
![
AType
]
->
Type
simplifyTypeApp
(
TA
type_cons
=:{
type_arity
}
cons_args
)
type_args
=
TA
{
type_cons
&
type_arity
=
type_arity
+
length
type_args
}
(
cons_args
++
type_args
)
simplifyTypeApp
(
TAS
type_cons
=:{
type_arity
}
cons_args
strictness
)
type_args
...
...
frontend/genericsupport.dcl
View file @
926a3213
...
...
@@ -5,12 +5,12 @@ import syntax, checksupport
lookupGenericClassInfo
::
!
TypeKind
!
GenericClassInfos
->
!
(
Optional
GenericClassInfo
)
->
(
Optional
GenericClassInfo
)
addGenericClassInfo
::
!
GenericClassInfo
!
GenericClassInfos
->
!
GenericClassInfos
->
GenericClassInfos
getGenericClassInfo
::
!(
Global
Index
)
...
...
@@ -45,8 +45,8 @@ getGenericClass ::
//****************************************************************************************
// Ident Helpers
//****************************************************************************************
makeIdent
::
!
String
->
!
Ident
postfixIdent
::
!
Ident
!
String
->
!
Ident
genericIdentToClassIdent
::
!
Ident
!
TypeKind
->
!
Ident
genericIdentToMemberIdent
::
!
Ident
!
TypeKind
->
!
Ident
genericIdentToFunIdent
::
!
Ident
!
TypeCons
->
!
Ident
makeIdent
::
!
String
->
Ident
postfixIdent
::
!
Ident
!
String
->
Ident
genericIdentToClassIdent
::
!
Ident
!
TypeKind
->
Ident
genericIdentToMemberIdent
::
!
Ident
!
TypeKind
->
Ident
genericIdentToFunIdent
::
!
Ident
!
TypeCons
->
Ident
frontend/genericsupport.icl
View file @
926a3213
...
...
@@ -52,7 +52,7 @@ getGenericClass gen kind modules generic_heap
->
(
Yes
class_glob
,
generic_heap
)
lookupGenericClassInfo
::
!
TypeKind
!
GenericClassInfos
->
!
(
Optional
GenericClassInfo
)
lookupGenericClassInfo
::
!
TypeKind
!
GenericClassInfos
->
(
Optional
GenericClassInfo
)
lookupGenericClassInfo
kind
class_infos
#!
hash_index
=
case
kind
of
KindConst
->
0
...
...
@@ -64,7 +64,7 @@ where
|
gci
.
gci_kind
==
kind
=
Yes
gci
=
lookup
kind
gcis
addGenericClassInfo
::
!
GenericClassInfo
!
GenericClassInfos
->
!
GenericClassInfos
addGenericClassInfo
::
!
GenericClassInfo
!
GenericClassInfos
->
GenericClassInfos
addGenericClassInfo
class_info
=:{
gci_kind
}
class_infos
#!
hash_index
=
case
gci_kind
of
KindConst
->
0
...
...
@@ -76,13 +76,13 @@ addGenericClassInfo class_info=:{gci_kind} class_infos
//****************************************************************************************
// Ident Helpers
//****************************************************************************************
makeIdent
::
!
String
->
!
Ident
makeIdent
::
!
String
->
Ident
makeIdent
str
=
{
id_name
=
str
,
id_info
=
nilPtr
}
postfixIdent
::
!
Ident
!
String
->
!
Ident
postfixIdent
::
!
Ident
!
String
->
Ident
postfixIdent
{
id_name
}
postfix
=
makeIdent
(
id_name
+++
postfix
)
genericIdentToClassIdent
::
!
Ident
!
TypeKind
->
!
Ident
genericIdentToClassIdent
::
!
Ident
!
TypeKind
->
Ident
genericIdentToClassIdent
gen_name
kind
=
postfixIdent
gen_name
(
"_"
+++
kind_to_str
kind
)
where
...
...
@@ -93,11 +93,11 @@ where
kinds_to_str
[
KindConst
:
ks
]
=
"s"
+++
kinds_to_str
ks
kinds_to_str
[
k
:
ks
]
=
"o"
+++
(
kind_to_str
k
)
+++
"c"
+++
kinds_to_str
ks
genericIdentToMemberIdent
::
!
Ident
!
TypeKind
->
!
Ident
genericIdentToMemberIdent
::
!
Ident
!
TypeKind
->
Ident
genericIdentToMemberIdent
gen_name
kind
=
genericIdentToClassIdent
gen_name
kind
genericIdentToFunIdent
::
!
Ident
!
TypeCons
->
!
Ident
genericIdentToFunIdent
::
!
Ident
!
TypeCons
->
Ident
genericIdentToFunIdent
gen_name
type_cons
=
postfixIdent
gen_name
(
"_"
+++
type_cons_to_str
type_cons
)
where
...
...
frontend/overloading.icl
View file @
926a3213
...
...
@@ -1737,14 +1737,14 @@ where
},
{
ui
&
ui_local_vars
=
[
cyclic_fv
:
ui
.
ui_local_vars
]})
getSymbol
::
!
Int
!(
!
(
Global
!
Int
)
->
!
SymbKind
)
!*
UpdateInfo
->
(
SymbIdent
,*
UpdateInfo
)
getSymbol
::
!
Int
!((
Global
Int
)
->
SymbKind
)
!*
UpdateInfo
->
(
SymbIdent
,*
UpdateInfo
)
getSymbol
index
symb_kind
ui
=:{
ui_x
}
#
({
pds_module
,
pds_def
},
ui_x
)
=
ui_x
!
x_predef_symbols
.[
index
]
#
pds_ident
=
predefined_idents
.[
index
]
symbol
=
{
symb_name
=
pds_ident
,
symb_kind
=
symb_kind
{
glob_module
=
pds_module
,
glob_object
=
pds_def
}
}
=
(
symbol
,
{
ui
&
ui_x
=
ui_x
})
get_constructor
::
!
Int
!*
UpdateInfo
->
!
(!
Expression
,!*
UpdateInfo
)
get_constructor
::
!
Int
!*
UpdateInfo
->
(!
Expression
,!*
UpdateInfo
)
get_constructor
index
ui
=:{
ui_x
=
{
x_type_code_info
={
tci_instances
}}}
/*
** MV
...
...
frontend/parse.icl
View file @
926a3213
...
...
@@ -375,7 +375,7 @@ where
=
try_module_token
MK_System
scanState
=
(
False
,
MK_None
,
""
,
tokenBack
scanState
)
try_module_token
::
!
ModuleKind
!
ScanState
->
(!
Bool
,!
ModuleKind
!
,!
String
,!
ScanState
)
try_module_token
::
!
ModuleKind
!
ScanState
->
(!
Bool
,!
ModuleKind
,!
String
,!
ScanState
)
try_module_token
mod_type
scanState
#
(
token
,
scanState
)
=
nextToken
GeneralContext
scanState
|
token
==
ModuleToken
...
...
@@ -984,7 +984,7 @@ where
default_found
(
GuardedAlts
_
No
)
=
False
default_found
_
=
True
want_OptExprWithLocals
::
!
Bool
!
Token
![
NodeDefWithLocals
]
!
RhsDefiningSymbol
!
ParseState
->
(!
Optional
!
ExprWithLocalDefs
,
!
RhsDefiningSymbol
,
!
ParseState
)
want_OptExprWithLocals
::
!
Bool
!
Token
![
NodeDefWithLocals
]
!
RhsDefiningSymbol
!
ParseState
->
(!
Optional
ExprWithLocalDefs
,
!
RhsDefiningSymbol
,
!
ParseState
)
// want_OptExprWithLocals withExpected DoubleArrowToken nodeDefs pState
// = want_OptExprWithLocals True EqualToken nodeDefs (replaceToken EqualToken pState)
want_OptExprWithLocals
withExpected
token
nodeDefs
definingSymbol
pState
...
...
@@ -3758,7 +3758,7 @@ wantBeginGroup msg pState
_ -> parseError msg (Yes token) "begin group without layout, {," pState
// AA..
wantKind :: !ParseState ->
!
(!TypeKind, !ParseState)
wantKind :: !ParseState -> (!TypeKind, !ParseState)
wantKind pState
| SwitchGenerics False True
= (KindConst, parseErrorSimple "kind" "generics are not supported by this compiler" pState)
...
...
frontend/postparse.icl
View file @
926a3213
...
...
@@ -102,7 +102,7 @@ addFunctionsRange fun_defs ca
=
ca
!
ca_fun_count
=
({
ir_from
=
frm
,
ir_to
=
to
},
ca
)
where
add_function
::
FunDef
!*
CollectAdmin
->
!
*
CollectAdmin
add_function
::
FunDef
!*
CollectAdmin
->
*
CollectAdmin
add_function
fun_def
ca
=:{
ca_fun_count
,
ca_rev_fun_defs
}
=
{
ca
&
ca_fun_count
=
ca
.
ca_fun_count
+
1
,
ca_rev_fun_defs
=
[
fun_def
:
ca
.
ca_rev_fun_defs
]
...
...
frontend/trans.icl
View file @
926a3213
...
...
@@ -2029,7 +2029,7 @@ where
determine_args
::
![
Bool
]
![
ConsClass
]
!
Index
!{!
Producer
}
![
Optional
SymbolType
]
![
FreeVar
]
!
ReadOnlyTI
!*
DetermineArgsState
->
!
*
DetermineArgsState
->
*
DetermineArgsState
determine_args
_
[]
prod_index
producers
prod_atypes
forms
_
das
=:{
das_var_heap
}
#
(
vars
,
das_var_heap
)
=
new_variables
forms
das_var_heap
=
{
das
&
das_vars
=
vars
,
das_var_heap
=
das_var_heap
}
...
...
@@ -2049,7 +2049,7 @@ determine_args [linear_bit : linear_bits] [cons_arg : cons_args] prod_index prod
determine_arg
::
!
Producer
.(
Optional
SymbolType
)
!
FreeVar
.
Int
!(!(!
Bool
,!
ConsClass
),!
ReadOnlyTI
)
!*
DetermineArgsState
->
!
*
DetermineArgsState
->
*
DetermineArgsState
determine_arg
PR_Empty
_
form
=:{
fv_name
,
fv_info_ptr
}
_
((
linear_bit
,
cons_arg
),
_)
das
=:{
das_var_heap
}
#
(
new_info_ptr
,
das_var_heap
)
=
newPtr
VI_Empty
das_var_heap
...
...
frontend/transform.icl
View file @
926a3213
...
...
@@ -1820,7 +1820,7 @@ where
bindings introduced in a 'let' are removed.
*/
class
collectVariables
a
::
!
a
![
FreeVar
]
!*
CollectState
->
!
(!
a
,
![
FreeVar
],!*
CollectState
)
class
collectVariables
a
::
!
a
![
FreeVar
]
!*
CollectState
->
(!
a
,
![
FreeVar
],!*
CollectState
)
cContainsACycle
:==
True
cContainsNoCycle
:==
False
...
...
frontend/type.icl
View file @
926a3213
...
...
@@ -818,7 +818,7 @@ freshSymbolType is_appl fresh_context_vars st=:{st_vars,st_args,st_result,st_con
=
(
attr_heap
<:=
(
av_info_ptr
,
AVI_Attr
(
TA_TempVar
attr_store
)),
inc
attr_store
)
clear_attributes
::
[
AttributeVar
]
!*
AttrVarHeap
->
!
*
AttrVarHeap
clear_attributes
::
[
AttributeVar
]
!*
AttrVarHeap
->
*
AttrVarHeap
clear_attributes
attributes
attr_heap
=
foldSt
clear_attribute
attributes
attr_heap
where
...
...
frontend/type_io.dcl
View file @
926a3213
...
...
@@ -3,7 +3,7 @@
*/
definition
module
type_io
openTclFile
::
!
Bool
!
String
!*
Files
->
(
Optional
!
.
File
,
!*
Files
)
openTclFile
::
!
Bool
!
String
!*
Files
->
(
Optional
.
File
,
!*
Files
)
closeTclFile
::
!*(
Optional
*
File
)
*
Files
->
*(!
Bool
,*
Files
)
baseName
::
{#
Char
}
->
{#
Char
}
...
...
frontend/type_io.icl
View file @
926a3213
...
...
@@ -500,7 +500,7 @@ where
// MV ...
from
CoclSystemDependent
import
DirectorySeparator
,
ensureCleanSystemFilesExists
openTclFile
::
!
Bool
!
String
!*
Files
->
(
Optional
!
.
File
,
!*
Files
)
openTclFile
::
!
Bool
!
String
!*
Files
->
(
Optional
.
File
,
!*
Files
)
openTclFile
False
icl_mod_pathname
files
=
(
No
,
files
)
openTclFile
compile_for_dynamics
icl_mod_pathname
files
...
...
frontend/typesupport.icl
View file @
926a3213
...
...
@@ -1548,7 +1548,7 @@ getImplicitAttrInequalities st=:{st_args, st_result}
ineqs2
=
get_ineqs_of_atype
st_result
=
uniqueBagToList
(
Pair
ineqs1
ineqs2
)
where
get_ineqs_of_atype
::
!
AType
->
!
.
Bag
AttrInequality
get_ineqs_of_atype
::
!
AType
->
.
Bag
AttrInequality
get_ineqs_of_atype
{
at_attribute
=
TA_Var
outer_av
,
at_type
=
at_type
=:
TA
type_symb_ident
type_args
}
=
get_ineqs_of_TA_with_TA_Var
outer_av
at_type
type_symb_ident
type_args
get_ineqs_of_atype
{
at_attribute
=
TA_Var
outer_av
,
at_type
=
at_type
=:
TAS
type_symb_ident
type_args
_}
...
...
@@ -1669,7 +1669,7 @@ beautifulizeAttributes symbol_type th_attrs
=
foldSt
add_unvisited_node
descendants
(
xs
,
visited
)
=
searchPath
xs
goal
(
visited
,
coer_demanded
)
add_unvisited_node
::
!
Int
!(![
Int
],
!
u
:{#
Bool
})
->
!
(![
Int
],
!
u
:{#
Bool
})
add_unvisited_node
::
!
Int
!(![
Int
],
!
u
:{#
Bool
})
->
(![
Int
],
!
u
:{#
Bool
})
add_unvisited_node
candidate
(
accu
,
visited
)
|
visited
.[
candidate
]
=
(
accu
,
visited
)
...
...
@@ -1851,7 +1851,7 @@ removeInequality offered demanded attr_env_coercions=:{coer_offered, coer_demand
coer_demanded
=
appCoercionTree
(
removeNode
demanded
)
offered
coer_demanded
=
{
attr_env_coercions
&
coer_demanded
=
coer_demanded
,
coer_offered
=
coer_offered
}
removeNode
::
!
Int
!*
CoercionTree
->
!
.
CoercionTree
removeNode
::
!
Int
!*
CoercionTree
->
.
CoercionTree
removeNode
i1
(
CT_Node
i2
left
right
)
|
i1
<
i2
=
CT_Node
i2
(
removeNode
i1
left
)
right
...
...
@@ -1859,7 +1859,7 @@ removeNode i1 (CT_Node i2 left right)
=
CT_Node
i2
left
(
removeNode
i1
right
)
=
rightInsert
left
right
where
rightInsert
::
!*
CoercionTree
!*
CoercionTree
->
!
.
CoercionTree
rightInsert
::
!*
CoercionTree
!*
CoercionTree
->
.
CoercionTree
rightInsert
CT_Empty
right
=
right
rightInsert
(
CT_Node
i
left
right2
)
right1
...
...
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