Add makecleantest program

.gitignore

 Clean System Files/
-Tools/ctest
+Tools/clean-compiler/
+Tools/cleantest
+Tools/makecleantest

Cloogle @ f7c26a57

+Subproject commit f7c26a577fe7994912b67e9f38132fe024b7f8e2

Tools/Makefile

-BIN:=ctest
-SRC:=CleanTest
+BIN:=cleantest makecleantest
 CLM:=clm
 CLMFLAGS:=-nr -nt -nortsopts\
-	-I $$CLEAN_HOME/lib/Platform
+	-IL ArgEnv\
+	-IL Platform\
+	-IL Platform/Deprecated/StdLib\
+	-IL TCPIP\
+	-I Cloogle\
+	-I Cloogle/libcloogle\
+	-I Cloogle/CleanTypeUnifier\
+	-I Cloogle/CleanPrettyPrint\
+	-I clean-compiler/frontend\
+	-I clean-compiler/backend\
+	-I clean-compiler/main\
+	-I clean-compiler/main/Unix
 
 .PHONY: all clean
 
 all: $(BIN)
 
-$(BIN): .FORCE
-	$(CLM) $(CLMFLAGS) $(SRC) -o $@
+$(BIN): clean-compiler .FORCE
+	$(CLM) $(CLMFLAGS) $@ -o $@
+
+clean-compiler:
+	svn checkout -r 2838 https://svn.cs.ru.nl/repos/clean-compiler/branches/itask/ clean-compiler
+	cd clean-compiler; for f in ../Cloogle/compiler-patch/*.patch; do patch -p1 < "$$f"; done
+	$(MAKE) -j -C clean-compiler/main/Unix
+	$(MAKE) -j -C clean-compiler/backendC/CleanCompilerSources -f Makefile.linux64
+	ln -s ../../backendC/CleanCompilerSources/backend.a clean-compiler/backend/Clean\ System\ Files/backend_library
 
 clean:
 	$(RM) -r **/Clean\ System\ Files $(BIN)

Tools/CleanTest.icl → Tools/cleantest.icl

-module CleanTest
+module cleantest
 
 import StdArray
 import StdBool
@@ -207,12 +207,7 @@ Start w
 = w
 where
 	exit :: String *World -> *World
-	exit error w
-	# io = stderr
-	# io = io <<< error <<< "\n"
-	# (_,w) = fclose io w
-	# w = setReturnCode 1 w
-	= w
+	exit error w = snd $ fclose (stderr <<< error <<< "\n") $ setReturnCode 1 w
 
 	makeRuns :: [RunResult] Strategy [TestRun] -> [SubTestRun]
 	makeRuns _ S_Default runs = map JustRun runs

Tools/makecleantest.icl

