/*
module owner: Ronny Wichers Schreur
*/
implementation module coclmain
import StdEnv
import ArgEnv
import set_return_code
import compile
coclMain :: ![{#Char}] !*World -> *World
// currentVersion latestDefVersion latestImpVersion testArgs world
coclMain testArgs world
# (commandArgs, world)
= getCommandArgs (tl [arg \\ arg <-: getCommandLine]) testArgs world
# (symbol_table,world)
= init_identifiers newHeap world
# (success, world)
= accFiles (compiler commandArgs symbol_table) world
= set_return_code (if success 0(-1)) world
where
getCommandArgs :: [{#Char}] [{#Char}] *World -> ([{#Char}], *World)
getCommandArgs [] testArgs world
= getArgs testArgs world
getCommandArgs realArgs _ world
= getArgs realArgs world
getArgs :: [{#Char}] *World -> ([{#Char}], *World)
getArgs ["--dump-args" : commandArgs] world
# (opened, file, world)
= fopen CoclArgsFile FWriteText world
| not opened
= abort ("--dump-args " +++ CoclArgsFile +++ " could not be opened\n")
# file
= foldSt (\s -> fwritec '\n' o fwrites s) commandArgs file
# (closed, world)
= fclose file world
| not closed
= abort ("--dump-args " +++ CoclArgsFile +++ " could not be closed\n")
= (commandArgs, world)
getArgs ["--restore-args"] world
# (opened, file, world)
= fopen CoclArgsFile FReadText world
| not opened
= abort ("--restore-args " +++ CoclArgsFile +++ " could not be opened\n")
# (commandArgs, file)
= readArgs [] file
# (closed, world)
= fclose file world
| not closed
= abort ("--restore-args " +++ CoclArgsFile +++ " could not be closed\n")
= (commandArgs, world)
where
readArgs :: [{#Char}] *File -> ([{#Char}], *File)
readArgs reversedArgs file
# (arg, file)
= freadline file
| arg == ""
= (reverse reversedArgs, file)
// otherwise
= readArgs [chopNewline arg : reversedArgs] file
chopNewline :: {#Char} -> {#Char}
chopNewline s
| s.[n-1] == '\n'
= s % (0, n-2)
// otherwise
= s
where
n
= size s
getArgs commandArgs world
= (commandArgs, world)
CoclArgsFile :== "coclargs.txt"
import thread_message;
import code from "thread_message.obj";
compiler :: ![{#Char}] *SymbolTable *Files -> *(!Bool,!*Files);
compiler commandArgs symbol_table files
# dcl_cache = empty_cache symbol_table
| length commandArgs==2 && commandArgs!!0=="-ide"
# wm_number=get_message_number;
# thread_id=hex_to_int (commandArgs!!1);
= (True,compile_files dcl_cache thread_id wm_number files)
# (r,cache,files)=compile commandArgs dcl_cache files
= (r,files)
hex_to_int :: {#Char} -> Int
hex_to_int s
= hex_to_int 0 0;
where
l=size s;
hex_to_int i n
| i==l
= n;
# c=s.[i];
# i=i+1;
# n=n<<4;
| c<='9'
= hex_to_int i (n bitor (toInt c-toInt '0'));
= hex_to_int i (n bitor (toInt c-(toInt 'A'-10)));
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_files cache thread_id wm_number files
# (r,a,s) =get_integers_from_message wm_number;
| r==0
= abort "compile_files 1";
# string=createArray a '\0';
# r=get_string_from_file_map_and_delete_map s string;
| r==0
= abort ("compile_files 2 ");
# args=string_to_args (string % (0,size string-2))
= case args of
["cocl":cocl_args]
# (ok,cache,files)=compile cocl_args cache files
# result=if ok 0(-1);
# r=send_integers_to_thread thread_id wm_number 0 result;
| r==0
-> abort "compile_files 3";
-> compile_files cache thread_id wm_number files
["exit"]
-> files;
_
-> abort "compile_files 4"