aboutsummaryrefslogtreecommitdiff
path: root/backendC
diff options
context:
space:
mode:
Diffstat (limited to 'backendC')
-rw-r--r--backendC/CleanCompilerSources/apple_main.c61
-rw-r--r--backendC/CleanCompilerSources/backend.c69
-rw-r--r--backendC/CleanCompilerSources/backend.h8
-rw-r--r--backendC/CleanCompilerSources/backendsupport.c33
-rw-r--r--backendC/CleanCompilerSources/backendsupport.h2
-rw-r--r--backendC/CleanCompilerSources/buildtree.c11
-rw-r--r--backendC/CleanCompilerSources/buildtree.h17
-rw-r--r--backendC/CleanCompilerSources/checker.h3
-rw-r--r--backendC/CleanCompilerSources/checker_2.c1
-rw-r--r--backendC/CleanCompilerSources/checksupport.c1
-rw-r--r--backendC/CleanCompilerSources/checktypedefs_2.c1
-rw-r--r--backendC/CleanCompilerSources/cocl.c4
-rw-r--r--backendC/CleanCompilerSources/codegen.c3
-rw-r--r--backendC/CleanCompilerSources/codegen1.c8
-rw-r--r--backendC/CleanCompilerSources/codegen1.h3
-rw-r--r--backendC/CleanCompilerSources/codegen2.c2
-rw-r--r--backendC/CleanCompilerSources/codegen3.c2
-rw-r--r--backendC/CleanCompilerSources/comparser_2.c73
-rw-r--r--backendC/CleanCompilerSources/compiledefines.h4
-rw-r--r--backendC/CleanCompilerSources/compiler.c3
-rw-r--r--backendC/CleanCompilerSources/comsupport.c27
-rw-r--r--backendC/CleanCompilerSources/dbprint.c2
-rw-r--r--backendC/CleanCompilerSources/instructions.c23
-rw-r--r--backendC/CleanCompilerSources/mac.h2
-rw-r--r--backendC/CleanCompilerSources/mac_io.c280
-rw-r--r--backendC/CleanCompilerSources/macros_2.c3
-rw-r--r--backendC/CleanCompilerSources/optimisations.c12
-rw-r--r--backendC/CleanCompilerSources/overloading_2.c3
-rw-r--r--backendC/CleanCompilerSources/path_cache.c35
-rw-r--r--backendC/CleanCompilerSources/path_cache.h21
-rw-r--r--backendC/CleanCompilerSources/pattern_match.c1
-rw-r--r--backendC/CleanCompilerSources/result_state_database.c1
-rw-r--r--backendC/CleanCompilerSources/sa.c64
-rw-r--r--backendC/CleanCompilerSources/set_scope_numbers.c3
-rw-r--r--backendC/CleanCompilerSources/settings.c2
-rw-r--r--backendC/CleanCompilerSources/statesgen.c77
-rw-r--r--backendC/CleanCompilerSources/statesgen.h2
-rw-r--r--backendC/CleanCompilerSources/syntaxtr.t35
-rw-r--r--backendC/CleanCompilerSources/system.h2
-rw-r--r--backendC/CleanCompilerSources/tcsupport_2.c3
-rw-r--r--backendC/CleanCompilerSources/typechecker2_2.c3
-rw-r--r--backendC/CleanCompilerSources/typechecker_2.c3
-rw-r--r--backendC/CleanCompilerSources/typeconv_2.c16
-rw-r--r--backendC/CleanCompilerSources/types.t26
44 files changed, 808 insertions, 147 deletions
diff --git a/backendC/CleanCompilerSources/apple_main.c b/backendC/CleanCompilerSources/apple_main.c
index 2734724..5cb16f2 100644
--- a/backendC/CleanCompilerSources/apple_main.c
+++ b/backendC/CleanCompilerSources/apple_main.c
@@ -1,4 +1,10 @@
+#include "compiledefines.h"
+
+#ifdef KARBON
+# define TARGET_API_MAC_CARBON 1
+#endif
+
#include <stdio.h>
#include <unix.h>
#include <SIOUX.h>
@@ -15,6 +21,7 @@
#include "Gestalt.h"
#include "AERegistry.h"
+#include "types.t"
#include "system.h"
#include "path_cache.h"
#include "compiler.h"
@@ -23,6 +30,7 @@ extern void clear_inline_cache (void);
#undef BACKGROUND
#define MW_DEBUG 0
+#define NO68K
#ifndef BACKGROUND
# undef NO_REDIRECT_STDFILES
@@ -40,22 +48,22 @@ extern void clear_inline_cache (void);
static Boolean gAppleEventsFlag, gQuitFlag;
static long gSleepVal;
-static pascal OSErr DoAEOpenApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+static pascal OSErr DoAEOpenApplication (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon)
{
return noErr;
}
-static pascal OSErr DoAEOpenDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent, long refCon)
+static pascal OSErr DoAEOpenDocuments (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon)
{
return errAEEventNotHandled;
}
-static pascal OSErr DoAEPrintDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+static pascal OSErr DoAEPrintDocuments (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon)
{
return errAEEventNotHandled;
}
-static pascal OSErr DoAEQuitApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
+static pascal OSErr DoAEQuitApplication (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon)
{
gQuitFlag = true;
return noErr;
@@ -68,15 +76,19 @@ extern int CallCompiler (int argc,char **argv);
#ifdef CODE_GENERATOR
# ifdef __cplusplus
extern "C" { int generate_code (int,char **); }
+# ifndef NO68K
extern int generate_code68 (int,char **);
+# endif
# else
extern int generate_code (int,char **);
+# ifndef NO68K
extern int generate_code68__FiPPc (int,char **);
- #define generate_code68 generate_code68__FiPPc
+#define generate_code68 generate_code68__FiPPc
+# endif
# endif
#endif
-#ifdef LINKER
+#if defined (LINKER) && !defined (NO68K)
# ifdef __cplusplus
extern "C" { int link_application_argc_argv (int,char **); }
# else
@@ -104,7 +116,7 @@ int do_command (char *command)
++p;
while (*p!='\0' && argc<256){
- if (*p=='>' || *p=='„'){
+ if (*p=='>' || *p=='³'){
int redirection_char;
char *file_name;
@@ -153,7 +165,7 @@ int do_command (char *command)
freopen (file_name,"w",stdout);
redirect_stdout=1;
#endif
- } else if (redirection_char=='„' && redirect_stderr==0){
+ } else if (redirection_char=='³' && redirect_stderr==0){
#ifndef NO_REDIRECT_STDFILES
freopen (file_name,"w",stderr);
redirect_stderr=1;
@@ -215,6 +227,10 @@ int do_command (char *command)
*/
if (argc>0){
+#ifdef CLEAN2
+ if (0)
+ ;
+#else
if (!strcmp (argv[0],"cocl")){
if (argc>=2 && !strcmp ("-clear_cache",argv[1])){
result=CallCompiler (argc-2,&argv[2]);
@@ -224,13 +240,16 @@ int do_command (char *command)
} else
result=CallCompiler (argc-1,&argv[1]);
}
+#endif
#ifdef CODE_GENERATOR
else if (!strcmp (argv[0],"cg"))
result=generate_code (argc,&argv[0]);
+# ifndef NO68K
else if (!strcmp (argv[0],"cg68"))
result=generate_code68 (argc,&argv[0]);
+# endif
#endif
-#ifdef LINKER
+#if defined (LINKER) && !defined (NO68K)
else if (!strcmp (argv[0],"linker"))
result=link_application_argc_argv (argc,&argv[0]);
#endif
@@ -255,7 +274,13 @@ int do_command (char *command)
static char script_string[16001];
-static pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *replyAppleEvent,long refCon)
+#ifdef CLEAN2
+int compiler_id;
+#else
+extern int compiler_id;
+#endif
+
+pascal OSErr do_script_apple_event (const AppleEvent *apple_event,AppleEvent *replyAppleEvent,unsigned long refCon)
{
DescType returned_type;
long actual_size;
@@ -272,7 +297,13 @@ static pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *r
#if !MW_DEBUG
error=do_command (script_string);
#endif
-
+
+ if (compiler_id>=0){
+ error += (compiler_id+1)<<1;
+
+ compiler_id = -1;
+ }
+
return_error_string_length=strlen (return_error_string);
if (return_error_string_length!=0){
AEPutParamPtr (replyAppleEvent,keyErrorString,typeChar,return_error_string,return_error_string_length);
@@ -337,16 +368,22 @@ int /*clean_compiler_*/ main (void)
EventRecord mainEventRec;
Boolean eventFlag;
+#ifndef KARBON
SetApplLimit (GetApplLimit() - 200*1024);
InitGraf (&qd.thePort);
InitFonts();
+#endif
FlushEvents (everyEvent,0);
#ifndef BACKGROUND
+# ifndef KARBON
InitWindows();
+# endif
InitCursor();
+# ifndef KARBON
InitMenus();
+# endif
#endif
_fcreator='3PRM';
@@ -360,7 +397,7 @@ int /*clean_compiler_*/ main (void)
else
gAppleEventsFlag = false;
-#ifdef STDIO_WINDOW
+#if defined (STDIO_WINDOW)
SIOUXSettings.autocloseonquit=1;
SIOUXSettings.showstatusline=0;
SIOUXSettings.asktosaveonclose=0;
diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c
index 6d22e0c..7dd78eb 100644
--- a/backendC/CleanCompilerSources/backend.c
+++ b/backendC/CleanCompilerSources/backend.c
@@ -1,8 +1,9 @@
#define CODE_INLINE_FLAG
#define DYNAMIC_TYPE 1
-# include "system.h"
# include "compiledefines.h"
+# include "types.t"
+# include "system.h"
# include "syntaxtr.t"
# include "codegen_types.h"
# include "statesgen.h"
@@ -1022,6 +1023,52 @@ BELiteralSymbol (BESymbKind kind, CleanString value)
return (symbol);
} /* BELiteralSymbol */
+#if STRICT_LISTS
+void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness)
+{
+ BEModuleP module;
+ SymbolP symbol_p;
+
+ Assert (moduleIndex == kPredefinedModuleIndex);
+
+ Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
+ module = &gBEState.be_modules [moduleIndex];
+
+ Assert ((unsigned int) constructorIndex < module->bem_nConstructors);
+
+ symbol_p=module->bem_constructors [constructorIndex];
+
+ Assert (symbol_p->symb_kind == erroneous_symb);
+
+ symbol_p->symb_kind = symbolKind;
+ symbol_p->symb_arity = arity;
+ symbol_p->symb_head_strictness=head_strictness;
+ symbol_p->symb_tail_strictness=tail_strictness;
+}
+
+void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness)
+{
+ BEModuleP module;
+ SymbolP symbol_p;
+
+ Assert (moduleIndex == kPredefinedModuleIndex);
+
+ Assert ((unsigned int) moduleIndex < gBEState.be_nModules);
+ module = &gBEState.be_modules [moduleIndex];
+
+ Assert ((unsigned int) typeIndex < module->bem_nTypes);
+
+ symbol_p=module->bem_types [typeIndex];
+
+ Assert (symbol_p->symb_kind == erroneous_symb);
+
+ symbol_p->symb_kind = symbolKind;
+ symbol_p->symb_arity = 1;
+ symbol_p->symb_head_strictness=head_strictness;
+ symbol_p->symb_tail_strictness=tail_strictness;
+}
+#endif
+
void
BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind)
{
@@ -2532,6 +2579,26 @@ BEGenerateCode (CleanString outputFile)
gBEState.be_icl.beicl_module->im_rules = rule;
outputFileName = ConvertCleanString (outputFile);
+
+#if 0
+ {
+ File f;
+
+ f=fopen ("Rules","w");
+ if (f){
+ ImpRuleS *rule;
+
+ for (rule=gBEState.be_icl.beicl_module->im_rules; rule!=NULL; rule=rule->rule_next){
+ PrintImpRule (rule,4,f);
+
+ if (rule->rule_next!=NULL)
+ FPutC ('\n',f);
+ }
+ fclose (f);
+ }
+ }
+#endif
+
CodeGeneration (gBEState.be_icl.beicl_module, outputFileName);
return (!CompilerError);
diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h
index 0c46787..70d9e2a 100644
--- a/backendC/CleanCompilerSources/backend.h
+++ b/backendC/CleanCompilerSources/backend.h
@@ -200,6 +200,14 @@ Clean (BEBoolSymbol :: Bool BackEnd -> (BESymbolP, BackEnd))
BESymbolP BELiteralSymbol (BESymbKind kind, CleanString value);
Clean (BELiteralSymbol :: BESymbKind String BackEnd -> (BESymbolP, BackEnd))
+/*
+void BEPredefineListConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
+Clean (BEPredefineListConstructorSymbol :: Int Int Int BESymbKind Int Int BackEnd -> BackEnd)
+
+void BEPredefineListTypeSymbol (int typeIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness);
+Clean (BEPredefineListTypeSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd)
+*/
+
void BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind);
Clean (BEPredefineConstructorSymbol :: Int Int Int BESymbKind BackEnd -> BackEnd)
diff --git a/backendC/CleanCompilerSources/backendsupport.c b/backendC/CleanCompilerSources/backendsupport.c
index 98fb777..b2d4fe2 100644
--- a/backendC/CleanCompilerSources/backendsupport.c
+++ b/backendC/CleanCompilerSources/backendsupport.c
@@ -1,3 +1,6 @@
+
+# include "compiledefines.h"
+# include "types.t"
# include "system.h"
# include "comsupport.h"
# include "backendsupport.h"
@@ -30,6 +33,36 @@ AssertionFailed (char *conditionString, char *file, int line)
Debugger ();
}
#else
+# ifdef _MAC_
+ {
+ FILE *f;
+
+ f=fopen ("AssertionFailedError","w");
+ if (f!=NULL){
+ FPrintF (f, "Error in backend: File %s, Line %d (%s)\n", file, line, conditionString);
+ fclose (f);
+ }
+ }
+# endif
Debugger ();
#endif
} /* AssertionFailed */
+
+void
+fatal_backend_error (char *s)
+{
+ FPrintF (StdError, "Error in backend: %s\n", s);
+
+#ifdef _MAC_
+ {
+ FILE *f;
+
+ f=fopen ("AssertionFailedError","w");
+ if (f!=NULL){
+ FPrintF (f, "Error in backend: %s\n", s);
+ fclose (f);
+ }
+ }
+#endif
+ Debugger ();
+}
diff --git a/backendC/CleanCompilerSources/backendsupport.h b/backendC/CleanCompilerSources/backendsupport.h
index d0ea9eb..084ff30 100644
--- a/backendC/CleanCompilerSources/backendsupport.h
+++ b/backendC/CleanCompilerSources/backendsupport.h
@@ -12,6 +12,8 @@ typedef struct clean_string {int length; char chars [1]; } *CleanString;
extern void AssertionFailed (char *conditionString, char *file, int line);
# define Assert(condition) {if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);}
+extern void fatal_backend_error (char *s);
+
/*
Memory management
=================
diff --git a/backendC/CleanCompilerSources/buildtree.c b/backendC/CleanCompilerSources/buildtree.c
index 61b6a74..471b33a 100644
--- a/backendC/CleanCompilerSources/buildtree.c
+++ b/backendC/CleanCompilerSources/buildtree.c
@@ -1,3 +1,5 @@
+
+# include "compiledefines.h"
# include "types.t"
# include "syntaxtr.t"
# include "comsupport.h"
@@ -15,6 +17,15 @@ SymbolP BasicTypeSymbols [Nr_Of_Basic_Types],
EmptyTypeSymbol,
TupleTypeSymbols [MaxNodeArity];
+#if STRICT_LISTS
+SymbolP
+ StrictListSymbol, StrictConsSymbol, StrictNilSymbol,
+ UnboxedListSymbol, UnboxedConsSymbol, UnboxedNilSymbol,
+ TailStrictListSymbol, TailStrictConsSymbol, TailStrictNilSymbol,
+ StrictTailStrictListSymbol, StrictTailStrictConsSymbol, StrictTailStrictNilSymbol,
+ UnboxedTailStrictListSymbol, UnboxedTailStrictConsSymbol, UnboxedTailStrictNilSymbol;
+#endif
+
char BasicTypeIds [] = BASIC_TYPE_IDS_STRING;
IdentP gArrayIdents [NrOfArrayInstances];
diff --git a/backendC/CleanCompilerSources/buildtree.h b/backendC/CleanCompilerSources/buildtree.h
index d91ef3b..7f330c5 100644
--- a/backendC/CleanCompilerSources/buildtree.h
+++ b/backendC/CleanCompilerSources/buildtree.h
@@ -53,6 +53,15 @@ extern NodeP NewNodeByKind (NodeKind nodeKind, SymbolP symb, Args args, int arit
# define NewNil() NewNormalNode (NilSymbol, NIL, 0)
# define NewFalse() NewNormalNode (FalseSymbol, NIL, 0)
# define NewTrue() NewNormalNode (TrueSymbol, NIL, 0)
+
+#if STRICT_LISTS
+# define NewStrictNil() NewNormalNode (StrictNilSymbol, NIL, 0)
+# define NewUnboxedNil() NewNormalNode (UnboxedNilSymbol, NIL, 0)
+# define NewTailStrictNil() NewNormalNode (TailStrictNilSymbol, NIL, 0)
+# define NewStrictTailStrictNil() NewNormalNode (StrictTailStrictNilSymbol, NIL, 0)
+# define NewUnboxedTailStrictNil() NewNormalNode (UnboxedTailStrictNilSymbol, NIL, 0)
+#endif
+
extern NodeP NewIntNode (int value);
extern ImpRules NewRule (unsigned line_number, TypeAlts typeAlternative, NodeP rule_root, ScopeP scope);
@@ -101,6 +110,14 @@ extern SymbolP BasicTypeSymbols [],
TrueSymbol, FalseSymbol, TupleSymbol, ListSymbol, ConsSymbol, NilSymbol,
ApplySymbol, ApplyTypeSymbol, SelectSymbols[],
FailSymbol, IfSymbol, AllSymbol, EmptyTypeSymbol;
+#if STRICT_LISTS
+extern SymbolP
+ StrictListSymbol, StrictConsSymbol, StrictNilSymbol,
+ UnboxedListSymbol, UnboxedConsSymbol, UnboxedNilSymbol,
+ TailStrictListSymbol, TailStrictConsSymbol, TailStrictNilSymbol,
+ StrictTailStrictListSymbol, StrictTailStrictConsSymbol, StrictTailStrictNilSymbol,
+ UnboxedTailStrictListSymbol, UnboxedTailStrictConsSymbol, UnboxedTailStrictNilSymbol;
+#endif
extern SymbolP TupleTypeSymbols [];
IdentP UseArrayFunctionId (ArrayFunKind kind);
diff --git a/backendC/CleanCompilerSources/checker.h b/backendC/CleanCompilerSources/checker.h
index 6380ec4..1a0121d 100644
--- a/backendC/CleanCompilerSources/checker.h
+++ b/backendC/CleanCompilerSources/checker.h
@@ -7,6 +7,9 @@
extern Ident AnnotatedId, ListId, TupleId, ConsId, NilId, ApplyId, SelectId, IfId, FailId, DeltaBId,
AndId, OrId, StdArrayId, ArrayFunctionIds [], ArrayId, StrictArrayId, UnboxedArrayId, ArrayClassId;
+#if STRICT_LISTS
+extern Ident StrictListId,UnboxedListId,TailStrictListId,StrictTailStrictListId,UnboxedTailStrictListId;
+#endif
#ifdef CLEAN2
extern Ident DynamicId;
#endif
diff --git a/backendC/CleanCompilerSources/checker_2.c b/backendC/CleanCompilerSources/checker_2.c
index 3502cc2..3a7694b 100644
--- a/backendC/CleanCompilerSources/checker_2.c
+++ b/backendC/CleanCompilerSources/checker_2.c
@@ -12,6 +12,7 @@
#define MOVE_CURRIED_APPLICATIONS
#define MOVE_FUNCTIONS_IN_LAMBDAS
+#include "compiledefines.h"
#include "types.t"
#include "system.h"
#include "syntaxtr.t"
diff --git a/backendC/CleanCompilerSources/checksupport.c b/backendC/CleanCompilerSources/checksupport.c
index 9605040..70f7406 100644
--- a/backendC/CleanCompilerSources/checksupport.c
+++ b/backendC/CleanCompilerSources/checksupport.c
@@ -1,4 +1,5 @@
+#include "compiledefines.h"
#include "types.t"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/checktypedefs_2.c b/backendC/CleanCompilerSources/checktypedefs_2.c
index beb51ce..23ebcc3 100644
--- a/backendC/CleanCompilerSources/checktypedefs_2.c
+++ b/backendC/CleanCompilerSources/checktypedefs_2.c
@@ -8,6 +8,7 @@
#define COMPLEX_ABSTYPES
+#include "compiledefines.h"
#include "types.t"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/cocl.c b/backendC/CleanCompilerSources/cocl.c
index b423459..2d91077 100644
--- a/backendC/CleanCompilerSources/cocl.c
+++ b/backendC/CleanCompilerSources/cocl.c
@@ -1,9 +1,9 @@
#include "compiledefines.h"
-#include "system.h"
-#include <ctype.h>
#include "comsupport.h"
#include "settings.h"
+#include "system.h"
+#include <ctype.h>
#include "compiler.h"
#include "version.h"
diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c
index d3dba60..6109d4a 100644
--- a/backendC/CleanCompilerSources/codegen.c
+++ b/backendC/CleanCompilerSources/codegen.c
@@ -4,6 +4,8 @@
#define SHARE_UPDATE_CODE 0 /* also in codegen1.c */
#define SELECTORS_FIRST 1 /* also in codegen2.c */
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "syntaxtr.t"
#include "comsupport.h"
@@ -26,7 +28,6 @@
# if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
#include "tuple_tail_recursion.h"
# endif
-#include "dbprint.h"
static char *ECodeBlock = "incorrect number of output parameters";
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c
index 64361f4..f41f5a8 100644
--- a/backendC/CleanCompilerSources/codegen1.c
+++ b/backendC/CleanCompilerSources/codegen1.c
@@ -9,8 +9,9 @@
#define FREE_STRICT_LHS_TUPLE_ELEMENTS 1 /* also in codegen2.c */
#define BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS 1
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
@@ -88,6 +89,11 @@ LabDef tuple_lab = {NULL, "", False, "_Tuple", 0};
LabDef empty_lab = {NULL, "", False, "_", 0};
LabDef add_arg_lab = {NULL, "", False, "_add_arg", 0};
LabDef match_error_lab = {NULL, "", False, "_match_error", 0};
+#if STRICT_LISTS
+LabDef conss_lab = {NULL, "", False, "_Conss", 0};
+LabDef consts_lab = {NULL, "", False, "_Consts", 0};
+LabDef conssts_lab = {NULL, "", False, "_Conssts", 0};
+#endif
#ifdef CLEAN2
LabDef select_with_dictionary_lab = {NULL, "", False, "_select_with_dictionary", 0};
LabDef update_with_dictionary_lab = {NULL, "", False, "_update_with_dictionary", 0};
diff --git a/backendC/CleanCompilerSources/codegen1.h b/backendC/CleanCompilerSources/codegen1.h
index d388317..a93e19d 100644
--- a/backendC/CleanCompilerSources/codegen1.h
+++ b/backendC/CleanCompilerSources/codegen1.h
@@ -16,6 +16,9 @@ extern char channel_code [],ext_nf_reducer_code[],nf_reducer_code[],hnf_reducer_
extern LabDef
cycle_lab, reserve_lab, type_error_lab, indirection_lab, ind_lab,
hnf_lab, cons_lab, nil_lab, tuple_lab, empty_lab, add_arg_lab, match_error_lab,
+#if STRICT_LISTS
+ conss_lab,consts_lab,conssts_lab,
+#endif
#ifdef CLEAN2
select_with_dictionary_lab, update_with_dictionary_lab,
#endif
diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c
index 4dcfd77..f1f738b 100644
--- a/backendC/CleanCompilerSources/codegen2.c
+++ b/backendC/CleanCompilerSources/codegen2.c
@@ -14,6 +14,8 @@
#define FREE_STRICT_LHS_TUPLE_ELEMENTS 1 /* also in codegen1.c */
#define SELECTORS_FIRST 1 /* also in codegen.c */
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c
index d1682c6..ba675c8 100644
--- a/backendC/CleanCompilerSources/codegen3.c
+++ b/backendC/CleanCompilerSources/codegen3.c
@@ -10,6 +10,8 @@
#define for_li(v,i,l,n) for(v=(l),i=0;v!=NULL;v=v->n,++i)
#define for_ll(v1,v2,l1,l2,n1,n2) for(v1=(l1),v2=(l2);v1!=NULL;v1=v1->n1,v2=v2->n2)
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/comparser_2.c b/backendC/CleanCompilerSources/comparser_2.c
index 3a257ae..c784f16 100644
--- a/backendC/CleanCompilerSources/comparser_2.c
+++ b/backendC/CleanCompilerSources/comparser_2.c
@@ -13,6 +13,7 @@
# undef H
+# include "compiledefines.h"
# include "types.t"
# include "syntaxtr.t"
@@ -119,6 +120,78 @@ InitParser (void)
ListSymbol = NewSymbol (list_type);
ConsSymbol = NewSymbol (cons_symb);
NilSymbol = NewSymbol (nil_symb);
+
+#if STRICT_LISTS
+ ListSymbol->symb_head_strictness=0;
+ ListSymbol->symb_tail_strictness=0;
+
+ ConsSymbol->symb_head_strictness=0;
+ ConsSymbol->symb_tail_strictness=0;
+
+ NilSymbol->symb_head_strictness=0;
+ NilSymbol->symb_tail_strictness=0;
+
+ StrictListSymbol= NewSymbol (list_type);
+ StrictListSymbol->symb_head_strictness=1;
+ StrictListSymbol->symb_tail_strictness=0;
+
+ UnboxedListSymbol= NewSymbol (list_type);
+ UnboxedListSymbol->symb_head_strictness=2;
+ UnboxedListSymbol->symb_tail_strictness=0;
+
+ TailStrictListSymbol= NewSymbol (list_type);
+ TailStrictListSymbol->symb_head_strictness=0;
+ TailStrictListSymbol->symb_tail_strictness=1;
+
+ StrictTailStrictListSymbol= NewSymbol (list_type);
+ StrictTailStrictListSymbol->symb_head_strictness=1;
+ StrictTailStrictListSymbol->symb_tail_strictness=1;
+
+ UnboxedTailStrictListSymbol= NewSymbol (list_type);
+ UnboxedTailStrictListSymbol->symb_head_strictness=2;
+ UnboxedTailStrictListSymbol->symb_tail_strictness=1;
+
+ StrictConsSymbol= NewSymbol (cons_symb);
+ StrictConsSymbol->symb_head_strictness=1;
+ StrictConsSymbol->symb_tail_strictness=0;
+
+ UnboxedConsSymbol= NewSymbol (cons_symb);
+ UnboxedConsSymbol->symb_head_strictness=2;
+ UnboxedConsSymbol->symb_tail_strictness=0;
+
+ TailStrictConsSymbol= NewSymbol (cons_symb);
+ TailStrictConsSymbol->symb_head_strictness=0;
+ TailStrictConsSymbol->symb_tail_strictness=1;
+
+ StrictTailStrictConsSymbol= NewSymbol (cons_symb);
+ StrictTailStrictConsSymbol->symb_head_strictness=1;
+ StrictTailStrictConsSymbol->symb_tail_strictness=1;
+
+ UnboxedTailStrictConsSymbol= NewSymbol (cons_symb);
+ UnboxedTailStrictConsSymbol->symb_head_strictness=2;
+ UnboxedTailStrictConsSymbol->symb_tail_strictness=1;
+
+ StrictNilSymbol = NewSymbol (nil_symb);
+ StrictNilSymbol->symb_head_strictness=1;
+ StrictNilSymbol->symb_tail_strictness=0;
+
+ UnboxedNilSymbol = NewSymbol (nil_symb);
+ UnboxedNilSymbol->symb_head_strictness=2;
+ UnboxedNilSymbol->symb_tail_strictness=0;
+
+ TailStrictNilSymbol = NewSymbol (nil_symb);
+ TailStrictNilSymbol->symb_head_strictness=0;
+ TailStrictNilSymbol->symb_tail_strictness=1;
+
+ StrictTailStrictNilSymbol = NewSymbol (nil_symb);
+ StrictTailStrictNilSymbol->symb_head_strictness=1;
+ StrictTailStrictNilSymbol->symb_tail_strictness=1;
+
+ UnboxedTailStrictNilSymbol = NewSymbol (nil_symb);
+ UnboxedTailStrictNilSymbol->symb_head_strictness=2;
+ UnboxedTailStrictNilSymbol->symb_tail_strictness=1;
+#endif
+
ApplySymbol = NewSymbol (apply_symb);
FailSymbol = NewSymbol (fail_symb);
AllSymbol = NewSymbol (all_symb);
diff --git a/backendC/CleanCompilerSources/compiledefines.h b/backendC/CleanCompilerSources/compiledefines.h
index 2157bb8..b7d762d 100644
--- a/backendC/CleanCompilerSources/compiledefines.h
+++ b/backendC/CleanCompilerSources/compiledefines.h
@@ -17,3 +17,7 @@
#define IMPORT_OBJ_AND_LIB 1
#define WRITE_DCL_MODIFICATION_TIME 1
+
+#define STRICT_LISTS 0
+
+#undef KARBON \ No newline at end of file
diff --git a/backendC/CleanCompilerSources/compiler.c b/backendC/CleanCompilerSources/compiler.c
index fe3125f..be619f6 100644
--- a/backendC/CleanCompilerSources/compiler.c
+++ b/backendC/CleanCompilerSources/compiler.c
@@ -1,8 +1,9 @@
#undef PROFILE
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/comsupport.c b/backendC/CleanCompilerSources/comsupport.c
index a3e5201..bb0d320 100644
--- a/backendC/CleanCompilerSources/comsupport.c
+++ b/backendC/CleanCompilerSources/comsupport.c
@@ -14,6 +14,8 @@
Version: 1.0
*/
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "sizes.h"
#include "cmdline.h"
@@ -323,6 +325,17 @@ void FatalCompError (char *mod, char *proc, char *mess)
OpenedFile = (File) NIL;
}
#ifdef CLEAN2
+# ifdef _MAC_
+ {
+ FILE *f;
+
+ f=fopen ("FatalCompError","w");
+ if (f!=NULL){
+ FPrintF (f,"Fatal Error in %s:%s \"%s\"\n", mod, proc, mess);
+ fclose (f);
+ }
+ }
+# endif
exit (1);
#else
longjmp (ExitEnv, 1);
@@ -669,6 +682,20 @@ void ErrorInCompiler (char *mod, char *proc, char *msg)
FPrintF (StdError,"Error in compiler: Module %s, Function %s, \"%s\"\n",mod,proc,msg);
#ifdef CLEAN2
+# ifdef _MAC_
+ {
+ FILE *f;
+
+ f=fopen ("ErrorInCompiler","w");
+ if (f!=NULL){
+ if (CurrentModule!=NULL)
+ FPrintF (f,"Error in compiler while compiling %s.icl: Module %s, Function %s, \"%s\"\n",CurrentModule,mod,proc,msg);
+ else
+ FPrintF (f,"Error in compiler: Module %s, Function %s, \"%s\"\n",mod,proc,msg);
+ fclose (f);
+ }
+ }
+# endif
exit (1);
#endif
}
diff --git a/backendC/CleanCompilerSources/dbprint.c b/backendC/CleanCompilerSources/dbprint.c
index 2e3fc36..a864bdf 100644
--- a/backendC/CleanCompilerSources/dbprint.c
+++ b/backendC/CleanCompilerSources/dbprint.c
@@ -1,4 +1,6 @@
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c
index d9c9512..80ecb14 100644
--- a/backendC/CleanCompilerSources/instructions.c
+++ b/backendC/CleanCompilerSources/instructions.c
@@ -6,6 +6,7 @@
#pragma segment instructions
#include "compiledefines.h"
+#include "comsupport.h"
#include "system.h"
#include <ctype.h>
@@ -18,7 +19,6 @@
#include "codegen_types.h"
#include "codegen1.h"
#include "codegen2.h"
-#include "comsupport.h"
#include "instructions.h"
#include "statesgen.h"
#include "version.h"
@@ -3254,15 +3254,23 @@ void GenSystemImports (void)
GenImpLab_node_entry (indirection_lab.lab_name,"_eaind");
GenImpDesc ("e_system_dif");
GenImpLab_node_entry ("e_system_nif","e_system_eaif");
+ GenImpLab ("e_system_sif");
+
GenImpDesc ("e_system_dAP");
GenImpLab_node_entry ("e_system_nAP","e_system_eaAP");
-
- GenImpLab ("e_system_sif");
GenImpLab ("e_system_sAP");
- GenImpDesc (cons_lab.lab_name);
+
GenImpDesc (nil_lab.lab_name);
+ GenImpDesc (cons_lab.lab_name);
+#if STRICT_LISTS
+ GenImpDesc (conss_lab.lab_name);
+ GenImpLab_node_entry ("n_Conss","ea_Conss");
+ GenImpDesc (consts_lab.lab_name);
+ GenImpLab_node_entry ("n_Consts","ea_Consts");
+ GenImpDesc (conssts_lab.lab_name);
+ GenImpLab_node_entry ("n_Conssts","ea_Conssts");
+#endif
GenImpDesc (tuple_lab.lab_name);
-
for (selnum=1; selnum<=NrOfGlobalSelectors; ++selnum){
put_directive_b (impdesc);
FPrintF (OutFile,D_PREFIX "%s.%d",glob_sel,selnum);
@@ -3285,11 +3293,6 @@ void GenParameters (Bool input, Parameters params, int asp, int bsp)
{
int is_first_parameter;
-/* RWS ... ??? */
- if (params==NULL)
- return;
-/* ... RWS */
-
if (input)
put_instruction_ (Iin);
else
diff --git a/backendC/CleanCompilerSources/mac.h b/backendC/CleanCompilerSources/mac.h
index 9b55823..07aea6a 100644
--- a/backendC/CleanCompilerSources/mac.h
+++ b/backendC/CleanCompilerSources/mac.h
@@ -66,5 +66,5 @@ extern int open_dcl_file_for_block_reading (char *fname,File *file_p);
extern int read_next_block_from_dcl_file (char *buffer);
#if WRITE_DCL_MODIFICATION_TIME
-extern int open_dcl_file_for_block_reading_with_file_time (char *file_name,File *file_p,unsigned long *file_time_p);
+extern int open_dcl_file_for_block_reading_with_file_time (char *file_name,File *file_p,FileTime *file_time_p);
#endif \ No newline at end of file
diff --git a/backendC/CleanCompilerSources/mac_io.c b/backendC/CleanCompilerSources/mac_io.c
index e169074..bd2b55e 100644
--- a/backendC/CleanCompilerSources/mac_io.c
+++ b/backendC/CleanCompilerSources/mac_io.c
@@ -1,4 +1,10 @@
+#include "compiledefines.h"
+
+#ifdef KARBON
+# define TARGET_API_MAC_CARBON 1
+#endif
+
#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
#if defined (applec) || defined (__MWERKS__) || defined (__MRC__)
@@ -18,6 +24,7 @@
#include "compiledefines.h"
#ifndef _SYSTEM_
+# include "types.t"
# include "system.h"
#endif
@@ -61,35 +68,96 @@ static unsigned char *copy_c_to_p_string (char *c_string,char *p_string)
return (unsigned char*) p_string;
}
-static FileTime FindFileTime (char *fname,int wd_ref_num)
-{
- int err;
- FileParam fpb;
- char p_string [256];
+#ifdef KARBON
+ static int FindFileUTCDateTime0 (char *fname,UTCDateTime *file_time_p)
+ {
+ int err;
+ FSCatalogInfo catalog_info;
+ FSRef fs_ref;
+ FSSpec fs_spec;
- fpb.ioNamePtr=copy_c_to_p_string (fname,p_string);
- fpb.ioFDirIndex=0;
- fpb.ioFVersNum=0;
- fpb.ioVRefNum=wd_ref_num;
+ copy_c_to_p_string (fname,(char*)&fs_spec.name);
+ fs_spec.parID=0;
+ fs_spec.vRefNum=0;
-#ifdef mpwc
- err = PBGetFInfoSync ((ParmBlkPtr)&fpb);
+ err = FSpMakeFSRef (&fs_spec,&fs_ref);
+ if (err)
+ return 0;
+
+ err = FSGetCatalogInfo (&fs_ref,kFSCatInfoContentMod,&catalog_info,NULL,NULL,NULL);
+ if (err)
+ return 0;
+ else {
+ *file_time_p=catalog_info.contentModDate;
+
+ return 1;
+ }
+ }
+
+ static int FindFileUTCDateTime (char *fname,struct vd_id vd_id,UTCDateTime *file_time_p)
+ {
+ int err;
+ FSCatalogInfo catalog_info;
+ FSRef fs_ref;
+ FSSpec fs_spec;
+
+ copy_c_to_p_string (fname,(char*)&fs_spec.name);
+ fs_spec.parID=vd_id.directory_id;
+ fs_spec.vRefNum=vd_id.volume_id;
+
+ err = FSpMakeFSRef (&fs_spec,&fs_ref);
+ if (err)
+ return 0;
+
+ err = FSGetCatalogInfo (&fs_ref,kFSCatInfoContentMod,&catalog_info,NULL,NULL,NULL);
+ if (err!=0)
+ return 0;
+ else {
+ *file_time_p=catalog_info.contentModDate;
+
+ return 1;
+ }
+ }
+#else
+ static FileTime FindFileTime (char *fname,int wd_ref_num)
+ {
+ int err;
+ FileParam fpb;
+ char p_string [256];
+
+ fpb.ioNamePtr=copy_c_to_p_string (fname,p_string);
+ fpb.ioFDirIndex=0;
+ fpb.ioFVersNum=0;
+ fpb.ioVRefNum=wd_ref_num;
+
+#ifdef KARBON
+ err = PBHGetFInfo ((HParmBlkPtr)&fpb,0);
#else
- err = PBGetFInfo (&fpb, 0);
+# ifdef mpwc
+ err = PBGetFInfoSync ((ParmBlkPtr)&fpb);
+# else
+ err = PBGetFInfo (&fpb, 0);
+# endif
#endif
- if (err)
- return NoFile;
- else
- return fpb.ioFlMdDat;
-}
+ if (err)
+ return NoFile;
+ else
+ return fpb.ioFlMdDat;
+ }
+#endif
char *PATHLIST;
#ifdef mpwc
struct path_list {
+# ifdef KARBON
+ struct vd_id path_vd_id;
+ struct vd_id path_clean_system_files_vd_id;
+# else
short path_wd_ref_num;
short path_clean_system_files_wd_ref_num;
+# endif
struct path_list * path_next;
#if defined (__MWERKS__) || defined (__MRC__)
char path_name[];
@@ -102,12 +170,18 @@ static struct path_list *path_list=NULL;
static void add_directory_to_path_list (char *path_name,struct path_list **old_path_list_h)
{
- short wd_ref_num,clean_system_files_wd_ref_num;
struct path_list *new_path,**last_path_p;
int path_name_length;
char p_string [256];
+#ifdef KARBON
+ struct vd_id vd_id,clean_system_files_vd_id;
+ FSSpec fs_spec;
+ FSRef fs_ref;
+#else
+ short wd_ref_num,clean_system_files_wd_ref_num;
CInfoPBRec fpb;
WDPBRec wd_pb;
+#endif
int err,root_path;
root_path=0;
@@ -125,6 +199,24 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
}
}
+#ifdef KARBON
+ vd_id.volume_id=0;
+ vd_id.directory_id=0;
+ err = FSMakeFSSpec (0,0,path_name ? copy_c_to_p_string (path_name,p_string) : (unsigned char*)"\001:",&fs_spec);
+ if (err==0){
+ err = FSpMakeFSRef (&fs_spec,&fs_ref);
+ if (err==0){
+ FSCatalogInfo catalog_info;
+
+ err = FSGetCatalogInfo (&fs_ref,kFSCatInfoVolume|kFSCatInfoNodeID,&catalog_info,NULL,NULL,NULL);
+
+ if (err==0){
+ vd_id.volume_id=catalog_info.volume;
+ vd_id.directory_id=catalog_info.nodeID;
+ }
+ }
+ }
+#else
if (path_name)
fpb.hFileInfo.ioNamePtr=copy_c_to_p_string (path_name,p_string);
else
@@ -135,6 +227,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
fpb.hFileInfo.ioDirID=0;
err = PBGetCatInfoSync (&fpb);
+#endif
if (err!=0){
#ifdef FOLDER_DOES_NOT_EXIST_ERRORS
@@ -148,6 +241,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
return;
}
+#ifndef KARBON
wd_pb.ioNamePtr=fpb.hFileInfo.ioNamePtr;
wd_pb.ioWDProcID='ClCo';
@@ -169,6 +263,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
}
wd_ref_num=wd_pb.ioVRefNum;
+#endif
#ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
if (path_name){
@@ -178,7 +273,38 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
strcat (path_name,":Clean System Files");
} else
path_name="Clean System Files";
+
+# ifdef KARBON
+ clean_system_files_vd_id.volume_id=0;
+ clean_system_files_vd_id.directory_id=0;
+ err = FSMakeFSSpec (0,0,copy_c_to_p_string (path_name,p_string),&fs_spec);
+
+ if (err==fnfErr){
+ long dir_id;
+
+ err=FSpDirCreate (&fs_spec,smSystemScript,&dir_id);
+ }
+
+ if (err==0){
+ err = FSpMakeFSRef (&fs_spec,&fs_ref);
+ if (err==0){
+ FSCatalogInfo catalog_info;
+
+ err = FSGetCatalogInfo (&fs_ref,kFSCatInfoVolume|kFSCatInfoNodeID,&catalog_info,NULL,NULL,NULL);
+
+ if (err==0){
+ clean_system_files_vd_id.volume_id=catalog_info.volume;
+ clean_system_files_vd_id.directory_id=catalog_info.nodeID;
+ }
+ }
+ }
+ if (err!=0){
+ fprintf (stderr,"cannot create folder '%s'\n",path_name);
+
+ return;
+ }
+# else
fpb.hFileInfo.ioNamePtr=copy_c_to_p_string (path_name,p_string);
fpb.hFileInfo.ioVRefNum =0;
fpb.hFileInfo.ioFDirIndex=0;
@@ -213,6 +339,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
}
clean_system_files_wd_ref_num=wd_pb.ioVRefNum;
+# endif
path_name_length=strlen (path_name)-strlen (":Clean System Files");
if (path_name_length<0)
@@ -236,8 +363,16 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
struct path_list *old_path_list_p;
for (; (old_path_list_p=*old_path_list_h)!=NULL; old_path_list_h=&old_path_list_p->path_next){
- if (old_path_list_p->path_wd_ref_num==wd_ref_num &&
+ if (
+#ifdef KARBON
+ old_path_list_p->path_vd_id.volume_id==vd_id.volume_id &&
+ old_path_list_p->path_vd_id.directory_id==vd_id.directory_id &&
+ old_path_list_p->path_clean_system_files_vd_id.volume_id==clean_system_files_vd_id.volume_id &&
+ old_path_list_p->path_clean_system_files_vd_id.directory_id==clean_system_files_vd_id.directory_id &&
+#else
+ old_path_list_p->path_wd_ref_num==wd_ref_num &&
old_path_list_p->path_clean_system_files_wd_ref_num==clean_system_files_wd_ref_num &&
+#endif
!strcmp (old_path_list_p->path_name,path_name))
{
*old_path_list_h=old_path_list_p->path_next;
@@ -250,8 +385,13 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p
}
new_path=(struct path_list*)Alloc (1,sizeof (struct path_list)+1+path_name_length);
+#ifdef KARBON
+ new_path->path_vd_id=vd_id;
+ new_path->path_clean_system_files_vd_id=clean_system_files_vd_id;
+#else
new_path->path_wd_ref_num=wd_ref_num;
new_path->path_clean_system_files_wd_ref_num=clean_system_files_wd_ref_num;
+#endif
strcpy (new_path->path_name,path_name);
new_path->path_next=NULL;
@@ -387,14 +527,20 @@ extern char *clean_abc_path; /* imported from clm.c */
#endif
for_l (path_elem,path_list,path_next){
- short wd_ref_num;
+#ifdef KARBON
+ UTCDateTime file_time;
+
+ if (FindFileUTCDateTime (path,path_elem->path_vd_id,&file_time)){
+#else
unsigned long file_time;
+ short wd_ref_num;
wd_ref_num=path_elem->path_wd_ref_num;
file_time=FindFileTime (path,wd_ref_num);
if (file_time!=NoFile){
+#endif
strcpy (path,path_elem->path_name);
#ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
@@ -411,8 +557,13 @@ extern char *clean_abc_path; /* imported from clm.c */
#if USE_PATH_CACHE
if (kind==dclFile)
- cache_dcl_path (file_name,path_elem->path_wd_ref_num,
- path_elem->path_clean_system_files_wd_ref_num,file_time,path_elem->path_name);
+ cache_dcl_path (file_name,
+# ifdef KARBON
+ path_elem->path_vd_id,path_elem->path_clean_system_files_vd_id,
+# else
+ path_elem->path_wd_ref_num,path_elem->path_clean_system_files_wd_ref_num,
+# endif
+ file_time,path_elem->path_name);
#endif
*file_time_p=file_time;
@@ -424,6 +575,9 @@ extern char *clean_abc_path; /* imported from clm.c */
strcpy (path,file_name);
strcat (path,file_extension);
+#ifdef KARBON
+ return FindFileUTCDateTime0 (path,file_time_p);
+#else
{
unsigned long file_time;
@@ -434,7 +588,8 @@ extern char *clean_abc_path; /* imported from clm.c */
*file_time_p=file_time;
return True;
}
- }
+ }
+#endif
}
#endif
@@ -503,19 +658,33 @@ extern char *clean_abc_path; /* imported from clm.c */
#else
for_l (path_elem,path_list,path_next){
#endif
+#ifdef KARBON
+ struct vd_id vd_id;
+ FileTime file_time;
+
+# ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
+ if (in_clean_system_files_folder)
+ vd_id=path_elem->path_clean_system_files_vd_id;
+ else
+# endif
+ vd_id=path_elem->path_vd_id;
+
+ if (FindFileUTCDateTime (path,vd_id,&file_time)){
+#else
short wd_ref_num;
unsigned long file_time;
-#ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
+# ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
if (in_clean_system_files_folder)
wd_ref_num=path_elem->path_clean_system_files_wd_ref_num;
else
-#endif
+# endif
wd_ref_num=path_elem->path_wd_ref_num;
file_time=FindFileTime (path,wd_ref_num);
if (file_time!=NoFile){
+#endif
strcpy (path,path_elem->path_name);
#ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS
@@ -537,8 +706,13 @@ extern char *clean_abc_path; /* imported from clm.c */
#if USE_PATH_CACHE
if (kind==dclFile && !in_clean_system_files_folder)
- cache_dcl_path (file_name,path_elem->path_wd_ref_num,
- path_elem->path_clean_system_files_wd_ref_num,file_time,path_elem->path_name);
+ cache_dcl_path (file_name,
+# ifdef KARBON
+ path_elem->path_vd_id,path_elem->path_clean_system_files_vd_id,
+# else
+ path_elem->path_wd_ref_num,path_elem->path_clean_system_files_wd_ref_num,
+# endif
+ file_time,path_elem->path_name);
#endif
return True;
}
@@ -559,7 +733,14 @@ extern char *clean_abc_path; /* imported from clm.c */
strcat (path,file_extension);
- return FindFileTime (path,0);
+# ifdef KARBON
+ {
+ FileTime file_time;
+ return FindFileUTCDateTime0 (path,&file_time);
+ }
+# else
+ return FindFileTime (path,0)!=NoFile;
+# endif
}
#else
static Bool findfilepath (char *wname, FileKind kind, char *path)
@@ -573,7 +754,11 @@ extern char *clean_abc_path; /* imported from clm.c */
strcpy (path,wname);
strcat (path,file_extension);
+# ifdef KARBON
+ if (FindFileUTCDateTime0 (path) != NoFile)
+# else
if (FindFileTime (path,0) != NoFile)
+# endif
return True;
pathelem = PATHLIST;
@@ -593,7 +778,11 @@ extern char *clean_abc_path; /* imported from clm.c */
strcat (path, wname);
strcat (path,file_extension);
+#ifdef KARBON
+ if (FindFileUTCDateTime0 (path) != NoFile)
+#else
if (FindFileTime (path,0) != NoFile)
+#endif
return True;
/* if all else fails, exit the loop */
@@ -885,7 +1074,8 @@ long FTell (File f)
{
return ftell ((FILE *) f);
} /* FTell */
-
+
+#ifndef KARBON
FileTime FGetFileTime (char *fname, FileKind kind)
{
char path[MAXPATHLEN];
@@ -896,17 +1086,34 @@ FileTime FGetFileTime (char *fname, FileKind kind)
/* FPrintF (StdOut, "timing %s\n", fname); */
if (res)
+#ifdef KARBON
+ return FindFileUTCDateTime0 (path);
+#else
return FindFileTime (path,0);
+#endif
else
return NoFile;
-} /* FGetFileTime */
+}
+#endif
#ifdef WRITE_DCL_MODIFICATION_TIME
void FWriteFileTime (FileTime file_time,File f)
{
DateTimeRec date_and_time;
+# ifdef KARBON
+ {
+ LocalDateTime local_date_and_time;
+ LongDateRec long_date_and_time;
+ SInt64 long_file_time;
+ ConvertUTCToLocalDateTime (&file_time,&local_date_and_time);
+ long_file_time=((SInt64)local_date_and_time.highSeconds<<32) | local_date_and_time.lowSeconds;
+ LongSecondsToDate (&long_file_time,&long_date_and_time);
+ date_and_time=long_date_and_time.od.oldDate;
+ }
+# else
SecondsToDate (file_time,&date_and_time);
+# endif
fprintf (f,"%04d%02d%02d%02d%02d%02d",
date_and_time.year,date_and_time.month,date_and_time.day,
@@ -928,7 +1135,7 @@ void DoError (char *fmt, ...)
(void) vfprintf (stderr, fmt, args);
va_end (args);
-} /* DoError */
+}
void DoFatalError (char *fmt, ...)
{ va_list args;
@@ -940,8 +1147,7 @@ void DoFatalError (char *fmt, ...)
va_end (args);
exit (0);
-} /* DoFatalError */
-
+}
void CmdError (char *errormsg,...)
{ va_list args;
@@ -953,17 +1159,17 @@ void CmdError (char *errormsg,...)
fputc ('\n', stdout);
va_end (args);
-} /* CmdError */
+}
extern long GetMainModuleVolume (void);
long GetMainModuleVolume (void)
{
return 0;
-} /* GetMainModuleVolume */
+}
static void Nothing (void)
{
-} /* Nothing */
+}
static void (*interfunct) (void) = Nothing;
@@ -971,7 +1177,7 @@ void (*SetSignal (void (*f) (void))) (void)
{ void (*oldf) () = interfunct;
interfunct = f;
return oldf;
-} /* SetSignal */
+}
int CheckInterrupt ()
{
diff --git a/backendC/CleanCompilerSources/macros_2.c b/backendC/CleanCompilerSources/macros_2.c
index 0a63a9b..a7b974a 100644
--- a/backendC/CleanCompilerSources/macros_2.c
+++ b/backendC/CleanCompilerSources/macros_2.c
@@ -3,6 +3,8 @@
Author: John van Groningen
*/
+#include "compiledefines.h"
+#include "types.t"
#include "types.t"
#include "system.h"
#include "syntaxtr.t"
@@ -14,4 +16,3 @@
#include "checktypedefs.h"
struct local_def *free_ldefs;
-
diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c
index bb83056..f0ffede 100644
--- a/backendC/CleanCompilerSources/optimisations.c
+++ b/backendC/CleanCompilerSources/optimisations.c
@@ -3,6 +3,8 @@
Author: John van Groningen
*/
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "syntaxtr.t"
#include "comsupport.h"
@@ -1549,7 +1551,11 @@ static void optimise_normal_node (Node node)
#else
if ((BETWEEN (int_denot,real_denot,symbol->symb_kind)
|| symbol->symb_kind==string_denot
+# if STRICT_LISTS
+ || (BETWEEN (tuple_symb,nil_symb,symbol->symb_kind) && !(symbol->symb_kind==cons_symb && (symbol->symb_head_strictness || symbol->symb_tail_strictness)))
+# else
|| BETWEEN (tuple_symb,nil_symb,symbol->symb_kind)
+# endif
) && node->node_state.state_kind==OnA){
#endif
node->node_state.state_kind=StrictOnA;
@@ -1903,6 +1909,10 @@ static Bool try_insert_constructor_update_node (NodeP node,FreeUniqueNodeIdsP *f
break;
}
case cons_symb:
+#if STRICT_LISTS
+ if ((node->node_symbol->symb_head_strictness || node->node_symbol->symb_tail_strictness) && IsLazyStateKind (node->node_state.state_kind))
+ return False;
+#endif
return insert_unique_fill_node (node,f_node_ids,2,0);
case tuple_symb:
return insert_unique_fill_node (node,f_node_ids,node->node_arity,0);
@@ -3394,7 +3404,7 @@ static ImpRuleS **OptimiseRule (ImpRuleS *rule)
new_rules=new_rule->rule_next;
alt=new_rule->rule_alts;
- DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0);
+ DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,&alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0);
ReorderNodeDefinitionsAndDetermineUsedEntries (&alt->alt_rhs_defs,alt->alt_rhs_root);
new_rule->rule_next=rule->rule_next;
diff --git a/backendC/CleanCompilerSources/overloading_2.c b/backendC/CleanCompilerSources/overloading_2.c
index ed5a04e..b79912f 100644
--- a/backendC/CleanCompilerSources/overloading_2.c
+++ b/backendC/CleanCompilerSources/overloading_2.c
@@ -4,8 +4,9 @@
Author: Sjaak Smetsers
*/
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/path_cache.c b/backendC/CleanCompilerSources/path_cache.c
index e2b0eef..c8b7325 100644
--- a/backendC/CleanCompilerSources/path_cache.c
+++ b/backendC/CleanCompilerSources/path_cache.c
@@ -1,18 +1,30 @@
+#if 0
+#define KARBON
+#define TARGET_API_MAC_CARBON 1
+#endif
+
#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
+#include <Files.h>
#include "path_cache.h"
struct path_cache_list {
char * pcache_path;
+#ifdef KARBON
+ struct vd_id pcache_vd_id;
+ struct vd_id pcache_clean_system_files_vd_id;
+#else
short pcache_wd_ref_num;
short pcache_clean_system_files_wd_ref_num;
- FileTime pcache_dcl_time;
+#endif
+ FileTime pcache_dcl_time;
struct path_cache_list * pcache_next;
struct file_block * pcache_file_blocks;
#if defined (__MWERKS__) || defined (__MRC__)
@@ -49,8 +61,13 @@ static int simple_hash (char *name)
return sum & 31;
}
-void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_wd_ref_num,
- unsigned long file_time,char *path)
+void cache_dcl_path (char *file_name,
+#ifdef KARBON
+ struct vd_id vd_id,struct vd_id clean_system_files_vd_id,
+#else
+ short wd_ref_num,short clean_system_files_wd_ref_num,
+#endif
+ FileTime file_time,char *path)
{
int hash_value,file_name_length;
struct path_cache_list **pcache_elem_p,*new_pcache_elem;
@@ -71,8 +88,13 @@ void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_w
if (new_pcache_elem!=NULL){
strcpy (new_pcache_elem->pcache_file_name,file_name);
new_pcache_elem->pcache_path=path;
+#ifdef KARBON
+ new_pcache_elem->pcache_vd_id=vd_id;
+ new_pcache_elem->pcache_clean_system_files_vd_id=clean_system_files_vd_id;
+#else
new_pcache_elem->pcache_wd_ref_num=wd_ref_num;
new_pcache_elem->pcache_clean_system_files_wd_ref_num=clean_system_files_wd_ref_num;
+#endif
new_pcache_elem->pcache_dcl_time=file_time;
new_pcache_elem->pcache_next=NULL;
new_pcache_elem->pcache_file_blocks=NULL;
@@ -95,8 +117,15 @@ int search_dcl_path_in_cache (char *file_name,struct search_dcl_path_in_cache_re
struct path_cache_list *pcache_elem;
pcache_elem=*pcache_elem_p;
+#ifdef KARBON
+/*
+ r->fs_spec=pcache_elem->pcache_vd_id;
+ r->clean_system_files_fs_spec=pcache_elem->pcache_clean_system_files_fs_spec;
+*/
+#else
r->wd_ref_num=pcache_elem->pcache_wd_ref_num;
r->clean_system_files_wd_ref_num=pcache_elem->pcache_clean_system_files_wd_ref_num;
+#endif
r->file_time=pcache_elem->pcache_dcl_time;
r->path=pcache_elem->pcache_path;
diff --git a/backendC/CleanCompilerSources/path_cache.h b/backendC/CleanCompilerSources/path_cache.h
index 68718a9..f3a9afc 100644
--- a/backendC/CleanCompilerSources/path_cache.h
+++ b/backendC/CleanCompilerSources/path_cache.h
@@ -1,11 +1,26 @@
-extern void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_wd_ref_num,
- unsigned long file_time,char *path);
+#ifdef KARBON
+ struct vd_id {
+ FSVolumeRefNum volume_id;
+ long directory_id;
+ };
+#endif
+
+extern void cache_dcl_path (char *file_name,
+#ifdef KARBON
+ struct vd_id vd_id,struct vd_id clean_system_files_vd_id,
+#else
+ short wd_ref_num,short clean_system_files_wd_ref_num,
+#endif
+ FileTime file_time,char *path);
struct search_dcl_path_in_cache_result {
+#ifdef KARBON
+#else
short wd_ref_num;
short clean_system_files_wd_ref_num;
- unsigned long file_time;
+#endif
+ FileTime file_time;
char * path;
};
diff --git a/backendC/CleanCompilerSources/pattern_match.c b/backendC/CleanCompilerSources/pattern_match.c
index ff2e15e..9c335d9 100644
--- a/backendC/CleanCompilerSources/pattern_match.c
+++ b/backendC/CleanCompilerSources/pattern_match.c
@@ -11,6 +11,7 @@
#include <stdio.h>
+#include "compiledefines.h"
#include "types.t"
#include "syntaxtr.t"
#include "pattern_match.h"
diff --git a/backendC/CleanCompilerSources/result_state_database.c b/backendC/CleanCompilerSources/result_state_database.c
index d910db0..c9e92ae 100644
--- a/backendC/CleanCompilerSources/result_state_database.c
+++ b/backendC/CleanCompilerSources/result_state_database.c
@@ -10,6 +10,7 @@
#include <stdio.h>
+#include "compiledefines.h"
#include "types.t"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c
index f26bf4e..054e9e8 100644
--- a/backendC/CleanCompilerSources/sa.c
+++ b/backendC/CleanCompilerSources/sa.c
@@ -31,6 +31,8 @@
#define SHOW_STRICT_EXPORTED_TUPLE_ELEMENTS
#define MORE_ANNOTS 1
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "settings.h"
#include "sizes.h"
@@ -113,6 +115,13 @@ static Fun
* inffunct_sym, /* the E2 id */
* botmemfunct_sym; /* the E3 id */
+#if STRICT_LISTS
+# ifndef _DB_
+static
+# endif
+Fun *strict_cons_sym,*tail_strict_cons_sym,*strict_tail_strict_cons_sym;
+#endif
+
static ExpRepr top;
static ExpRepr bottom;
static ExpRepr inf;
@@ -2183,6 +2192,15 @@ static Exp ConvertNode (Node node, NodeId nid)
e->e_hnf = True;
break;
case cons_symb:
+#if STRICT_LISTS
+ if (node->node_symbol->symb_head_strictness){
+ e->e_fun = node->node_symbol->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym;
+ break;
+ } else if (node->node_symbol->symb_tail_strictness){
+ e->e_fun = tail_strict_cons_sym;
+ break;
+ }
+#endif
e->e_hnf = True;
e->e_fun = conssym;
break;
@@ -2377,8 +2395,8 @@ static Exp ConvertNode (Node node, NodeId nid)
newrecordexp->e_args[i] = NULL;
/* now fill in the updates of the new record */
- for (arg = node->node_arguments->arg_next; arg; arg = arg->arg_next)
- { field_nr = arg->arg_node->node_symbol->symb_def->sdef_sel_field_number;
+ for_l (arg,node->node_arguments->arg_next,arg_next){
+ field_nr = arg->arg_node->node_symbol->symb_def->sdef_sel_field_number;
newrecordexp->e_args[field_nr] = ConvertNode (arg->arg_node->node_arguments->arg_node, Null);
}
@@ -2484,6 +2502,15 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i
e->e_hnf = True;
break;
case cons_symb:
+#if STRICT_LISTS
+ if (symbol_p->symb_head_strictness){
+ e->e_fun = symbol_p->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym;
+ break;
+ } else if (symbol_p->symb_tail_strictness){
+ e->e_fun = tail_strict_cons_sym;
+ break;
+ }
+#endif
e->e_hnf = True;
e->e_fun = conssym;
break;
@@ -3082,6 +3109,39 @@ static void init_predefined_symbols (void)
InitStrictResult (& f->fun_strictresult);
f++;
+#if STRICT_LISTS
+ strict_cons_sym = f;
+ f->fun_symbol = NULL;
+ f->fun_arity = 2;
+ f->fun_kind = Constructor;
+ f->fun_strictargs = InitNewStrictInfos (2,NotStrict);;
+ f->fun_single = False;
+ InitStrictInfo (f->fun_strictargs,HnfStrict);
+ InitStrictResult (&f->fun_strictresult);
+ ++f;
+
+ tail_strict_cons_sym = f;
+ f->fun_symbol = NULL;
+ f->fun_arity = 2;
+ f->fun_kind = Constructor;
+ f->fun_strictargs = InitNewStrictInfos (2,NotStrict);;
+ f->fun_single = False;
+ InitStrictInfo (&f->fun_strictargs[1],HnfStrict);
+ InitStrictResult (&f->fun_strictresult);
+ ++f;
+
+ strict_tail_strict_cons_sym = f;
+ f->fun_symbol = NULL;
+ f->fun_arity = 2;
+ f->fun_kind = Constructor;
+ f->fun_strictargs = InitNewStrictInfos (2,NotStrict);;
+ f->fun_single = False;
+ InitStrictInfo (f->fun_strictargs,HnfStrict);
+ InitStrictInfo (&f->fun_strictargs[1],HnfStrict);
+ InitStrictResult (&f->fun_strictresult);
+ ++f;
+#endif
+
if_sym = f;
f->fun_symbol = Null;
f->fun_arity = 3;
diff --git a/backendC/CleanCompilerSources/set_scope_numbers.c b/backendC/CleanCompilerSources/set_scope_numbers.c
index 993e211..9d0018e 100644
--- a/backendC/CleanCompilerSources/set_scope_numbers.c
+++ b/backendC/CleanCompilerSources/set_scope_numbers.c
@@ -1,6 +1,7 @@
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/settings.c b/backendC/CleanCompilerSources/settings.c
index a09d306..b46894a 100644
--- a/backendC/CleanCompilerSources/settings.c
+++ b/backendC/CleanCompilerSources/settings.c
@@ -1,4 +1,6 @@
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
#include "settings.h"
diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c
index 8e7b970..09f7d35 100644
--- a/backendC/CleanCompilerSources/statesgen.c
+++ b/backendC/CleanCompilerSources/statesgen.c
@@ -11,8 +11,9 @@
#pragma segment statesgen
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
@@ -1510,13 +1511,13 @@ static Bool AdjustState (StateS *old_state_p, StateS newstate)
return False;
}
-static void DetermineStateOfThenOrElse (Args t_or_e_args, NodeDefs t_or_e_defs, StateS demstate,int local_scope)
+static void DetermineStateOfThenOrElse (Args t_or_e_args, NodeDefs *t_or_e_defs, StateS demstate,int local_scope)
{
Node node;
node=t_or_e_args->arg_node;
- if (node->node_kind==NodeIdNode && t_or_e_defs==NULL){
+ if (node->node_kind==NodeIdNode && *t_or_e_defs==NULL){
NodeId node_id;
node_id=node->node_node_id;
@@ -1693,11 +1694,16 @@ static Bool ArgsInAStrictContext (StateP arg_state_p,Args argn, int local_scope)
selector_node=arg->arg_node;
selector_number=selector_node->node_symbol->symb_def->sdef_sel_field_number;
-
+
+#if 1
+ type_arg_number=selector_number;
+#else
+ /* Codewarrior 6 optimizer bug */
while (type_arg_number!=selector_number){
++type_arg_number;
}
-
+#endif
+
if (!IsLazyState (record_arg_states[type_arg_number])){
if (semi_strict
? ArgInAStrictContext (selector_node->node_arguments,StrictState,True,local_scope)
@@ -1727,6 +1733,14 @@ static Bool NodeInAStrictContext (Node node,StateS demanded_state,int local_scop
rootsymb = node->node_symbol;
switch (rootsymb->symb_kind){
case cons_symb:
+#if STRICT_LISTS
+ if (node->node_arity==2){
+ if (rootsymb->symb_head_strictness)
+ parallel = DetermineStrictArgContext (node->node_arguments,StrictState,local_scope);
+ if (rootsymb->symb_tail_strictness)
+ parallel = DetermineStrictArgContext (node->node_arguments->arg_next,StrictState,local_scope);
+ }
+#endif
if (ShouldDecrRefCount)
DecrRefCountCopiesOfArgs (node->node_arguments IF_OPTIMIZE_LAZY_TUPLE_RECURSION(local_scope));
case nil_symb:
@@ -2244,10 +2258,10 @@ static void DetermineStatesIfRootNode (Node node, StateS demstate,int local_scop
AdjustState (&node->node_state, demstate);
++scope;
- DetermineStateOfThenOrElse (condpart->arg_next,node->node_then_node_defs,demstate,new_local_scope);
+ DetermineStateOfThenOrElse (condpart->arg_next,&node->node_then_node_defs,demstate,new_local_scope);
++scope;
- DetermineStateOfThenOrElse (condpart->arg_next->arg_next,node->node_else_node_defs,demstate,new_local_scope);
+ DetermineStateOfThenOrElse (condpart->arg_next->arg_next,&node->node_else_node_defs,demstate,new_local_scope);
}
static void DetermineStatesSwitchRootNode (Node root_node, StateS demstate, int local_scope)
@@ -2265,14 +2279,12 @@ static void DetermineStatesSwitchRootNode (Node root_node, StateS demstate, int
case_alt_node_p=node->node_arguments->arg_node;
/* Codewarrior bug if (case_alt_node_p->node_kind==PushNode){ */
- if (node->node_arguments->arg_node->node_kind==PushNode){
- DetermineStatesOfRootNodeAndDefs (case_alt_node_p->node_arguments->arg_next->arg_node,
- node->node_node_defs, demstate, local_scope);
- }
+ if (node->node_arguments->arg_node->node_kind==PushNode)
+ DetermineStatesOfRootNodeAndDefs (case_alt_node_p->node_arguments->arg_next->arg_node,&node->node_node_defs,demstate,local_scope);
else
- DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node, node->node_node_defs, demstate, local_scope);
+ DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node,&node->node_node_defs,demstate,local_scope);
} else if (node->node_kind==DefaultNode){
- DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node, node->node_node_defs, demstate, local_scope);
+ DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node,&node->node_node_defs,demstate,local_scope);
} else
error_in_function ("DetermineStatesSwitchRootNode");
}
@@ -2580,11 +2592,21 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat
StateP unique_state_p;
unique_state_p=CompAllocType (StateS);
+# if STRICT_LISTS
+ if (symbol->symb_head_strictness)
+ *unique_state_p=StrictState;
+ else
+# endif
*unique_state_p=LazyState;
unique_state_p->state_mark |= STATE_UNIQUE_MASK;
node_id_p->nid_lhs_state_p_=unique_state_p;
} else
+# if STRICT_LISTS
+ if (symbol->symb_head_strictness)
+ node_id_p->nid_lhs_state_p_=&StrictState;
+ else
+# endif
node_id_p->nid_lhs_state_p_=&LazyState;
node_ids=node_ids->nidl_next;
@@ -2596,7 +2618,11 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat
StateP unique_state_p;
unique_state_p=CompAllocType (StateS);
-
+# if STRICT_LISTS
+ if (symbol->symb_tail_strictness)
+ *unique_state_p=StrictState;
+ else
+# endif
*unique_state_p=LazyState;
unique_state_p->state_mark |= STATE_UNIQUE_MASK;
if ((node_id_state_p->state_mark & STATE_UNIQUE_TYPE_ARGUMENTS_MASK) && (node_id_state_p->state_unq_type_args & 1)){
@@ -2629,6 +2655,19 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat
}
} else
# endif
+# if STRICT_LISTS
+ if (symbol->symb_kind==cons_symb && (symbol->symb_head_strictness || symbol->symb_tail_strictness) && case_alt_node_p->node_arity==2){
+ NodeIdP node_id_p;
+
+ node_id_p=node_ids->nidl_node_id;
+ node_id_p->nid_lhs_state_p_= symbol->symb_head_strictness ? &StrictState : &LazyState;
+ node_id_p->nid_ref_count_copy=node_id_p->nid_refcount;
+
+ node_id_p=node_ids->nidl_next->nidl_node_id;
+ node_id_p->nid_lhs_state_p_= symbol->symb_tail_strictness ? &StrictState : &LazyState;
+ node_id_p->nid_ref_count_copy=node_id_p->nid_refcount;
+ } else
+# endif
set_lazy_push_node_id_states (node_ids);
}
}
@@ -2666,10 +2705,10 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat
}
#endif
-void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS demstate,int local_scope)
+void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs *rootdef,StateS demstate,int local_scope)
{
#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- DetermineStatesOfNodeAndDefs (root_node,rootdef,demstate,local_scope);
+ DetermineStatesOfNodeAndDefs (root_node,*rootdef,demstate,local_scope);
#else
ShouldDecrRefCount = True;
@@ -2684,8 +2723,8 @@ void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS de
} else
DetermineStatesRootNode (root_node,NULL,demstate,local_scope);
- if (rootdef)
- DetermineStatesOfNodeDefs (rootdef,local_scope);
+ if (*rootdef)
+ DetermineStatesOfNodeDefs (*rootdef,local_scope);
#endif
}
@@ -2796,7 +2835,7 @@ void GenerateStatesForRule (ImpRuleS *rule)
scope=1;
if (alt->alt_kind==Contractum){
- DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0);
+ DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,&alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0);
#ifdef OBSERVE_ARRAY_SELECTS_IN_PATTERN
set_states_of_array_selects_in_pattern (alt);
diff --git a/backendC/CleanCompilerSources/statesgen.h b/backendC/CleanCompilerSources/statesgen.h
index b158bd1..63c6bdd 100644
--- a/backendC/CleanCompilerSources/statesgen.h
+++ b/backendC/CleanCompilerSources/statesgen.h
@@ -18,7 +18,7 @@ extern void DetermineSharedAndAnnotatedNodes (ImpRules rules,SymbolP *im_symbols
extern void DetermineStateOfArrayElem (Symbol elemtype, States state);
extern void ExamineTypesAndLhsOfSymbols (Symbol symbs);
extern void ImportSymbols (Symbol symbols);
-extern void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS demstate,int local_scope);
+extern void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs *rootdef,StateS demstate,int local_scope);
extern unsigned next_def_number;
diff --git a/backendC/CleanCompilerSources/syntaxtr.t b/backendC/CleanCompilerSources/syntaxtr.t
index aa337bd..6259035 100644
--- a/backendC/CleanCompilerSources/syntaxtr.t
+++ b/backendC/CleanCompilerSources/syntaxtr.t
@@ -77,22 +77,6 @@ typedef enum {
erroneous_symb
} SymbKind;
-#ifdef THINK_C
-#define DSymbKind(v) ( \
- v==definition?"definition": \
- v==int_denot?"int_denot": \
- v==tuple_symb?"tuple_symb": \
- v==cons_symb?"cons_symb": \
- v==nil_symb?"nil_symb": \
- v==select_symb?"select_symb": \
- v==apply_symb?"apply_symb": \
- v==if_symb?"if_symb": \
- v==newsymbol?"newsymbol": \
- v==emptysymbol?"emptysymbol": \
- v==field_symbol_list?"field_symbol_list": \
- "")
-#endif
-
#if D
STRUCT (state,State){
@@ -184,6 +168,11 @@ STRUCT (symbol,Symbol) {
unsigned symb_infix_assoc:2; /* Assoc */
};
+#if STRICT_LISTS
+# define symb_head_strictness symb_infix_priority /* 0=lazy,1=strict,2=unboxed */
+# define symb_tail_strictness symb_infix_assoc /* 0=lazy,1=strict */
+#endif
+
#define symb_ident symb_val.val_ident
#define symb_def symb_val.val_def
#define symb_int symb_val.val_int
@@ -605,20 +594,6 @@ typedef enum {
SwitchNode, CaseNode, DefaultNode, PushNode, GuardNode, TupleSelectorsNode, FillUniqueNode /* nodes in codegen */
} NodeKind;
-#ifdef THINK_C
-#define DNodeKind(v) ( \
- v==IfNode?"IfNode": \
- v==NormalNode?"NormalNode": \
- v==SelectorNode?"SelectorNode": \
- v==NodeIdNode?"NodeIdNode": \
- v==RecordNode?"RecordNode": \
- v==UpdateNode?"UpdateNode": \
- v==IdentNode?"IdentNode": \
- v==ApplyNode?"ApplyNode": \
- v==PrefixNode?"PrefixNode" \
- :"")
-#endif
-
#define SELECTOR_U 2
#define SELECTOR_F 3
#define SELECTOR_L 4
diff --git a/backendC/CleanCompilerSources/system.h b/backendC/CleanCompilerSources/system.h
index 2d964ff..d200b95 100644
--- a/backendC/CleanCompilerSources/system.h
+++ b/backendC/CleanCompilerSources/system.h
@@ -6,7 +6,7 @@
*/
#define _SYSTEM_
-#define _WINDOWS_
+#undef _WINDOWS_
#if defined (applec) || (defined (__MWERKS__) && !defined (_WINDOWS_)) || defined (__MRC__)
# define _MAC_
diff --git a/backendC/CleanCompilerSources/tcsupport_2.c b/backendC/CleanCompilerSources/tcsupport_2.c
index 173f6e1..6c514e9 100644
--- a/backendC/CleanCompilerSources/tcsupport_2.c
+++ b/backendC/CleanCompilerSources/tcsupport_2.c
@@ -6,8 +6,9 @@
#pragma options (!macsbug_names)
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/typechecker2_2.c b/backendC/CleanCompilerSources/typechecker2_2.c
index f882816..e1a9386 100644
--- a/backendC/CleanCompilerSources/typechecker2_2.c
+++ b/backendC/CleanCompilerSources/typechecker2_2.c
@@ -4,8 +4,9 @@
Author: Sjaak Smetsers
*/
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/typechecker_2.c b/backendC/CleanCompilerSources/typechecker_2.c
index 19a27c6..4f75cbd 100644
--- a/backendC/CleanCompilerSources/typechecker_2.c
+++ b/backendC/CleanCompilerSources/typechecker_2.c
@@ -6,8 +6,9 @@
#pragma options (!macsbug_names)
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
diff --git a/backendC/CleanCompilerSources/typeconv_2.c b/backendC/CleanCompilerSources/typeconv_2.c
index 6a1c0fb..7f828f7 100644
--- a/backendC/CleanCompilerSources/typeconv_2.c
+++ b/backendC/CleanCompilerSources/typeconv_2.c
@@ -1,16 +1,14 @@
/*
-
Version 1.0 26/08/1994
-
Author: Sjaak Smetsers
-
*/
#define STATES_GENERATED
#define STORE_UNIQUE_ATTRIBUTES_IN_TYPE_NODES
+#include "compiledefines.h"
+#include "types.t"
#include "system.h"
-
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
@@ -479,7 +477,17 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p
}
case list_type:
FPutC ('[', StdListTypes);
+#if STRICT_LISTS
+ if (node->type_node_symbol->symb_head_strictness==1)
+ FPutC ('!', StdListTypes);
+ else if (node->type_node_symbol->symb_head_strictness==2)
+ FPutC ('#', StdListTypes);
+#endif
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cNotInAStrictContext, NULL);
+#if STRICT_LISTS
+ if (node->type_node_symbol->symb_tail_strictness)
+ FPutC ('!', StdListTypes);
+#endif
FPutC (']', StdListTypes);
break;
case array_type:
diff --git a/backendC/CleanCompilerSources/types.t b/backendC/CleanCompilerSources/types.t
index 74feca2..9a58e36 100644
--- a/backendC/CleanCompilerSources/types.t
+++ b/backendC/CleanCompilerSources/types.t
@@ -2,7 +2,7 @@
#if !defined (_THE__TYPES_)
#define _THE__TYPES_
-#define _WINDOWS_
+#undef _WINDOWS_
#if (defined (__MWERKS__) && !defined (_WINDOWS_)) || defined (__MRC__)
# define POWER 1
@@ -62,21 +62,25 @@ typedef struct
opt_liststricttypes:1;
} CompilerOptions;
-
-#endif
-
#ifdef _WINDOWS_
-#include <stdarg.h>
-#define FileTime FILETIME
-#ifdef __MWERKS__
+# include <stdarg.h>
+# define FileTime FILETIME
+# ifdef __MWERKS__
# include <x86_prefix.h>
-#else
+# else
# define _X86_
-#endif
-#include <windef.h>
-#include <winbase.h>
+# endif
+# include <windef.h>
+# include <winbase.h>
#else
+# ifdef KARBON
+#include <UTCUtils.h>
+typedef UTCDateTime FileTime;
+# else
typedef unsigned long FileTime;
+# endif
#endif
#define NoFile ((FileTime) 0)
+
+#endif