From 33184a874f16f9044da0ac27e3d782e6b96300c3 Mon Sep 17 00:00:00 2001
From: Camil Staps <info@camilstaps.nl>
Date: Sat, 9 Jun 2018 12:22:59 +0200
Subject: [PATCH] Add simple command-line sapl code generator tool

---
 .gitignore             |  3 ++
 src/saplcg.icl         | 89 ++++++++++++++++++++++++++++++++++++++++++
 src/saplcg.prj.default | 61 +++++++++++++++++++++++++++++
 3 files changed, 153 insertions(+)
 create mode 100644 src/saplcg.icl
 create mode 100644 src/saplcg.prj.default

diff --git a/.gitignore b/.gitignore
index 8a0bf11..2481d17 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,4 @@
 **/Clean System Files
+*-sapl/
+*.prj
+src/saplcg
diff --git a/src/saplcg.icl b/src/saplcg.icl
new file mode 100644
index 0000000..8995ef6
--- /dev/null
+++ b/src/saplcg.icl
@@ -0,0 +1,89 @@
+module saplcg
+
+import StdFile
+import StdList
+import StdString
+import StdTuple
+
+import Data.Error
+from Data.Func import $, seqSt
+import Data.Maybe
+import System.CommandLine
+import System.File
+import System.FilePath
+import System.Options
+import Text
+
+import Sapl.Target.CleanFlavour
+import Sapl.Target.JS.CodeGeneratorJS
+
+:: Options =
+	{ sapl_files :: ![FilePath]
+	, trampoline :: !Bool
+	, output     :: !Maybe FilePath
+	}
+
+defaultOptions :: Options
+defaultOptions =
+	{ sapl_files = []
+	, trampoline = False
+	, output     = Nothing
+	}
+
+Start w
+# ([prog:opts],w) = getCommandLine w
+# noUsage = Nothing
+# usage = Just ("Usage: " +++ prog +++ " [--trampoline] -o OUTPUT INPUT [INPUT..]")
+
+# opts = parseOptions optionDescription opts defaultOptions
+| isError opts = error noUsage (join "\n" $ fromError opts) w
+# opts = fromOk opts
+
+| isEmpty opts.sapl_files = error usage "No sapl files given" w
+| isNothing opts.output   = error usage "No output file given" w
+
+# (ok,out,w) = case opts.output of
+	Nothing -> let (f,w`) = stdio w in (True,f,w`)
+	Just o  -> fopen o FWriteText w
+# (out,_,w) = seqSt (handleFile opts) opts.sapl_files (out,Nothing,w)
+= w
+where
+	optionDescription :: Option Options
+	optionDescription = WithHelp True $ Options
+		[ Shorthand "-t" "--trampoline" $ Flag
+			"--trampoline"
+			(\opts -> Ok {opts & trampoline=True})
+			"Turn on trampoline code"
+		, Shorthand "-o" "--output" $ Option
+			"--output"
+			(\f opts -> Ok {opts & output=Just f})
+			"OUTPUT"
+			"File to write output to"
+		, Operand False
+			(\f opts -> Just $ Ok {opts & sapl_files=opts.sapl_files ++ [f]})
+			"INPUT"
+			"Sapl files to generate code for"
+		]
+
+error :: !(Maybe String) !String !*World -> *World
+error usage s w
+# io = stderr
+# io = io <<< s <<< "\n"
+# io = case usage of
+	Nothing -> io
+	Just u  -> io <<< u <<< "\n"
+# (_,w) = fclose io w
+# w = setReturnCode 1 w
+= w
+
+handleFile :: !Options !FilePath !*(!*File,!Maybe ParserState,!*World) -> *(!*File,!Maybe ParserState,!*World)
+handleFile opts fp (out,pst,w)
+#! (f,w) = readFile fp w
+| isError f = (out, pst, error Nothing (fromError f <+ " " +++ fp) w)
+#! genResult = generateJS cleanFlavour opts.trampoline (fromOk f) pst
+| isError genResult = (out, pst, error Nothing (fromError genResult) w)
+#! (res,pst) = fromOk genResult
+#! (mbError,out) = intoFile res out
+#! out = out <<< "\n"
+#! w = if (isError mbError) (error Nothing "Error while writing output\n" w) w
+= (out,Just pst,w)
diff --git a/src/saplcg.prj.default b/src/saplcg.prj.default
new file mode 100644
index 0000000..11d4902
--- /dev/null
+++ b/src/saplcg.prj.default
@@ -0,0 +1,61 @@
+Version: 1.4
+Global
+	ProjectRoot:	.
+	Target:	StdEnv
+	Exec:	{Project}/saplcg
+	CodeGen
+		CheckStacks:	False
+		CheckIndexes:	True
+	Application
+		HeapSize:	2097152
+		StackSize:	512000
+		ExtraMemory:	8192
+		IntialHeapSize:	204800
+		HeapSizeMultiplier:	4096
+		ShowExecutionTime:	False
+		ShowGC:	False
+		ShowStackSize:	False
+		MarkingCollector:	False
+		DisableRTSFlags:	False
+		StandardRuntimeEnv:	True
+		Profile
+			Memory:	False
+			MemoryMinimumHeapSize:	0
+			Time:	False
+			Stack:	False
+			Dynamics:	False
+			GenericFusion:	False
+			DescExL:	False
+		Output
+			Output:	NoConsole
+			Font:	Monaco
+			FontSize:	9
+			WriteStdErr:	False
+	Link
+		LinkMethod:	Static
+		GenerateRelocations:	False
+		GenerateSymbolTable:	False
+		GenerateLinkMap:	False
+		LinkResources:	False
+		ResourceSource:	
+		GenerateDLL:	False
+		ExportedNames:	
+	Paths
+		Path:	{Project}
+		Path:	{Application}/lib/Platform
+	Precompile:	
+	Postlink:	
+MainModule
+	Name:	saplcg
+	Dir:	{Project}
+	Compiler
+		NeverMemoryProfile:	False
+		NeverTimeProfile:	False
+		StrictnessAnalysis:	True
+		ListTypes:	StrictExportTypes
+		ListAttributes:	True
+		Warnings:	True
+		Verbose:	True
+		ReadableABC:	False
+		ReuseUniqueNodes:	True
+		Fusion:	False
-- 
GitLab