Hat on Windows, patches

Index: src/hatlib/hat-c.c
===================================================================
RCS file: /home/cvs/root/hat/src/hatlib/hat-c.c,v
retrieving revision 1.41
diff -u -r1.41 hat-c.c
--- src/hatlib/hat-c.c	8 Jul 2005 14:43:39 -0000	1.41
+++ src/hatlib/hat-c.c	27 Jun 2006 10:05:22 -0000
@@ -8,7 +8,7 @@
 #include <stdlib.h>
 #include <string.h>
 #include <signal.h>
-#include <netinet/in.h>		/* for ntohl() macro */
+#include "ntohl.h"
 #include "hat-c.h"
 
 
@@ -104,7 +104,7 @@
 
     strcpy(filename,progname);
     strcat(filename,".hat");		/* the .hat file holds the archive */
-    HatFile = fopen(filename,"w");	/* of redex trails */
+    HatFile = fopen(filename,"wb");	/* of redex trails */
     p = ftell(HatFile);                 /* should be 0 */
     fprintf(HatFile,"Hat%s",FILEVERSION);	/* initialise file */
     fputc(0,HatFile);
@@ -116,14 +116,16 @@
 
     strcpy(filename,progname);		/* the .output file is a copy of */
     strcat(filename,".hat.output");	/* stdout */
-    HatOutput = fopen(filename,"w");
+    HatOutput = fopen(filename,"wb");
     strcpy(filename,progname);		/* the .bridge file links the output */
     strcat(filename,".hat.bridge");	/* to the archived trails */
-    HatBridge = fopen(filename,"w");
+    HatBridge = fopen(filename,"wb");
 
     controlC = False;
     /* SIGQUIT here before, why? */
+#if defined(SIGQUIT)
     signal(SIGQUIT, hat_Interrupt);    /* install handler for abortion? */
+#endif
     signal(SIGABRT, hat_Interrupt);    /* install handler for abortion? */
     signal(SIGFPE, hat_ArithmeticError);
     signal(SIGINT, hat_Interrupt); /* install handler for Control-C */
Index: src/hattools/HighlightStyle.hs
===================================================================
RCS file: /home/cvs/root/hat/src/hattools/HighlightStyle.hs,v
retrieving revision 1.7
diff -u -r1.7 HighlightStyle.hs
--- src/hattools/HighlightStyle.hs	12 Oct 2004 17:22:09 -0000	1.7
+++ src/hattools/HighlightStyle.hs	27 Jun 2006 13:55:44 -0000
@@ -19,6 +19,11 @@
 import List (intersperse,isPrefixOf)
 import Run  (runAndReadStdout)
 import Char (isDigit)
+import System.Info (os)
+
+
+hasEscapes :: Bool
+hasEscapes = os /= "windows" && os /= "mingw32"
 
 
 -- Basic screen control codes:
@@ -81,11 +86,13 @@
 highlight :: [Highlight] -> String -> String
 highlight attrs s = highlightOn attrs ++ s ++ highlightOff
 
+highlightOn _  | not hasEscapes = ""
 highlightOn []     = highlightOn [Normal]
 highlightOn attrs  = "\ESC["
                      ++ concat (intersperse ";" (map (show.fromEnum) attrs))
                      ++"m"
-highlightOff = "\ESC[0m"
+
+highlightOff = if hasEscapes then "\ESC[0m" else ""
 
 
 -- An infinite supply of colours.
@@ -106,14 +113,16 @@
 
 -- Find width and height of terminal screen
 getTerminalSize :: IO (Int,Int)
-getTerminalSize = do
-    str <- runAndReadStdout "resize -u"
-    let ls = lines str
-    return (find "COLUMNS" ls, find "LINES" ls)
+getTerminalSize =
+    if hasEscapes then do
+        str <- runAndReadStdout "resize -u"
+        let ls = lines str
+        return (find "COLUMNS" ls, find "LINES" ls)
+    else
+        return (80, 30)
   where
     find x  []    = 0
     find x (s:ss) | x `isPrefixOf` s = read (filter isDigit s)
                   | otherwise        = find x ss
     s `containedIn` [] = False
     s `containedIn` x@(_:xs) = s `isPrefixOf` x  || s `containedIn` xs
-
Index: src/hattools/artutils.c
===================================================================
RCS file: /home/cvs/root/hat/src/hattools/artutils.c,v
retrieving revision 1.31
diff -u -r1.31 artutils.c
--- src/hattools/artutils.c	2 May 2006 16:37:24 -0000	1.31
+++ src/hattools/artutils.c	27 Jun 2006 12:43:28 -0000
@@ -9,6 +9,7 @@
 #include "art.h"
 #include "artutils.h"
 #include "pathutils.h"
+#include "ntohl.h"
 
 #define DEBUG 0
 
@@ -64,7 +65,7 @@
   FILE* file;
   strcpy(filename,base);
   strcat(filename,ext);
-  if (file = fopen(filename,"r")) {
+  if (file = fopen(filename,"rb")) {
     return file;
   } else {
     fprintf(stderr,"%s: cannot open %s\n",progname,filename);
Index: src/hattools/hat-check.c
===================================================================
RCS file: /home/cvs/root/hat/src/hattools/hat-check.c,v
retrieving revision 1.30
diff -u -r1.30 hat-check.c
--- src/hattools/hat-check.c	9 May 2006 10:28:29 -0000	1.30
+++ src/hattools/hat-check.c	27 Jun 2006 11:05:29 -0000
@@ -31,6 +31,7 @@
 #include <signal.h>
 
 #include "art.h"
+#include "ntohl.h"
 
 /* out-of-range values must be <= 31 && not overlap Exps and Atoms */
 #define ANYEXP	22
@@ -173,7 +174,7 @@
   if (!strends(".hat", filename)) strcat(filename, ".hat");
   stat(filename, &statbuf);
   filesize = statbuf.st_size;
-  f = fopen(filename, (rmode ? "r+" : "r"));
+  f = fopen(filename, (rmode ? "r+b" : "rb"));
   if (f==(FILE*)0) {
     fprintf(stderr, "cannot open trace file %s\n",filename);
     exit(1);
@@ -213,7 +214,9 @@
   }
   if (rmode) {
     signal(SIGINT, restoretags);
+#ifdef SIGQUIT
     signal(SIGQUIT, restoretags);
+#endif
     markfromheader(buffer);
     strcat(filename, ".bridge");
     markfromoutput(filename,buffer);
@@ -908,7 +911,7 @@
 void
 markfromoutput (char *bridgefile, unsigned long *buf)
 {
-  FILE* bridge = fopen(bridgefile, "r");
+  FILE* bridge = fopen(bridgefile, "rb");
   if (bridge==(FILE*)0) return;
   for (;;) {
     int n = fread(buf,sizeof(unsigned long),1,bridge);
Index: src/hattools/observeutils.c
===================================================================
RCS file: /home/cvs/root/hat/src/hattools/observeutils.c,v
retrieving revision 1.47
diff -u -r1.47 observeutils.c
--- src/hattools/observeutils.c	24 May 2006 13:14:22 -0000	1.47
+++ src/hattools/observeutils.c	27 Jun 2006 14:14:21 -0000
@@ -9,6 +9,7 @@
 #include "art.h"
 #include "artutils.h"
 #include "observeutils.h"
+#include "ntohl.h"
 
 #define DEBUG 0

#if defined(WIN32)

/* Windows does not have ntohl, so define it here */
#define htonl(x) ntohl(x)
int ntohl(int x);

#else

/* Unix does, so just use it */
#include <netinet/in.h>		/* for ntohl() macro */

#endif /* WIN32 */

int ntohl(int x){
       int ret;
       unsigned char* pr = (unsigned char*) &ret;
       unsigned char* px = (unsigned char*) &x;

       pr[0] =px[3]; pr[1] = px[2]; pr[2] = px[1]; pr[3] = px[0];
       return ret;
}

module Main where

import System
import List
import Char
import System.Directory
import Monad


main = do x <- getArgs
          Just hatPath <- findExecutable "hat-make"
          let hatFolder = dropFilename hatPath
          let y = case x of
                    [x] -> x
                    _ -> error "Please give the name of the file to hat-make on the command line"
          system $ "ghc -M " ++ y
          mak <- readFile "Makefile"
          let (files,depends) = parseMakefile mak
          translate hatFolder files depends
          compileAll hatFolder y

dropFilename x = reverse $ dropWhile (\x -> not $ x `elem` "\\/") $ reverse x


parseMakefile :: String -> ([String], [(String, String)])
parseMakefile src =
        (
            nub $ concat [[a,b] | (a,b) <- res]
            ,
            nub $ [(a,b) | (a,b) <- res, a /= b]
        )
    where
        res = concatMap f $ lines src
    
        f :: String -> [(String, String)]
        f ('#':_) = []
        f x = [(filename a, filename b)]
            where (a,_:b) = break (== ':') x

filename x = reverse $ tail $ dropWhile (/= '.') $ reverse $ filter (not . isSpace) x


translate :: String -> [String] -> [(String, String)] -> IO ()
translate hatFolder files deps =
        if null files then return ()
        else if null yes then error "Circular dependancies"
        else mapM_ (translateFile hatFolder) yes >> translate hatFolder no newdeps
    where
        newdeps = [(a,b) | (a,b) <- deps, not (b `elem` yes)]
        (yes,no) = partition isDoable files
        isDoable x = not $ any ((==) x . fst) deps


translateFile :: String -> FilePath -> IO ()
translateFile hatFolder file = do
    fil <- pickFile file
    putStrLn $ "Converting with Hat, " ++ fil
    systemTry $ hatFolder ++ "/hat-trans.exe " ++ fil ++ " -I" ++ hatFolder ++ "/hx"


pickFile :: FilePath -> IO FilePath
pickFile x = do hs  <- doesFileExist (x++".hs")
                lhs <- doesFileExist (x++".lhs")
                return $ if lhs then x ++ ".lhs" else x ++ ".hs"

compileAll :: String -> String -> IO ()
compileAll hatFolder file = do
    putStrLn "Compiling with GHC..."
    systemTry $ "ghc --make Hat/" ++ file ++ " -ffi -fglasgow-exts -cpp -i.;" ++
                    hatFolder ++ "/hs " ++
                    hatFolder ++ "/c/hat-c.o"

systemTry :: String -> IO ()
systemTry x = do y <- system x
                 when (y /= ExitSuccess) exitFailure