Commit ae28016e authored by cvs2snv's avatar cvs2snv

This commit was manufactured by cvs2svn to create tag 'clean-2-2'.

parent 070915ee
CleanCompilerLib
clear_cache
BEGetVersion
BEInit
BECloseFiles
BEFree
BEArg
BEDeclareModules
BEBindSpecialModule
BEBindSpecialFunction
BESpecialArrayFunctionSymbol
BEDictionarySelectFunSymbol
BEDictionaryUpdateFunSymbol
BEFunctionSymbol
BEConstructorSymbol
BEFieldSymbol
BETypeSymbol
BEDontCareDefinitionSymbol
BEBoolSymbol
BELiteralSymbol
BEPredefineListConstructorSymbol
BEPredefineListTypeSymbol
BEAdjustStrictListConsInstance
BEAdjustUnboxedListDeconsInstance
BEAdjustOverloadedNilFunction
BEOverloadedConsSymbol
BEOverloadedPushNode
BEPredefineConstructorSymbol
BEPredefineTypeSymbol
BEBasicSymbol
BEVarTypeNode
BETypeVarListElem
BETypeVars
BENoTypeVars
BENormalTypeNode
BEAnnotateTypeNode
BEAddForAllTypeVariables
BEAttributeTypeNode
BEAttributeKind
BENoAttributeKinds
BEAttributeKinds
BEUniVarEquation
BENoUniVarEquations
BEUniVarEquationsList
BENoTypeArgs
BETypeArgs
BETypeAlt
BENormalNode
BEMatchNode
BETupleSelectNode
BEIfNode
BEGuardNode
BESetNodeDefRefCounts
BEAddNodeIdsRefCounts
BESwitchNode
BECaseNode
BEEnterLocalScope
BELeaveLocalScope
BEPushNode
BEDefaultNode
BESelectorNode
BEUpdateNode
BENodeIdNode
BENoArgs
BEArgs
BERuleAlt
BERuleAlts
BENoRuleAlts
BEDeclareNodeId
BENodeId
BEWildCardNodeId
BENodeDef
BENoNodeDefs
BENodeDefs
BEStrictNodeId
BENoStrictNodeIds
BEStrictNodeIds
BERule
BEDeclareRuleType
BEDefineRuleType
BEAdjustArrayFunction
BENoRules
BERules
BETypes
BENoTypes
BEFlatType
BEAlgebraicType
BERecordType
BEAbsType
BEConstructors
BENoConstructors
BEConstructor
BEDeclareField
BEField
BEFields
BENoFields
BEDeclareConstructor
BETypeVar
BEDeclareType
BEDeclareFunction
BECodeAlt
BEString
BEStrings
BENoStrings
BECodeParameter
BECodeParameters
BENoCodeParameters
BENodeIdListElem
BENodeIds
BENoNodeIds
BEAbcCodeBlock
BEAnyCodeBlock
BEDeclareIclModule
BEDeclareDclModule
BEDeclarePredefinedModule
BEDefineRules
BEGenerateCode
BEExportType
BESwapTypes
BEExportConstructor
BEExportField
BEExportFunction
BEDefineImportedObjsAndLibs
BESetMainDclModuleN
BEStrictPositions
BEGetIntFromArray
BEDeclareDynamicTypeSymbol
BEDynamicTempTypeSymbol
BEInsertForeignExport
backend.dll
BEGetVersion
BEInit
BECloseFiles
BEFree
BEArg
BEDeclareModules
BEBindSpecialModule
BEBindSpecialFunction
BESpecialArrayFunctionSymbol
BEDictionarySelectFunSymbol
BEDictionaryUpdateFunSymbol
BEFunctionSymbol
BEConstructorSymbol
BEFieldSymbol
BETypeSymbol
BEDontCareDefinitionSymbol
BEBoolSymbol
BELiteralSymbol
BEPredefineListConstructorSymbol
BEPredefineListTypeSymbol
BEAdjustStrictListConsInstance
BEAdjustUnboxedListDeconsInstance
BEAdjustOverloadedNilFunction
BEOverloadedConsSymbol
BEOverloadedPushNode
BEPredefineConstructorSymbol
BEPredefineTypeSymbol
BEBasicSymbol
BEVarTypeNode
BETypeVarListElem
BETypeVars
BENoTypeVars
BENormalTypeNode
BEAnnotateTypeNode
BEAddForAllTypeVariables
BEAttributeTypeNode
BEAttributeKind
BENoAttributeKinds
BEAttributeKinds
BEUniVarEquation
BENoUniVarEquations
BEUniVarEquationsList
BENoTypeArgs
BETypeArgs
BETypeAlt
BENormalNode
BEMatchNode
BETupleSelectNode
BEIfNode
BEGuardNode
BESetNodeDefRefCounts
BEAddNodeIdsRefCounts
BESwitchNode
BECaseNode
BEEnterLocalScope
BELeaveLocalScope
BEPushNode
BEDefaultNode
BESelectorNode
BEUpdateNode
BENodeIdNode
BENoArgs
BEArgs
BERuleAlt
BERuleAlts
BENoRuleAlts
BEDeclareNodeId
BENodeId
BEWildCardNodeId
BENodeDef
BENoNodeDefs
BENodeDefs
BEStrictNodeId
BENoStrictNodeIds
BEStrictNodeIds
BERule
BEDeclareRuleType
BEDefineRuleType
BEAdjustArrayFunction
BENoRules
BERules
BETypes
BENoTypes
BEFlatType
BEAlgebraicType
BERecordType
BEAbsType
BEConstructors
BENoConstructors
BEConstructor
BEDeclareField
BEField
BEFields
BENoFields
BEDeclareConstructor
BETypeVar
BEDeclareType
BEDeclareFunction
BECodeAlt
BEString
BEStrings
BENoStrings
BECodeParameter
BECodeParameters
BENoCodeParameters
BENodeIdListElem
BENodeIds
BENoNodeIds
BEAbcCodeBlock
BEAnyCodeBlock
BEDeclareIclModule
BEDeclareDclModule
BEDeclarePredefinedModule
BEDefineRules
BEGenerateCode
BEExportType
BEExportConstructor
BEExportField
BEExportFunction
BEDefineImportedObjsAndLibs
BESetMainDclModuleN
BEStrictPositions
BEGetIntFromArray
BEDeclareDynamicTypeSymbol
BEDynamicTempTypeSymbol
BEInsertForeignExport
\ No newline at end of file
......@@ -1235,7 +1235,7 @@ convertRule aliasDummyId (index, {fun_type=Yes type, fun_body=body, fun_pos, fun
positionToLineNumber (LinePos _ lineNumber)
= lineNumber
positionToLineNumber _
= 0
= -1
beautifyAttributes :: SymbolType -> BEMonad SymbolType
beautifyAttributes st
......
......@@ -122,7 +122,6 @@ BEDefineImportedObjsAndLibs
BESetMainDclModuleN
BEStrictPositions
BECopyInts
BEGetIntFromArray
BEDeclareDynamicTypeSymbol
BEDynamicTempTypeSymbol
BEInsertForeignExport
\ No newline at end of file
# This is for linux 64
CC = gcc
CFLAGS = -D_SUN_ -DGNU_C -DG_A64 -O -fomit-frame-pointer
AR = ar
RANLIB = ranlib
OBJECTS = \
backend.o backendsupport.o buildtree.o checker_2.o checksupport.o \
cocl.o codegen1.o codegen2.o codegen3.o codegen.o comparser_2.o \
compiler.o comsupport.o dbprint.o instructions.o optimisations.o \
pattern_match_2.o result_state_database.o sa.o scanner_2.o \
set_scope_numbers.o settings.o unix_io.o statesgen.o tcsupport_2.o \
typeconv_2.o version.o
backend.a: $(OBJECTS)
$(AR) cur backend.a $(OBJECTS)
$(RANLIB) backend.a
......@@ -380,10 +380,6 @@ BESetMainDclModuleN (int main_dcl_module_n_parameter)
static DefMod im_def_module;
static void DeclareFunctionC (char *name, int arity, int functionIndex, unsigned int ancestor);
static BESymbolP CreateDictionarySelectFunSymbol (void);
static BESymbolP CreateDictionaryUpdateFunSymbol (void);
void
BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctions, int nTypes, int nConstructors, int nFields)
{
......@@ -432,6 +428,7 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio
for (i = 0; i < ArraySize (gLocallyGeneratedFunctions); i++)
{
static void DeclareFunctionC (char *name, int arity, int functionIndex, unsigned int ancestor);
BELocallyGeneratedFunctionP locallyGeneratedFunction;
locallyGeneratedFunction = &gLocallyGeneratedFunctions [i];
......@@ -441,6 +438,9 @@ BEDeclareIclModule (CleanString name, CleanString modificationTime, int nFunctio
/* +++ hack */
{
static BESymbolP CreateDictionarySelectFunSymbol (void);
static BESymbolP CreateDictionaryUpdateFunSymbol (void);
gBEState.be_dictionarySelectFunSymbol = CreateDictionarySelectFunSymbol ();
gBEState.be_dictionaryUpdateFunSymbol = CreateDictionaryUpdateFunSymbol ();
}
......
......@@ -21,8 +21,6 @@
#define STRICT_LISTS 1
#define BOXED_RECORDS 1
#define NEW_APPLY
#define KARBON
#define NEW_SELECTOR_DESCRIPTORS
......@@ -1164,6 +1164,11 @@ void FWriteFileTime (FileTime file_time,File f)
}
#endif
Bool GetOptionsFromIclFile (char *fname, CompilerOptions *opts)
{
return False;
} /* GetOptionsFromIclFile */
void DoError (char *fmt, ...)
{ va_list args;
......
This diff is collapsed.
This diff is collapsed.
#define Clean(a)
typedef struct clean_string *CleanString;
/* a string in Clean is:
struct clean_string {
int clean_string_length;
char clean_string_characters[clean_string_length];
};
The string does not end with a '\0' !
*/
/* CleanStringLength(clean_string) returns length of the clean_string in characters */
#define CleanStringLength(clean_string) (*(unsigned int *)(clean_string))
/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */
#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned int *)(clean_string)))
/* CleanStringSizeInts(string_length) return size of CleanString in integers */
#define CleanStringSizeInts(string_length) (1+(((unsigned int)(string_length)+3)>>2))
/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,
before using the clean_string variable, cast to CleanString, except for the macros above */
#define CleanStringVariable(clean_string,string_length) unsigned int clean_string[CleanStringSizeInts(string_length)]
/* CleanStringSizeBytes(string_length) return size of CleanString in bytes */
#define CleanStringSizeBytes(string_length) (4+(((unsigned int)(string_length)+3) & -4))
// this is for Windows
definition module CoclSystemDependent
//1.3
from StdString import String
from StdFile import Files
//3.1
/*2.0
from StdFile import ::Files
0.2*/
// RWS split
// from deltaIOSystem import DeviceSystem
// from deltaEventIO import InitialIO, IOState
PathSeparator
:== ','
DirectorySeparator
:== ':'
SystemDependentDevices :: [a]
SystemDependentInitialIO :: [a]
ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
set_compiler_id :: Int -> Int
compiler_loop :: ([{#Char}] *st -> *(Bool, *st)) *st -> (!Bool, !*st)
// this is for Unix
implementation module CoclSystemDependent
import StdEnv
import StdDebug
import ArgEnv
import ipc
from filesystem import ensureDirectoryExists
import code from "cDirectory_c.o"
import code from "ipc_c.o"
PathSeparator
:== ','
DirectorySeparator
:== ':'
SystemDependentDevices :: [a]
SystemDependentDevices
= []
SystemDependentInitialIO :: [a]
SystemDependentInitialIO
= []
set_compiler_id :: Int -> Int
set_compiler_id compiler_id = compiler_id
ensureCleanSystemFilesExists :: !String !*Files -> (!Bool, !*Files)
// returned bool: now there is such a subfolder
ensureCleanSystemFilesExists path env
= ensureDirectoryExists path env
compiler_loop :: ([{#Char}] *st -> *(Bool, *st)) *st -> (!Bool, !*st)
compiler_loop compile compile_state
| length commandArgs==3 && commandArgs!!0=="--pipe"
# commands_name= (commandArgs!!1);
# results_name= (commandArgs!!2);
= (True,compile_loop compile commands_name results_name compile_state)
# (r,compile_state)=compile commandArgs compile_state
= (r,compile_state)
where
commandArgs
= tl [arg \\ arg <-: getCommandLine]
// ... Unix
string_to_args string
= string_to_args 0;
where
l=size string;
string_to_args i
# end_spaces_i=skip_spaces i;
| end_spaces_i==l
= []
| string.[end_spaces_i]=='"'
# next_double_quote_i=skip_to_double_quote (end_spaces_i+1)
| next_double_quote_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i+1,next_double_quote_i-1);
= [arg : string_to_args (next_double_quote_i+1)];
# space_i=skip_to_space (end_spaces_i+1)
| space_i>=l
= [string % (end_spaces_i,l-1)]
# arg=string % (end_spaces_i,space_i-1);
= [arg : string_to_args (space_i+1)];
skip_spaces i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= skip_spaces (i+1);
= i;
skip_to_space i
| i>=l
= l;
# c=string.[i];
| c==' ' || c=='\t'
= i;
= skip_to_space (i+1);
skip_to_double_quote i
| i>=l
= l;
# c=string.[i];
| c=='"'
= i;
= skip_to_double_quote (i+1);
compile_loop :: ([{#Char}] *st -> *(Bool, *st)) {#Char} {#Char} *st -> *st
compile_loop compile commands results compile_state
# r=open_pipes commands results;
| r<>0
= abort ("compile_loop\n");
= compile_files compile compile_state
compile_files :: ([{#Char}] *st -> *(Bool, *st)) *st -> *st
compile_files compile compile_state
# n = get_command_length;
| n==(-1)
= abort "compile_files 1";
# string=createArray n '\0';
# r=get_command string;
| r<>0
= abort ("compile_files 2 ");
# args=string_to_args (string % (0,size string-2))
= case args of
["cocl":cocl_args]
# (ok,compile_state)=compile cocl_args compile_state
# result=if ok 0(-1);
# r=send_result result
| r<>0
-> abort "compile_files 3";
-> compile_files compile compile_state
["quit"]
-> /* trace_n "quiting" */ compile_state;
_
-> abort "compile_files 4"
CC=gcc
CFLAGS=-pedantic -Wall -W -O
CPPFLAGS=
all: cDirectory.o ipc.o set_return_code_c.o
This diff is collapsed.
/*
Unix clm/cocl interface
Ronny Wichers Schreur
*/
# include <stdio.h>
# include <stdlib.h>
# include <stdarg.h>
# include <strings.h>
/*
Clean string
============
*/
typedef struct clean_string {int length; char chars [1]; } *CleanString;
# define Clean(ignore)
# include "ipc.h"
static void
log (char *format, ...)
{
#ifdef DEBUG
va_list ap;
va_start (ap, format);
(void) fputs(" cocl: ", stderr);
(void) vfprintf(stderr, format, ap);
va_end(ap);
#else /* ifndef DEBUG */
#endif
}
static char *
ConvertCleanString (CleanString string)
{
int length;
char *copy;
length = string->length;
copy = malloc (length+1);
strncpy (copy, string->chars, length);
copy [length] = '\0';
return (copy);
} /* ConvertCleanString */
static FILE *commands, *results;
# define COMMAND_BUFFER_SIZE 1024
static char command_buffer[COMMAND_BUFFER_SIZE];
static void
crash (void)
{
int *p;
p = NULL;
log ("crashing\n");
*p = 0;
} /* crash */
static void
hang (void)
{
log ("hanging\n");
for (;;)
;
} /* hang */
int open_pipes (CleanString commands_clean, CleanString results_clean)
{
char *commands_name, *results_name;
commands_name = ConvertCleanString (commands_clean);
results_name = ConvertCleanString (results_clean);
if ((commands = fopen(commands_name, "r")) == NULL)
{
log("commands = %s\n",commands_name);
perror("fopen commands");
return -1;
}
if ((results = fopen(results_name, "w")) == NULL)
{
log("results = %s\n",results_name);
perror("fopen results");
return -1;
}
return 0;
}
int get_command_length (void)
{
log ("reading command\n");
if (fgets (command_buffer, COMMAND_BUFFER_SIZE, commands) == NULL)
return -1;
else
{
log ("command = %s", command_buffer);
return (strlen (command_buffer));
}
}
int get_command (CleanString cleanString)
{
log ("%s\n", command_buffer);
strncpy (cleanString->chars, command_buffer, cleanString->length);
return (0);
}
int send_result (int result)
{
int r;
if (fprintf (results, "%d\n", result) > 0)
r=0;
else
r=-1;
fflush (results);
return r;
}
definition module ipc;
//1.3
from StdString import String;
//3.1
open_pipes :: !String !String -> Int;
// int open_pipes (CleanString commands_name,CleanString results_name);
get_command_length :: Int;
// int get_command_length ();
get_command :: !String -> Int;
// int get_command (CleanString cleanString);
send_result :: !Int -> Int;
// int send_result (int result);
int open_pipes (CleanString commands_name, CleanString results_name);
Clean (open_pipes :: String String -> Int)
int get_command_length (void);
Clean (get_command_length :: Int)
int get_command (CleanString cleanString);
Clean (get_command :: String -> Int)
int send_result (int result);
Clean (send_result :: Int -> Int)
implementation module ipc;
//1.3
from StdString import String;
//3.1
open_pipes :: !String !String -> Int;
open_pipes a0 a1 = code {
ccall open_pipes "SS:I"
}
// int open_pipes (CleanString commands_name,CleanString results_name);
get_command_length :: Int;
get_command_length = code {
ccall get_command_length ":I"
}
// int get_command_length ();
get_command :: !String -> Int;
get_command a0 = code {
ccall get_command "S:I"