+module makecleantest
+
+import StdBool
+import StdFile
+import StdOrdList
+import StdString
+import StdTuple
+
+import Data.Error
+from Data.Func import $, on, `on`
+import Data.Functor
+import Data.GenDefault
+import Data.List
+import Data.Maybe
+import System.CommandLine
+import System.File
+import System.FilePath
+import System.Options
+import Text
+
+import CloogleDBFactory
+import Doc
+
+import TypeUtil
+
+:: Options =
+	{ name          :: !String
+	, input         :: !FilePath
+	, output        :: !FilePath
+	, print_options :: ![String]
+	, test_options  :: ![String]
+	}
+
+derive gDefault Options
+
+Start w
+# ([prog:args],w) = getCommandLine w
+# opts = parseOptions optionDescription args gDefault{|*|}
+| isError opts = exit (join "\n" $ fromError opts) w
+# opts = fromOk opts
+| any ((==) "") [opts.Options.name, opts.input, opts.output]
+	= exit ("Usage: " +++ prog +++ " -n NAME -i FILE -o FILE") w
+# (funs,_,_,_,_,_,_,_,(_,mod,_),w) = findModuleContents False (dropExtension opts.input) w
+# props = generatePropertyModule
+	opts.Options.name
+	opts.print_options
+	opts.test_options
+	mod
+	[f \\ (_,f,_) <- funs]
+# (ok,w) = writeFile opts.output props w
+| isError ok = exit (fromError ok <+ " " +++ opts.output) w
+= w
+where
+	exit :: String *World -> *World
+	exit error w = snd $ fclose (stderr <<< error <<< "\n") $ setReturnCode 1 w
+
+	optionDescription :: Option Options
+	optionDescription = WithHelp True $ Options
+		[ Shorthand "-n" "--name" $ Option
+			"--name"
+			(\n opts -> Ok {Options | opts & name=n})
+			"NAME"
+			"The name for the test module"
+		, Shorthand "-i" "--input" $ Option
+			"--input"
+			(\f opts -> Ok {opts & input=f})
+			"FILE"
+			"The file name of a Clean module to generate tests for"
+		, Shorthand "-o" "--output" $ Option
+			"--output"
+			(\f opts -> Ok {opts & output=f})
+			"FILE"
+			"The file name to write the test to"
+		, Shorthand "-P" "--print-option" $ Option
+			"--print-option"
+			(\po opts -> Ok {opts & print_options=opts.print_options ++ [po]})
+			"OPT"
+			"Add OPT to the print options (see Gast's PrintOption type)"
+		, Shorthand "-T" "--test-option" $ Option
+			"--test-option"
+			(\po opts -> Ok {opts & test_options=opts.test_options ++ [po]})
+			"OPT"
+			"Add OPT to the test options (see Gast's Testoption type)"
+		]
+
+generatePropertyModule :: !String ![String] ![String] !ModuleEntry ![FunctionEntry] -> String
+generatePropertyModule name print_options test_options me fes = join "\n\n"
+	[ "module " +++ name
+	, "import Gast, Gast.CommandLine"
+	, bootstrap
+	, start
+	: [gp.gp_implementation \\ gp <- props]
+	]
+where
+	props = concatMap generateProperties fes
+
+	bootstrap = case me.me_documentation of
+		Just d  -> fromMaybe "" $ fromMultiLine <$> d.property_bootstrap
+		Nothing -> ""
+
+	start = join "\n\t"
+		[ "Start w = exposeProperties"
+		, "[" +++ join "," print_options +++ "]"
+		, "[" +++ join "," test_options +++ "]"
+		, "[ EP " +++ join "\n\t, EP " [gp.gp_name \\ gp <- props]
+		, "] w"
+		]
+
+:: GeneratedProperty =
+	{ gp_name           :: !String
+	, gp_implementation :: !String
+	}
+
+generateProperties :: !FunctionEntry -> [GeneratedProperty]
+generateProperties fe=:{fe_documentation=Just doc} =
+	[gen p config
+		\\ p <- doc.properties
+		, config <- configurations $ groupInstantiations doc.property_test_with]
+where
+	groupInstantiations :: [PropertyVarInstantiation] -> [[(String,Type)]]
+	groupInstantiations pvis = groupBy ((==) `on` fst) $ sortBy ((<) `on` fst) [vi \\ PropertyVarInstantiation vi <- pvis]
+
+	configurations :: [[(String,Type)]] -> [[(String,Type)]]
+	configurations [vis:viss] = [[vi`:vis`] \\ vi` <- vis, vis` <- configurations viss]
+	configurations [] = [[]]
+
+	gen :: !Property ![(String,Type)] -> GeneratedProperty
+	gen (ForAll name ts imp) vis =
+		{ gp_name = name`
+		, gp_implementation = join "\n"
+			[ name` +++ " :: " +++ toString type
+			, join " " [name`:map fst ts] +++ " = " +++ imp
+			]
+		}
+	where
+		name` = "prop_" +++ name
+		type = fromJust $ assignAll vis $ Func (map snd ts) (Type "Property" []) []
+generateProperties _ = []