From 8539dabd55fa45b98d3b7df38ae9962e584b89fa Mon Sep 17 00:00:00 2001 From: martinw Date: Fri, 29 Jun 2001 11:55:58 +0000 Subject: new application that removes all preprocessor directives (that eventually have been added by the coclPort tool) git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@510 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d --- portToNewSyntax/rmPreprop.icl | 190 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 190 insertions(+) create mode 100644 portToNewSyntax/rmPreprop.icl diff --git a/portToNewSyntax/rmPreprop.icl b/portToNewSyntax/rmPreprop.icl new file mode 100644 index 0000000..1be1eef --- /dev/null +++ b/portToNewSyntax/rmPreprop.icl @@ -0,0 +1,190 @@ +module rmPreprop + +import StdEnv, Directory, StdLib, StdDebug + +one_three =: "1.3" +two_zero =: "2.0" + +intro_text current_dir_string = + [ "This program can be used to remove the preprocessor statements\n" + , "from your Clean sources. Consult the documentation about\n" + , "differences between Clean 1.3 and Clean 2.0 to get more information\n" + , "about the Clean preprocessor.\n" + , "\n" + , "This program will perform it's task on all .icl and .dcl files\n" + , "in the current folder only. To process several folders you can move\n" + , "this executable.\n" + , "\n" + , "This program will not alter the files in the current folder, but will\n" + , "rather create two subfolders with the resulting 1.3 and 2.0 sources.\n" + , "The subfolders are called \"", one_three, "\" and \"", two_zero, "\".\n" + , "\n" + , "Current directory:", current_dir_string, "\n" + , "\n" + , "Should I start? (y/n):" + ] + + +appStdio f w + #! (io, w) + = stdio w + (x, io, w) + = f io w + (_, w) + = fclose io w + = (x, w) + +appStdio1 f w + #! (_, w) + = appStdio (\io w -> let io2 = f io in (0, io2, w)) w + = w + +intro io w + #! (current_dir_path, w) + = getCurrentDirectory w + (current_dir_string, w) + = pathToPD_String current_dir_path w + io + = foldlSt fwrites (intro_text current_dir_string) io + (answer, io) + = freadline io + io + = fwrites "\n" io + = (size answer>0 && (answer.[0]=='y' || answer.[0]=='Y'), io, w) + +perform w + #! (filenames, w) + = getFilenames w + | isEmpty filenames + = (False, w) + #! (ok, w) + = makeSubfolders w + | not ok + = (ok, w) + = loop filenames w + where + getFilenames w + #! ((err, dir_entries), w) + = getDirectoryContents (RelativePath []) w + | err<>NoDirError + #! w + = appStdio1 (fwrites "Error:can't retrieve contents of current directory\n\n") w + = ([], w) + = ([fileName \\ {fileName}<-dir_entries | endsWith fileName ".dcl" || endsWith fileName ".icl"], w) + endsWith s suffix + #! size_s = size s + = s % (size_s-size suffix, size_s-1)==suffix + makeSubfolders w + #! (ok1, w) + = makeSubfolder one_three w + (ok2, w) + = makeSubfolder two_zero w + = (ok1 && ok2, w) + makeSubfolder name w + #! (err, w) + = createDirectory (RelativePath [PathDown name]) w + = (err==NoDirError || err==AlreadyExists, w) + loop [] w + = (True, w) + loop [filename:filenames] w + #! (ok, w) + = performOnFile filename w + | not ok + = (ok, w) + = loop filenames w + performOnFile filename w + #! (ok, input, w) + = fopen filename FReadData w + | not ok + = (ok, w) + #! (ok1, out13, w) + = openOutputfile one_three filename w + (ok2, out20, w) + = openOutputfile two_zero filename w + | not ok1 || not ok2 + = (False, w) + #! (input, out13, out20) + = fileLoop input out13 out20 + (_, w) + = fclose input w + (_, w) + = fclose out13 w + (_, w) + = fclose out20 w + = (True, w) + where + fileLoop :: !*File !*File !*File -> (!*File, !*File, !*File) + fileLoop input out13 out20 + #! (isEof, input) + = fend input + | isEof + = (input, out13, out20) + #! (line, input) + = freadline input + | beginsWith "//1.3" line + = oneThree input out13 out20 + | beginsWith "/*2.0" line + = twoZero input out13 out20 + #! out13 + = fwrites line out13 + out20 + = fwrites line out20 + = fileLoop input out13 out20 + oneThree :: !*File !*File !*File -> (!*File, !*File, !*File) + oneThree input out13 out20 + #! (isEof, input) + = fend input + | isEof + = (input, out13, out20) + #! (line, input) + = freadline input + | beginsWith "//3.1" line + = fileLoop input out13 out20 + #! out13 + = fwrites line out13 + = oneThree input out13 out20 + twoZero :: !*File !*File !*File -> (!*File, !*File, !*File) + twoZero input out13 out20 + #! (isEof, input) + = fend input + | isEof + = (input, out13, out20) + #! (line, input) + = freadline input + | beginsWith "0.2*/" line + = fileLoop input out13 out20 + #! out20 + = fwrites line out20 + = twoZero input out13 out20 + beginsWith praefix line + = line % (0, size praefix-1) == praefix + openOutputfile subdir_name filename w + #! (pd_path, w) + = pathToPD_String (RelativePath [PathDown subdir_name, PathDown filename]) w + (ok, file, w) + = fopen pd_path FWriteData w + | not ok + #! w + = appStdio1 (fwrites ("Error:can't open "+++pd_path+++".\n\n")) w + = (ok, file, w) + = (ok, file, w) + +byebye ok io + #! io + = fwrites (if ok "Work done.\n\n" "Couldn't finish work.\n\n") io + io + = fwrites "Push enter to quit" io + (_, io) + = freadline io + = io + +Start w + #! (do_it, w) + = appStdio intro w + | not do_it + = w + #! (ok, w) + = perform w + w + = appStdio1 (byebye ok) w + = w \ No newline at end of file -- cgit v1.2.3