Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-compiler-and-rts
compiler
Commits
60812627
Commit
60812627
authored
Oct 04, 2001
by
Ronny Wichers Schreur
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fail explicit cases
parent
636fe443
Changes
12
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
98 additions
and
25 deletions
+98
-25
MacLibraries/CleanCompilerLib
MacLibraries/CleanCompilerLib
+0
-0
backend/backend.dcl
backend/backend.dcl
+2
-2
backend/backend.icl
backend/backend.icl
+2
-2
backend/backendconvert.icl
backend/backendconvert.icl
+38
-17
backendC/CleanCompilerSources/backend.h
backendC/CleanCompilerSources/backend.h
+2
-2
backendC/CleanCompilerSources/codegen3.c
backendC/CleanCompilerSources/codegen3.c
+24
-0
backendC/CleanCompilerSources/instructions.c
backendC/CleanCompilerSources/instructions.c
+25
-0
backendC/CleanCompilerSources/instructions.h
backendC/CleanCompilerSources/instructions.h
+3
-0
backendC/backend.mcp
backendC/backend.mcp
+0
-0
backendC/backend.rc
backendC/backend.rc
+1
-1
coclmaindll/backend.dll
coclmaindll/backend.dll
+0
-0
frontend/convertcases.icl
frontend/convertcases.icl
+1
-1
No files found.
MacLibraries/CleanCompilerLib
View file @
60812627
No preview for this file type
backend/backend.dcl
View file @
60812627
...
...
@@ -279,9 +279,9 @@ BEDeclareDynamicTypeSymbol :: !Int !Int !BackEnd -> BackEnd;
// void BEDeclareDynamicTypeSymbol (int typeIndex,int moduleIndex);
BEDynamicTempTypeSymbol
::
!
BackEnd
->
(!
BESymbolP
,!
BackEnd
);
// BESymbolP BEDynamicTempTypeSymbol ();
kBEVersionCurrent
:==
0x0200021
3
;
kBEVersionCurrent
:==
0x0200021
4
;
kBEVersionOldestDefinition
:==
0x02000213
;
kBEVersionOldestImplementation
:==
0x0200021
3
;
kBEVersionOldestImplementation
:==
0x0200021
4
;
kBEDebug
:==
1
;
kPredefinedModuleIndex
:==
1
;
BENoAnnot
:==
0
;
...
...
backend/backend.icl
View file @
60812627
...
...
@@ -763,9 +763,9 @@ BEDynamicTempTypeSymbol a0 = code {
ccall
BEDynamicTempTypeSymbol
":I:I"
}
;
// BESymbolP BEDynamicTempTypeSymbol ();
kBEVersionCurrent
:==
0x0200021
3
;
kBEVersionCurrent
:==
0x0200021
4
;
kBEVersionOldestDefinition
:==
0x02000213
;
kBEVersionOldestImplementation
:==
0x0200021
3
;
kBEVersionOldestImplementation
:==
0x0200021
4
;
kBEDebug
:==
1
;
kPredefinedModuleIndex
:==
1
;
BENoAnnot
:==
0
;
...
...
backend/backendconvert.icl
View file @
60812627
...
...
@@ -1605,7 +1605,7 @@ convertBackEndLhs functionIndex patterns main_dcl_module_n
convertStrings
::
[{#
Char
}]
->
BEMonad
BEStringListP
convertStrings
strings
=
sfoldr
(
beStrings
o
beString
)
beNoStrings
strings
convertCodeParameters
::
(
CodeBinding
a
)
->
BEMonad
BECodeParameterP
|
varInfoPtr
a
convertCodeParameters
codeParameters
=
sfoldr
(
beCodeParameters
o
convertCodeParameter
)
beNoCodeParameters
codeParameters
...
...
@@ -1686,11 +1686,23 @@ convertRootExpr aliasDummyId (Conditional {if_cond=cond, if_then=then, if_else=N
beNoNodeDefs
beNoStrictNodeIds
(
beNormalNode
(
beBasicSymbol
BEFailSymb
)
beNoArgs
)
convertRootExpr
aliasDummyId
(
Case
{
case_expr
,
case_guards
,
case_default
})
main_dcl_module_n
=
beSwitchNode
(
convertVar
var
.
var_info_ptr
)
(
convertCases
case_guards
aliasDummyId
var
case_
default
main_dcl_module_n
)
convertRootExpr
aliasDummyId
(
Case
kees
=:
{
case_expr
,
case_guards
})
main_dcl_module_n
=
beSwitchNode
(
convertVar
var
.
var_info_ptr
)
(
convertCases
case_guards
aliasDummyId
var
(
default
Case
kees
)
main_dcl_module_n
)
where
var
=
caseVar
case_expr
defaultCase
{
case_default
=
Yes
defaul
}
=
DefaultCase
defaul
defaultCase
{
case_explicit
,
case_default
=
No
,
case_ident
}
|
case_explicit
=
case
case_ident
of
Yes
ident
->
DefaultCaseFail
ident
_
->
abort
"backendconvert:defaultCase, case without id"
// otherwise
=
DefaultCaseNone
convertRootExpr
_
expr
main_dcl_module_n
=
convertExpr
expr
main_dcl_module_n
...
...
@@ -1948,7 +1960,12 @@ caseVar (Var var)
caseVar
expr
=
undef
// <<- ("backendconvert, caseVar: unknown expression", expr)
class
convertCases
a
::
a
Ident
BoundVar
(
Optional
Expression
)
Int
->
BEMonad
BEArgP
::
DefaultCase
=
DefaultCase
Expression
|
DefaultCaseFail
!
Ident
|
DefaultCaseNone
class
convertCases
a
::
a
Ident
BoundVar
DefaultCase
Int
->
BEMonad
BEArgP
instance
convertCases
CasePatterns
where
convertCases
(
AlgebraicPatterns
_
patterns
)
aliasDummyId
var
default_case
main_dcl_module_n
...
...
@@ -1963,11 +1980,14 @@ instance convertCases [a] | convertCase a where
convertCases
patterns
aliasDummyId
var
optionalCase
main_dcl_module_n
=
sfoldr
(
beArgs
o
convertCase
main_dcl_module_n
(
localRefCounts
patterns
optionalCase
)
aliasDummyId
var
)
(
convertDefaultCase
optionalCase
aliasDummyId
main_dcl_module_n
)
patterns
where
localRefCounts
[
x
]
No
=
False
localRefCounts
_
_
=
True
localRefCounts
::
[
pattern
]
DefaultCase
->
Bool
localRefCounts
[_]
DefaultCaseNone
=
False
localRefCounts
[_]
(
DefaultCaseFail
_)
=
False
localRefCounts
_
_
=
True
class
convertCase
a
::
Int
Bool
Ident
BoundVar
a
->
BEMonad
BENodeP
...
...
@@ -2073,11 +2093,6 @@ convertOverloadedListPatterns patterns decons_expr aliasDummyId var optionalCase
=
sfoldr
(
beArgs
o
convertOverloadedListPattern
decons_expr
(
localRefCounts
patterns
optionalCase
))
(
convertDefaultCase
optionalCase
aliasDummyId
main_dcl_module_n
)
patterns
where
localRefCounts
[
x
]
No
=
False
localRefCounts
_
_
=
True
convertOverloadedListPattern
::
Expression
Bool
AlgebraicPattern
->
BEMonad
BENodeP
convertOverloadedListPattern
decons_expr
localRefCounts
{
ap_symbol
={
glob_module
,
glob_object
={
ds_index
}},
ap_vars
=[],
ap_expr
}
=
caseNode
localRefCounts
0
...
...
@@ -2117,10 +2132,16 @@ convertPatternVar :: FreeVar -> BEMonad BENodeIdListP
convertPatternVar
freeVar
=
beNodeIdListElem
(
convertVar
freeVar
.
fv_info_ptr
)
convertDefaultCase
::
(
Optional
Expression
)
Ident
Int
->
BEMonad
BEArgP
convertDefaultCase
No
_
_
convertDefaultCase
DefaultCaseNone
_
_
=
beNoArgs
convertDefaultCase
(
Yes
expr
)
aliasDummyId
main_dcl_module_n
convertDefaultCase
(
DefaultCaseFail
ident
)
aliasDummyId
main_dcl_module_n
=
beArgs
(
defaultNode
beNoNodeDefs
beNoStrictNodeIds
(
beNormalNode
(
beLiteralSymbol
BEFailSymb
ident
.
id_name
)
beNoArgs
))
beNoArgs
convertDefaultCase
(
DefaultCase
expr
)
aliasDummyId
main_dcl_module_n
=
beArgs
(
defaultNode
(
convertRhsNodeDefs
aliasDummyId
expr
main_dcl_module_n
)
...
...
backendC/CleanCompilerSources/backend.h
View file @
60812627
/* version info */
// increment this for every release
# define kBEVersionCurrent 0x0200021
3
# define kBEVersionCurrent 0x0200021
4
// change this to the same value as kBEVersionCurrent if the new release is not
// upward compatible (for example when a function is added)
...
...
@@ -9,7 +9,7 @@
// change this to the same value as kBEVersionCurrent if the new release is not
// downward compatible (for example when a function is removed)
# define kBEVersionOldestImplementation 0x0200021
3
# define kBEVersionOldestImplementation 0x0200021
4
# define kBEDebug 1
...
...
backendC/CleanCompilerSources/codegen3.c
View file @
60812627
...
...
@@ -860,9 +860,33 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
CodeRootSelection
(
root
,
rootid
,
asp
,
bsp
,
code_gen_node_ids_p
,
resultstate
);
return
;
case
fail_symb
:
#if CLEAN2
{
IdentS
case_ident_s
;
SymbDefS
case_def_s
;
case_ident_s
.
ident_name
=
rootsymb
->
symb_string
;
Assume
(
case_ident_s
.
ident_name
!=
NULL
,
"codegen3"
,
"CodeNormalRootNode (fail_symb)"
);
case_def_s
.
sdef_ident
=
&
case_ident_s
;
case_def_s
.
sdef_line
=
0
;
StaticMessage
(
FunctionMayFailIsError
,
"%D"
,
"case may fail"
,
&
case_def_s
);
if
(
!
(
IsOnBStack
(
resultstate
)
||
(
IsSimpleState
(
resultstate
)
&&
resultstate
.
state_kind
==
StrictRedirection
)))
/* root needed */
asp
++
;
GenCaseNoMatchError
(
&
case_def_s
,
asp
,
bsp
);
return
;
}
#else
/* ifndef CLEAN2 */
error_in_function
(
"CodeNormalRootNode"
);
/* JumpToNextAlternative (asp, bsp); */
return
;
#endif
case
string_denot
:
GenPopA
(
asp
);
GenPopB
(
bsp
);
...
...
backendC/CleanCompilerSources/instructions.c
View file @
60812627
...
...
@@ -3393,6 +3393,31 @@ void GenNoMatchError (SymbDef sdef,int asp,int bsp,int string_already_generated)
}
}
#if CLEAN2
void
GenCaseNoMatchError
(
SymbDefP
case_def
,
int
asp
,
int
bsp
)
{
static
int
case_number
;
GenPopA
(
asp
);
GenPopB
(
bsp
);
put_instruction_b
(
pushD
);
FPrintF
(
OutFile
,
"m_%s"
,
CurrentModule
);
put_instruction_b
(
pushD
);
FPrintF
(
OutFile
,
"case_fail%u"
,
case_number
);
GenJmp
(
&
match_error_lab
);
put_directive_
(
Dstring
);
FPrintF
(
OutFile
,
"case_fail%u
\"
"
,
case_number
);
PrintSymbolOfIdent
(
case_def
->
sdef_ident
,
case_def
->
sdef_line
,
OutFile
);
FPrintF
(
OutFile
,
"
\"
"
);
case_number
++
;
}
#endif
static
void
GenImpLab
(
char
*
label_name
)
{
put_directive_b
(
implab
);
...
...
backendC/CleanCompilerSources/instructions.h
View file @
60812627
...
...
@@ -187,6 +187,9 @@ void InitFileInfo (ImpMod imod);
/* void GenFileInfo (void); */
void
GenNoMatchError
(
SymbDef
sdef
,
int
asp
,
int
bsp
,
int
string_already_generated
);
#if CLEAN2
void
GenCaseNoMatchError
(
SymbDefP
case_def
,
int
asp
,
int
bsp
);
#endif
void
InitInstructions
(
void
);
...
...
backendC/backend.mcp
View file @
60812627
No preview for this file type
backendC/backend.rc
View file @
60812627
...
...
@@ -37,7 +37,7 @@ BEGIN
VALUE "LegalTrademarks", "\0"
VALUE "OriginalFilename","backend.dll\0"
VALUE "ProductName", "Clean System"
VALUE "ProductVersion", "2.0.d.
12
"
VALUE "ProductVersion", "2.0.d.
0
"
VALUE "OLESelfRegister", "\0"
END
...
...
coclmaindll/backend.dll
View file @
60812627
No preview for this file type
frontend/convertcases.icl
View file @
60812627
...
...
@@ -1083,7 +1083,7 @@ convertNonRootCase ci=:{ci_bound_vars, ci_group_index, ci_common_defs} kees=:{ c
case_free_var
=
{
fv_def_level
=
NotALevel
,
fv_name
=
var_id
,
fv_info_ptr
=
new_info_ptr
,
fv_count
=
0
}
cs
=
{
cs
&
cs_var_heap
=
cs_var_heap
}
kees
=
{
kees
&
case_expr
=
case_var
}
kees
=
{
kees
&
case_expr
=
case_var
,
case_explicit
=
False
}
(
case_expr
,
cs
)
=
convertCases
ci
case_expr
cs
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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