Commit 33184a87 authored by Camil Staps's avatar Camil Staps 🍃

Add simple command-line sapl code generator tool

parent 71a63e64
**/Clean System Files
*-sapl/
*.prj
src/saplcg
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)
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment