More Haskell install script stuff

Author: augustss

Makefile

@@ -80,6 +80,11 @@ bin/mcabal:	$(RTS)/*.c $(RTS)/*.h $(RTS)/*/*.h #generated/mcabal.c
 	@mkdir -p bin
 	$(CCEVAL) generated/mcabal.c $(CCLIBS) -o bin/mcabal
 
+# Compile cpphs from distribution, with C compiler
+bin/install:	$(RTS)/*.c $(RTS)/*.h $(RTS)/*/*.h #generated/install.c
+	@mkdir -p bin
+	$(CCEVAL) generated/install.c $(CCLIBS) -o bin/install
+
 # Compile combinator evaluator
 bin/mhseval:	$(RTS)/*.c $(RTS)/*.h $(RTS)/*/*.h
 	@mkdir -p bin
@@ -128,6 +133,10 @@ generated/mhs.c:	bin/mhs src/*/*.hs
 	@mkdir -p generated
 	bin/mhs -z $(MHSINC) $(MAINMODULE) -ogenerated/mhs.c
 
+generated/install.c:	bin/mhs Tools/Install.hs
+	@mkdir -p generated
+	bin/mhs -z $(MHSINC) -iTools Install -ogenerated/install.c
+
 ghcgen:	bin/gmhs src/*/*.hs lib/*.hs lib/*/*.hs lib/*/*/*.hs
 	bin/gmhs $(MHSINC) $(MAINMODULE) -ogenerated/mhs.c
 
@@ -177,7 +186,7 @@ bootstrapcpphs: bin/mhs cpphssrc/malcolm-wallace-universe/.git
 	MHSCPPHS=$(USECPPHS) bin/mhs -z -XCPP '-DMIN_VERSION_base(x,y,z)=((x)<4||(x)==4&&(y)<19||(x)==4&&(y)==19&&(z)<=1)' -icpphscompat -icpphssrc/malcolm-wallace-universe/polyparse-1.12/src -icpphssrc/malcolm-wallace-universe/cpphs-1.20.9 cpphssrc/malcolm-wallace-universe/cpphs-1.20.9/cpphs.hs -ogenerated/cpphs.c
 
 mhs.conf: mhs.conf.in
-	sed -e "s,GMPFLAGS,$(MHSGMPCCFLAGS)," -e "s,GMPLIBS,$(MHSGMPCCLIBS)," mhs.conf.in > mhs.conf
+	sed -e "s,%GMPFLAGS,$(MHSGMPCCFLAGS)," -e "s,%GMPLIBS,$(MHSGMPCCLIBS)," mhs.conf.in > mhs.conf
 
 # Run test examples with ghc-compiled compiler
 runtest:	bin/mhseval bin/gmhs tests/*.hs
@@ -326,6 +335,7 @@ $(MCABALBIN)/mcabal: bin/mcabal
 preparedist:	newmhsz bootstrapcpphs
 	rm -f generated/mcabal.c generated/mhseval.js generated/base.pkg
 	$(MAKE) generated/mcabal.c
+	$(MAKE) generated/install.c
 	$(MAKE) generated/mhseval.js
 	$(MAKE) generated/base.pkg
 

Tools/Install.hs

@@ -1,5 +1,6 @@
 module Install where
 import Control.Monad
+import Data.Char
 import Data.List
 import Data.Maybe
 import Data.Word
@@ -30,15 +31,15 @@ main = do
       inst = fromMaybe (home </> ".mcabal") (instDirM flags)
       flags' = flags { exeSuffix = exe, cconf = cc, instDir = inst, conf = confText }
 
-  install flags
+  install flags'
 
 install :: Flags -> IO ()
 install flags = do
   instBin flags
   vers <- init <$> mhsOut flags ["--numeric-version"]
   let flags' = flags { version = vers }
   mkMachdep flags'
-  mkConf flags
+  mkConf flags'
   copyRTS flags'
   copyBase flags'
   checkPath flags'
@@ -88,7 +89,7 @@ checkPath flags = do
   let paths = splitOn pathSep path
       pathSep | target flags == "windows" = ";"
               | otherwise = ":"
-      bin = instDir flags </> bin
+      bin = instDir flags </> "bin"
   when (bin `notElem` paths) $
     putStrLn $ "Please add " ++ bin ++ " to your PATH"
 
@@ -107,7 +108,7 @@ mhsOut flags args = do
   let exe = "bin" </> "mhs" <.> exeSuffix flags
   msg flags $ unwords (exe:args)
   if dryRun flags then
-    return "MHSOUT"
+    return "MHSOUT\n"
    else
     readProcess exe args ""
 
@@ -167,10 +168,12 @@ copy flags src dst = do
 
 copyDir :: Flags -> FilePath -> FilePath -> IO ()
 copyDir flags src dst = do
+  msg flags $ unwords ["cp -r", src, dst]
+  let flags' = flags{ quiet = not (verbose flags) }
   mkdir flags dst
   let one file = do
-        d <- doesDirectoryExist file
-        (if d then copyDir else copy) flags (src </> file) (dst </> file)
+        d <- doesDirectoryExist (src </> file)
+        (if d then copyDir else copy) flags' (src </> file) (dst </> file)
   mapM_ one =<< listDirectory src
 
 splitOn :: String -> String -> [String]
@@ -183,11 +186,11 @@ splitOn d = loop []
 macroExpand :: Flags -> String -> String
 macroExpand flags = loop
   where loop [] = []
-        loop ('$':cs) = p ++ loop r where (p, r) = expnd (macros flags) cs
+        loop ('%':cs) =
+          let (mn, rest) = span nameChar cs
+              nameChar c = isAlphaNum c || c == '_'
+          in  fromMaybe "" (lookup mn (macros flags)) ++ loop rest
         loop (c:cs) = c : loop cs
-        expnd [] s = ("", s)
-        expnd ((m,e):ms) s | Just r <- stripPrefix m s = (e, r)
-                           | otherwise = expnd ms s
 
 -----