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
5f0679df
Commit
5f0679df
authored
Jan 14, 2009
by
John van Groningen
Browse files
add seq
parent
f36dcd61
Changes
15
Hide whitespace changes
Inline
Side-by-side
backendC/CleanCompilerSources/backend.c
View file @
5f0679df
...
...
@@ -583,8 +583,13 @@ BEBindSpecialFunction (BESpecialIdentIndex index, int functionIndex, int moduleI
Assert
((
unsigned
int
)
functionIndex
<
module
->
bem_nFunctions
);
functionSymbol
=
&
module
->
bem_functions
[
functionIndex
];
if
(
functionSymbol
->
symb_kind
==
definition
)
if
(
functionSymbol
->
symb_kind
==
definition
)
{
*
gSpecialIdents
[
index
]
=
functionSymbol
->
symb_def
->
sdef_ident
;
if
(
index
==
BESpecialIdentSeq
&&
moduleIndex
!=
main_dcl_module_n
){
functionSymbol
->
symb_kind
=
seq_symb
;
}
}
}
/* BEBindSpecialFunction */
extern
SymbDefP
special_types
[];
/* defined in statesgen */
...
...
@@ -3630,7 +3635,6 @@ CheckBEEnumTypes (void)
Assert
(
apply_symb
==
BEApplySymb
);
Assert
(
if_symb
==
BEIfSymb
);
Assert
(
fail_symb
==
BEFailSymb
);
Assert
(
all_symb
==
BEAllSymb
);
Assert
(
select_symb
==
BESelectSymb
);
Assert
(
Nr_Of_Predef_FunsOrConses
==
BENrOfPredefFunsOrConses
);
Assert
(
definition
==
BEDefinition
);
...
...
@@ -3787,6 +3791,11 @@ BEInit (int argc)
gSpecialIdents
[
BESpecialIdentAnd
]
=
&
AndId
;
gSpecialIdents
[
BESpecialIdentOr
]
=
&
OrId
;
PreludeId
=
Identifier
(
"Prelude"
);
seq_id
=
NULL
;
gSpecialIdents
[
BESpecialIdentPrelude
]
=
&
PreludeId
;
gSpecialIdents
[
BESpecialIdentSeq
]
=
&
seq_id
;
UserDefinedArrayFunctions
=
NULL
;
#if STRICT_LISTS
unboxed_record_cons_list
=
NULL
;
...
...
backendC/CleanCompilerSources/backend.h
View file @
5f0679df
...
...
@@ -166,6 +166,7 @@ Clean (::BESpecialIdentIndex :== Int)
enum
{
BESpecialIdentStdMisc
,
BESpecialIdentAbort
,
BESpecialIdentUndef
,
BESpecialIdentStdBool
,
BESpecialIdentAnd
,
BESpecialIdentOr
,
BESpecialIdentPrelude
,
BESpecialIdentSeq
,
BESpecialIdentCount
};
...
...
backendC/CleanCompilerSources/buildtree.c
View file @
5f0679df
...
...
@@ -13,7 +13,7 @@ SymbolP BasicTypeSymbols [Nr_Of_Basic_Types],
ApplyTypeSymbol
,
TrueSymbol
,
FalseSymbol
,
TupleSymbol
,
ListSymbol
,
ConsSymbol
,
NilSymbol
,
SelectSymbols
[
MaxNodeArity
],
ApplySymbol
,
IfSymbol
,
FailSymbol
,
AllSymbol
,
SelectSymbols
[
MaxNodeArity
],
ApplySymbol
,
IfSymbol
,
FailSymbol
,
EmptyTypeSymbol
,
TupleTypeSymbols
[
MaxNodeArity
];
...
...
@@ -452,11 +452,6 @@ NewRuleAlt (void)
return
(
alt
);
}
/* NewRuleAlt */
TypeNode
NewEmptyTypeNode
(
void
)
{
return
NewTypeNode
(
NoAnnot
,
NoAttr
,
EmptyTypeSymbol
,
NIL
,
0
);
}
/* NewEmptyTypeNode */
struct
p_at_node_tree
{
NodeP
annoted_node
;
NodeP
at_node
;
...
...
backendC/CleanCompilerSources/buildtree.h
View file @
5f0679df
...
...
@@ -78,8 +78,6 @@ extern char *CopyString (char *to, char *from, int *rest_size);
extern
char
BasicTypeIds
[];
#define ConvertBasicTypeToChar(type_symb) BasicTypeIds [(type_symb) -> symb_kind]
extern
TypeNode
NewEmptyTypeNode
(
void
);
extern
IdentP
DetermineNewSymbolId
(
char
*
prefix
,
TypeNode
inst_type
,
TableKind
table
);
extern
IdentP
gArrayIdents
[];
...
...
@@ -88,7 +86,7 @@ extern SymbolP BasicTypeSymbols [],
ArraySymbols
[],
TrueSymbol
,
FalseSymbol
,
TupleSymbol
,
ListSymbol
,
ConsSymbol
,
NilSymbol
,
ApplySymbol
,
ApplyTypeSymbol
,
SelectSymbols
[],
FailSymbol
,
IfSymbol
,
AllSymbol
,
EmptyTypeSymbol
;
FailSymbol
,
IfSymbol
;
#if STRICT_LISTS
extern
SymbolP
StrictListSymbol
,
StrictConsSymbol
,
StrictNilSymbol
,
...
...
backendC/CleanCompilerSources/checker.h
View file @
5f0679df
...
...
@@ -16,6 +16,7 @@ extern Ident DynamicId;
#if SA_RECOGNIZES_ABORT_AND_UNDEF
extern
Ident
StdMiscId
,
abort_id
,
undef_id
;
#endif
extern
Ident
PreludeId
,
seq_id
,
system_seq_id
;
extern
Symbol
StartSymbol
,
UnboxedArrayClassSymbols
[],
UnboxedArrayFunctionSymbols
[];
extern
SymbDef
scc_dependency_list
,
ArrayFunctionDefs
[],
StdArrayAbortDef
;
...
...
backendC/CleanCompilerSources/checker_2.c
View file @
5f0679df
...
...
@@ -110,6 +110,8 @@ Ident AnnotatedId, ListId, TupleId, ConsId, NilId, ApplyId, SelectId,
Ident
StdMiscId
,
abort_id
,
undef_id
;
#endif
Ident
PreludeId
,
seq_id
,
system_seq_id
;
Symbol
StartSymbol
;
SymbDef
ArrayFunctionDefs
[
NoArrayFun
],
StdArrayAbortDef
;
...
...
@@ -203,6 +205,8 @@ void InitChecker (void)
StdMiscId
=
PutStringInHashTable
(
"StdMisc"
,
ModuleIdTable
);
#endif
system_seq_id
=
PutStringInHashTable
(
"seq"
,
SymbolIdTable
);
/* Predefined Array functions */
ArrayFunctionIds
[
CreateArrayFun
]
=
PutStringInHashTable
(
"createArray"
,
SymbolIdTable
);
...
...
backendC/CleanCompilerSources/codegen2.c
View file @
5f0679df
...
...
@@ -51,7 +51,7 @@ char else_symb[] = "else";
char
then_symb
[]
=
"then"
;
char
notused_string
[]
=
"notused"
;
SymbDef
ApplyDef
,
IfDef
;
SymbDef
ApplyDef
,
IfDef
,
SeqDef
;
unsigned
NewLabelNr
,
new_not_eq_z_label_n
;
...
...
@@ -3266,6 +3266,58 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
}
return
;
}
case
seq_symb
:
if
(
node
->
node_arity
==
2
){
if
(
IsLazyState
(
node
->
node_state
)){
FillSymbol
(
node
,
SeqDef
,
asp_p
,
bsp_p
,
update_node_id
,
code_gen_node_ids_p
);
}
else
{
int
old_asp
,
old_bsp
;
old_asp
=*
asp_p
;
old_bsp
=*
bsp_p
;
BuildArg
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
GenPopA
(
*
asp_p
-
old_asp
);
GenPopA
(
*
bsp_p
-
old_bsp
);
*
asp_p
=
old_asp
;
*
bsp_p
=
old_bsp
;
if
(
update_node_id
==
NULL
){
ArgP
arg2_arg
;
arg2_arg
=
node
->
node_arguments
->
arg_next
;
if
(
arg2_arg
->
arg_node
->
node_kind
!=
NodeIdNode
){
Build
(
arg2_arg
->
arg_node
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
}
else
{
NodeId
arg_node_id
;
arg_node_id
=
arg2_arg
->
arg_node
->
node_node_id
;
#if BOXED_RECORDS
arg_node_id
->
nid_mark2
|=
NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES
;
#endif
if
(
CopyNodeIdArgument
(
arg2_arg
->
arg_state
,
arg_node_id
,
asp_p
,
bsp_p
))
ChangeEvalStatusKindToStrictOnA
(
arg_node_id
,
code_gen_node_ids_p
->
saved_nid_state_l
);
decrement_reference_count_of_node_id
(
arg_node_id
,
&
code_gen_node_ids_p
->
free_node_ids
);
}
}
else
FillNodeOnACycle
(
node
->
node_arguments
->
arg_next
->
arg_node
,
asp_p
,
bsp_p
,
update_node_id
,
code_gen_node_ids_p
);
}
}
else
{
LabDef
name
;
ConvertSymbolToConstructorDLabel
(
&
name
,
SeqDef
);
BuildArgs
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
if
(
update_node_id
==
NULL
){
*
asp_p
+=
1
-
node
->
node_arity
;
GenBuildPartialFunctionh
(
&
name
,
node
->
node_arity
);
}
else
{
GenFillh
(
&
name
,
node
->
node_arity
,
*
asp_p
-
update_node_id
->
nid_a_index
,
NormalFill
);
*
asp_p
-=
node
->
node_arity
;
}
}
return
;
default:
if
(
symb
->
symb_kind
<
Nr_Of_Basic_Types
){
if
(
update_node_id
==
NULL
){
...
...
@@ -6480,6 +6532,9 @@ void InitCoding (void)
IfDef
=
MakeNewSymbolDefinition
(
"system"
,
IfId
,
3
,
DEFRULE
);
IfDef
->
sdef_number
=
0
;
SeqDef
=
MakeNewSymbolDefinition
(
"system"
,
system_seq_id
,
2
,
DEFRULE
);
SeqDef
->
sdef_number
=
0
;
InitBasicDescriptor
(
UnknownObj
,
"_"
,
SizeOfAStackElem
);
#if ABSTRACT_OBJECT
InitBasicDescriptor
(
AbstractObj
,
"_"
,
SizeOfAStackElem
);
...
...
backendC/CleanCompilerSources/codegen2.h
View file @
5f0679df
...
...
@@ -102,7 +102,7 @@ void build_and_cleanup (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen
#define CONSTRUCTOR_R_PREF k_pref
extern
char
*
Co_Wtype
,
*
Co_Wspine
,
else_symb
[],
then_symb
[],
notused_string
[];
extern
SymbDef
ApplyDef
,
IfDef
;
extern
SymbDef
ApplyDef
,
IfDef
,
SeqDef
;
extern
StateS
StrictOnAState
;
void
FillSelectSymbol
(
StateKind
result_state_kind
,
int
arity
,
int
argnr
,
Args
arg
,
int
*
asp_p
,
int
*
bsp_p
,
...
...
backendC/CleanCompilerSources/codegen3.c
View file @
5f0679df
...
...
@@ -724,6 +724,8 @@ static void CodeRootSelection (Node root, NodeId rootid,int asp,int bsp,CodeGenN
}
}
static
int
CodeRootNode
(
Node
root
,
NodeId
rootid
,
int
asp
,
int
bsp
,
CodeGenNodeIdsP
code_gen_node_ids_p
,
StateS
resultstate
,
struct
esc
*
esc_p
);
static
int
CodeRhsNodeDefsAndRestoreNodeIdStates
(
Node
root_node
,
NodeDefs
defs
,
int
asp
,
int
bsp
,
StateS
resultstate
,
struct
esc
*
esc_p
,
NodeIdListElementP
a_node_ids
,
NodeIdListElementP
b_node_ids
,
NodeIdListElementP
free_node_ids
,
int
doesnt_fail
)
...
...
@@ -972,6 +974,25 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
}
else
GenRtn
(
1
,
1
,
resultstate
);
return
;
case
seq_symb
:
if
(
root
->
node_arity
==
2
){
int
old_asp
,
old_bsp
;
old_asp
=
asp
;
old_bsp
=
bsp
;
BuildArg
(
root
->
node_arguments
,
&
asp
,
&
bsp
,
code_gen_node_ids_p
);
GenPopA
(
asp
-
old_asp
);
GenPopB
(
bsp
-
old_bsp
);
/* asp=old_asp; bsp=old_bsp; */
CodeRootNode
(
root
->
node_arguments
->
arg_next
->
arg_node
,
rootid
,
old_asp
,
old_bsp
,
code_gen_node_ids_p
,
resultstate
,
NULL
);
}
else
{
LabDef
name
;
ConvertSymbolToDLabel
(
&
name
,
SeqDef
);
FillRhsRoot
(
&
name
,
root
,
asp
,
bsp
,
code_gen_node_ids_p
);
}
return
;
default:
if
(
rootsymb
->
symb_kind
<
Nr_Of_Basic_Types
)
FillRhsRoot
(
&
BasicDescriptors
[
rootsymb
->
symb_kind
],
root
,
asp
,
bsp
,
code_gen_node_ids_p
);
...
...
backendC/CleanCompilerSources/comparser_2.c
View file @
5f0679df
...
...
@@ -193,8 +193,6 @@ InitParser (void)
ApplySymbol
=
NewSymbol
(
apply_symb
);
FailSymbol
=
NewSymbol
(
fail_symb
);
AllSymbol
=
NewSymbol
(
all_symb
);
EmptyTypeSymbol
=
NewSymbol
(
empty_type
);
clear_p_at_node_tree
();
}
/* InitParser */
backendC/CleanCompilerSources/instructions.c
View file @
5f0679df
...
...
@@ -3717,7 +3717,7 @@ void GenSystemImports (void)
GenImpDesc
(
"e_system_dAP"
);
GenImpLab_node_entry
(
"e_system_nAP"
,
"e_system_eaAP"
);
GenImpLab
(
"e_system_sAP"
);
GenImpDesc
(
nil_lab
.
lab_name
);
GenImpDesc
(
cons_lab
.
lab_name
);
#if STRICT_LISTS
...
...
@@ -3743,6 +3743,12 @@ void GenSystemImports (void)
FPrintF
(
OutFile
,
N_PREFIX
"%s.%d "
EA_PREFIX
"%s.%d"
,
glob_selr
,
selnum
,
glob_selr
,
selnum
);
}
#endif
if
(
SeqDef
!=
NULL
&&
(
SeqDef
->
sdef_mark
&
(
SDEF_USED_LAZILY_MASK
|
SDEF_USED_CURRIED_MASK
))){
GenImpDesc
(
"e_system_dseq"
);
GenImpLab_node_entry
(
"e_system_nseq"
,
"e_system_easeq"
);
}
GenImpLab
(
"_driver"
);
}
}
...
...
backendC/CleanCompilerSources/optimisations.c
View file @
5f0679df
...
...
@@ -3347,6 +3347,15 @@ static void ExamineSymbolApplication (struct node *node)
symbol
->
symb_unboxed_cons_sdef_p
->
sdef_mark
|=
SDEF_USED_CURRIED_MASK
;
else
if
(
IsLazyState
(
node
->
node_state
))
symbol
->
symb_unboxed_cons_sdef_p
->
sdef_mark
|=
SDEF_USED_LAZILY_MASK
;
}
else
if
(
symbol
->
symb_kind
==
seq_symb
){
if
(
node
->
node_arity
!=
2
)
SeqDef
->
sdef_mark
|=
SDEF_USED_CURRIED_MASK
;
else
{
if
(
IsLazyState
(
node
->
node_state
))
SeqDef
->
sdef_mark
|=
SDEF_USED_LAZILY_MASK
;
else
SeqDef
->
sdef_mark
|=
SDEF_USED_STRICTLY_MASK
;
}
}
return
;
}
...
...
backendC/CleanCompilerSources/sa.c
View file @
5f0679df
...
...
@@ -2164,7 +2164,9 @@ static void InitNode (Node node)
static
void
InitAlternative
(
RuleAltS
*
alt
)
{
#ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
NodeDefs
nds
;
#endif
InitNode
(
alt
->
alt_lhs_root
);
...
...
@@ -2337,6 +2339,20 @@ static Exp ConvertNode (Node node, NodeId nid)
}
break
;
}
case
seq_symb
:
if
(
node
->
node_arity
==
2
){
e
->
e_kind
=
Dep
;
e
->
e_args
=
NewExpArgs
(
2
);
e
->
e_sym
=
2
;
e
->
e_args
[
0
]
=
ConvertNode
(
node
->
node_arguments
->
arg_node
,
NULL
);
e
->
e_args
[
1
]
=
ConvertNode
(
node
->
node_arguments
->
arg_next
->
arg_node
,
NULL
);
if
(
nid
)
nid
->
nid_exp_
=
e
;
return
e
;
}
default:
e
=
&
top
;
if
(
nid
)
...
...
backendC/CleanCompilerSources/statesgen.c
View file @
5f0679df
...
...
@@ -2124,6 +2124,17 @@ static Bool NodeInAStrictContext (Node node,StateS demanded_state,int local_scop
}
break
;
}
case
seq_symb
:
node
->
node_state
=
demanded_state
;
if
(
node
->
node_arity
==
2
){
parallel
=
DetermineStrictArgContext
(
node
->
node_arguments
,
StrictState
,
local_scope
);
parallel
=
DetermineStrictArgContext
(
node
->
node_arguments
->
arg_next
,
demanded_state
,
local_scope
);
}
else
{
if
(
ShouldDecrRefCount
)
DecrRefCountCopiesOfArgs
(
node
->
node_arguments
IF_OPTIMIZE_LAZY_TUPLE_RECURSION
(
local_scope
));
node
->
node_state
=
StrictState
;
}
break
;
default:
if
(
rootsymb
->
symb_kind
<
Nr_Of_Predef_Types
){
node
->
node_state
=
BasicSymbolStates
[
rootsymb
->
symb_kind
];
...
...
backendC/CleanCompilerSources/syntaxtr.t
View file @
5f0679df
...
...
@@ -72,7 +72,7 @@ typedef enum {
#endif
Nr_Of_Predef_Types
,
tuple_symb
,
cons_symb
,
nil_symb
,
apply_symb
,
if_symb
,
fail_symb
,
all
_symb
,
apply_symb
,
if_symb
,
fail_symb
,
seq
_symb
,
select_symb
,
Nr_Of_Predef_FunsOrConses
,
definition
,
newsymbol
,
instance_symb
,
empty_symbol
,
field_symbol_list
,
...
...
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