From 4169b3b8aa5516a39586f09f057c71efd5e2fb99 Mon Sep 17 00:00:00 2001 From: Linnea Stjerna Date: Sun, 31 Dec 2023 07:23:23 +0100 Subject: [PATCH] Updates necessary for supporting tuning in mi-ocaml (#814) * Refactor inline use * Add function for parsing tune options from toml file * Update tune in main * Fix bug in toml test --- src/main/tune-config.mc | 6 -- src/main/tune.mc | 2 +- stdlib/ext/toml-ext.ext-ocaml.mc | 8 ++ stdlib/ext/toml-ext.mc | 9 ++- stdlib/tuning/tune-options.mc | 88 ++++++++++++++++++++- stdlib/tuning/tune.mc | 132 ++++++++++++------------------- 6 files changed, 152 insertions(+), 93 deletions(-) diff --git a/src/main/tune-config.mc b/src/main/tune-config.mc index 637871c49..87313b6c8 100644 --- a/src/main/tune-config.mc +++ b/src/main/tune-config.mc @@ -102,12 +102,6 @@ let tuneOptionsConfig : ParseConfig Options = concat optionsConfig [ let o: Options = p.options in let to : TuneOptions = o.tuneOptions in {o with tuneOptions = {to with debugExpansion = true}}), - ([("--seq-transform", "", "")], - "Transform sequence literals into create function choosing between rope and list", - lam p: ArgPart Options. - let o: Options = p.options in - let to : TuneOptions = o.tuneOptions in - {o with tuneOptions = {to with seqTransform = true}}), ([("--reduce-dependencies", " ", "")], join ["Reduce the dependency graph by filtering out measuring points with runtimes below this threshold value (default ", float2string tuneOptionsDefault.reduceDependencies, ")"], diff --git a/src/main/tune.mc b/src/main/tune.mc index ea730cd5b..ba346a850 100644 --- a/src/main/tune.mc +++ b/src/main/tune.mc @@ -93,7 +93,7 @@ let tune = lam files. lam options : Options. lam args. {options with output = Some (sysJoinPath r.tempDir "tune")} file ast in -- Do the tuning - let result = tuneEntry binary tuneOptions env dep instRes r ast in + let result = tune binary tuneOptions env dep instRes r ast in -- Write the best found values to filename.tune tuneFileDumpTable (tuneFileName file) env result true; diff --git a/stdlib/ext/toml-ext.ext-ocaml.mc b/stdlib/ext/toml-ext.ext-ocaml.mc index 999cbb9f0..0480f8d7c 100644 --- a/stdlib/ext/toml-ext.ext-ocaml.mc +++ b/stdlib/ext/toml-ext.ext-ocaml.mc @@ -58,6 +58,14 @@ let tomlExtMap = ", ty = tyarrows_ [tyTomlValue_, tyfloat_] } ]), + ("externalTomlValueToBoolExn", [ + impl { expr = + "fun v -> match v with + | Toml.Types.TBool v -> v + | _ -> raise (Invalid_argument (\"tomlValueToBoolExn: \" ^ (Toml.Printer.string_of_value v))) + ", + ty = tyarrows_ [tyTomlValue_, tybool_] } + ]), ("externalTomlValueToTableExn", [ impl { expr = "fun v -> match v with diff --git a/stdlib/ext/toml-ext.mc b/stdlib/ext/toml-ext.mc index 3745b3a77..3fefab945 100644 --- a/stdlib/ext/toml-ext.mc +++ b/stdlib/ext/toml-ext.mc @@ -8,11 +8,12 @@ include "map.mc" and each value is one of: - integer - float + - bool - string - TOML table - a sequence of values - Boolean and date data types are currently not supported. + Date data types are currently not supported. -/ type TomlTable @@ -84,6 +85,12 @@ let tomlValueToFloatExn = lam v. externalTomlValueToFloatExn v utest tomlValueToFloatExn (tomlFindExn "key" (tomlFromStringExn "key=3.14")) with 3.14 +-- 'tomlValueToBoolExn v' converts a toml value to a bool. +external externalTomlValueToBoolExn ! : TomlValue -> Bool +let tomlValueToBoolExn = lam v. externalTomlValueToBoolExn v + +utest tomlValueToBoolExn (tomlFindExn "key" (tomlFromStringExn "key=true")) with true + -- 'tomlValueToTableExn v' converts a toml value to a toml table. external externalTomlValueToTableExn ! : TomlValue -> TomlTable let tomlValueToTableExn = lam v. externalTomlValueToTableExn v diff --git a/stdlib/tuning/tune-options.mc b/stdlib/tuning/tune-options.mc index 488898e73..f22fab26d 100644 --- a/stdlib/tuning/tune-options.mc +++ b/stdlib/tuning/tune-options.mc @@ -1,4 +1,6 @@ +include "assoc.mc" include "option.mc" +include "ext/toml-ext.mc" type SearchMethod con Exhaustive : () -> SearchMethod @@ -26,7 +28,6 @@ type TuneOptions = , debugInstrumentation : Bool , debugExpansion : Bool , reduceDependencies : Float -, seqTransform : Bool , printStats : Bool } @@ -43,12 +44,93 @@ let tuneOptionsDefault : TuneOptions = , ignoreErrors = false , exitEarly = true , seed = None () -, dependencyAnalysis = false +, dependencyAnalysis = true , debugDependencyAnalysis = false , debugInstrumentation = false , debugExpansion = false -, seqTransform = false , reduceDependencies = 0.0 , cleanup = false , printStats = false } + +let tuneOptionsFromToml: TuneOptions -> String -> TuneOptions = + lam default. lam tomlString. + let toml = tomlBindings (tomlFromStringExn tomlString) in + foldl (lam acc. lam bind: (String, TomlValue). + match bind with (k,v) in + switch k + case "verbose" then {acc with verbose = tomlValueToBoolExn v} + case "iters" then {acc with iters = tomlValueToIntExn v} + case "timeoutMs" then {acc with timeoutMs = Some (tomlValueToFloatExn v)} + case "warmups" then {acc with warmups = tomlValueToIntExn v} + case "method" then + let method = tomlValueToStringExn v in + {acc with method = optionGetOrElse + (lam. error (concat "Unknown method: " method)) + (assocLookup {eq=eqString} method tuneSearchMethodMap)} + case "args" then {acc with args = tomlValueToStringSeqExn v} + case "epsilonMs" then {acc with epsilonMs = tomlValueToFloatExn v} + case "stepSize" then {acc with stepSize = tomlValueToIntExn v} + case "ignoreErrors" then {acc with ignoreErrors = tomlValueToBoolExn v} + case "exitEarly" then {acc with exitEarly = tomlValueToBoolExn v} + case "seed" then {acc with seed = Some (tomlValueToIntExn v)} + case "dependencyAnalysis" then + {acc with dependencyAnalysis = tomlValueToBoolExn v} + case "debugDependencyAnalysis" then + {acc with debugDependencyAnalysis = tomlValueToBoolExn v} + case "debugInstrumentation" then + {acc with debugInstrumentation = tomlValueToBoolExn v} + case "debugExpansion" then + {acc with debugExpansion = tomlValueToBoolExn v} + case "reduceDependencies" then + {acc with reduceDependencies = tomlValueToFloatExn v} + case "cleanup" then {acc with cleanup = tomlValueToBoolExn v} + case "printStats" then {acc with printStats = tomlValueToBoolExn v} + case key then error (concat "Unknown option: " key) + end + ) default toml + +mexpr + +utest tuneOptionsFromToml tuneOptionsDefault +" +verbose = true +iters = 3 +timeoutMs = 0.1 +method = \"exhaustive\" +args = [\"3000 3 1\", \"20000 3 2\"] +epsilonMs = 1.0 +stepSize = 102 +ignoreErrors = true +exitEarly = false +seed = 42 +dependencyAnalysis = false +debugDependencyAnalysis = true +debugInstrumentation = true +debugExpansion = false +reduceDependencies = 10.0 +cleanup = true +printStats = true +" +with +{ verbose = true +, iters = 3 +, timeoutMs = Some 0.1 +, warmups = 1 +, method = Exhaustive () +, args = ["3000 3 1", "20000 3 2"] +, epsilonMs = 1.0 +, stepSize = 102 +, ignoreErrors = true +, exitEarly = false +, seed = Some 42 +, dependencyAnalysis = false +, debugDependencyAnalysis = true +, debugInstrumentation = true +, debugExpansion = false +, reduceDependencies = 10.0 +, cleanup = true +, printStats = true +} +in +() diff --git a/stdlib/tuning/tune.mc b/stdlib/tuning/tune.mc index cfc390586..36cf60356 100644 --- a/stdlib/tuning/tune.mc +++ b/stdlib/tuning/tune.mc @@ -22,21 +22,6 @@ include "ocaml/pprint.mc" -- Start time of search. let tuneSearchStart = ref 0. --- Return code for timeout -let _returnCodeTimeout = 124 - --- Default command line options if program takes no input -let _inputEmpty = [""] - --- Convert from ms to s -let _ms2s = lam ms. divf ms 1000. - --- Filter out duplicates -let _distinct = lam cmp. lam seq. - setToSeq (setOfSeq cmp seq) - -utest _distinct subi [1,2,1] with [1,2] - ------------------------------ -- Base fragment for tuning -- ------------------------------ @@ -49,9 +34,33 @@ con Error : {msg : String, returncode : Int} -> TimingResult con Timeout : {ms : Float} -> TimingResult lang TuneBase = HoleAst - sem tune : TuneOptions -> Runner -> CallCtxEnv -> DependencyGraph - -> InstrumentedResult -> String -> (() -> ()) -> LookupTable -> Expr - -> LookupTable + sem tune : String -> TuneOptions -> CallCtxEnv -> DependencyGraph + -> InstrumentedResult -> ContextExpanded -> Expr -> LookupTable + sem tune binary options env dep inst exp = + | ast -> + -- Set the random seed? + (match options.seed with Some seed then randSetSeed seed else ()); + + let holes : [Expr] = env.idx2hole in + let hole2idx : Map NameInfo (Map [NameInfo] Int) = env.hole2idx in + + let ms2s = lam ms. divf ms 1000. in + + -- Runs the program with a given command-line input and optional timeout + let runner = lam input : String. lam timeoutMs : Option Float. + sysRunCommandWithTimingTimeout (optionMap ms2s timeoutMs) [binary, input] "" "." + in + + let cleanup = lam. + exp.cleanup (); + inst.cleanup () + in + + _tune options runner env dep inst exp.tempFile cleanup exp.table ast + + sem _tune : TuneOptions -> Runner -> CallCtxEnv -> DependencyGraph + -> InstrumentedResult -> String -> (() -> ()) -> LookupTable -> Expr + -> LookupTable sem measure (env: CallCtxEnv) (table: LookupTable) (runner: Runner) (file: String) (options: TuneOptions) (timeout: Option Float) @@ -64,7 +73,7 @@ lang TuneBase = HoleAst let rcode = res.returncode in match rcode with 0 then Success {ms = ms} - else if eqi rcode _returnCodeTimeout then + else if eqi rcode 124 then Timeout {ms = ms} else let msg = strJoin " " @@ -85,7 +94,7 @@ lang TuneBase = HoleAst | options -> let options : TuneOptions = options in let input = - match options.args with [] then _inputEmpty else options.args + match options.args with [] then [""] else options.args in input end @@ -97,7 +106,7 @@ end lang TuneLocalSearch = TuneBase + LocalSearchBase syn LSData = - sem initMeta : LSData -> MetaState + sem initMeta : LSData -> SearchMethod -> MetaState sem debugSearch : SearchState -> () @@ -158,18 +167,18 @@ lang TuneLocalSearch = TuneBase + LocalSearchBase | _ -> false -- Entry point for tuning - sem tune (options : TuneOptions) (run : Runner) (env : CallCtxEnv) + sem _tune (options : TuneOptions) (run : Runner) (env : CallCtxEnv) (dep : DependencyGraph) (inst : InstrumentedResult) (tuneFile : String) (onFailure : () -> ()) (defaultTable: LookupTable) = | t -> - match tuneDebug options run env dep inst tuneFile onFailure defaultTable t + match _tuneDebug options run env dep inst tuneFile onFailure defaultTable t with (table, _) in table -- Like 'tune', but also returns the final search state (for testing) - sem tuneDebug (options : TuneOptions) (run : Runner) (env : CallCtxEnv) - (dep : DependencyGraph) (inst : InstrumentedResult) - (tuneFile : String) (onFailure : () -> ()) - (defaultTable : LookupTable) = + sem _tuneDebug (options : TuneOptions) (run : Runner) (env : CallCtxEnv) + (dep : DependencyGraph) (inst : InstrumentedResult) + (tuneFile : String) (onFailure : () -> ()) + (defaultTable : LookupTable) = | t -> -- Nothing to tune? if null defaultTable then ([], None ()) else @@ -187,7 +196,7 @@ lang TuneLocalSearch = TuneBase + LocalSearchBase else ()); (defaultTable, None ()) else - let meta = initMeta data in + let meta = initMeta data options.method in let initTable = initialTable defaultTable meta in -- Warmup runs @@ -253,7 +262,7 @@ end -- Dependency-aware tuning -- ----------------------------- -lang TuneDep = TuneLocalSearch + Database +lang TuneDep = TuneLocalSearch + Database + TuneStats syn LSData = | TuneData { options : TuneOptions, run : Runner, env : CallCtxEnv, dep : DependencyGraph, inst : InstrumentedResult, @@ -277,7 +286,6 @@ lang TuneDep = TuneLocalSearch + Database , data = Some (TuneData { searchSpace = space, database = db }) } then - use MExprPrettyPrint in let elapsed = subf (wallTimeMs ()) (deref tuneSearchStart) in -- OPT(Linnea, 2022-02-08): Increase % incrementally let entries = databaseCount db in @@ -314,7 +322,6 @@ lang TuneDep = TuneLocalSearch + Database let database = databaseEmpty dep.offset dep.nbrMeas in (if options.printStats then - use TuneStats in printLn (tuneStats options dep searchSpace env t) else ()); @@ -354,7 +361,6 @@ lang TuneDep = TuneLocalSearch + Database -- Print the result (if d.options.printStats then - use TuneStats in printLn (tuneStatsTime sorted) else ()); @@ -391,7 +397,6 @@ lang TuneDep = TuneLocalSearch + Database sem getProfile = | profiles -> - use Instrumentation in let mergeProfiles = lam p1: InstrumentationProfile. lam p2: InstrumentationProfile. match (p1, p2) with ( {ids= ids1, nbrRuns= nbrRuns1, totalMs= totalMs1} @@ -475,10 +480,11 @@ end lang TuneDepExhaustive = TuneDep + SearchSpace syn MetaState = - | Exhaustive { tables : DataFrame (Option Expr) } + | MetaExhaustive { tables : DataFrame (Option Expr) } - sem initMeta = - | TuneData d -> + sem initMeta data = + | Exhaustive {} -> + match data with TuneData d in let df: DataFrame (Option Expr) = searchSpaceExhaustive d.options.stepSize d.env d.dep in -- If the first row contains a None (), it means that hole is not connected -- to a measuring point. Set those to the default value. @@ -488,10 +494,10 @@ lang TuneDepExhaustive = TuneDep + SearchSpace ) (head df.data) in let df = dataFrameSetRow 0 row0 df in - Exhaustive {tables = df} + MetaExhaustive {tables = df} sem initialTable (defaultTable : LookupTable) = - | Exhaustive {tables = tables} -> + | MetaExhaustive {tables = tables} -> let res = mapi (lam i. lam v. match v with Some v then v @@ -503,7 +509,7 @@ lang TuneDepExhaustive = TuneDep + SearchSpace res sem step (searchState : SearchState) = - | Exhaustive { tables = tables } -> + | MetaExhaustive { tables = tables } -> match searchState with { iter = iter, cost = cost, data = data } in match data with Some (TuneData {env = env, options = options}) then let row = iter in @@ -520,47 +526,15 @@ lang TuneDepExhaustive = TuneDep + SearchSpace in let a = Table {table = t} in ( Some {assignment = a, cost = cost (None ()) a} - , Exhaustive {tables = tables} ) - else ( None(), Exhaustive {tables = tables} ) + , MetaExhaustive {tables = tables} ) + else ( None(), MetaExhaustive {tables = tables} ) else error "Expected tune data" end -let _tuneMethod = lam options : TuneOptions. - switch options.method - case Exhaustive {} then use TuneDepExhaustive in tune - end - --- Entry point for tuning -let tuneEntry = - lam binary : String. - lam options : TuneOptions. - lam env : CallCtxEnv. - lam dep : DependencyGraph. - lam inst : InstrumentedResult. - lam exp : ContextExpanded. - - -- Set the random seed? - (match options.seed with Some seed then randSetSeed seed else ()); - - let holes : use Ast in [Expr] = env.idx2hole in - let hole2idx : Map NameInfo (Map [NameInfo] Int) = env.hole2idx in - - -- Runs the program with a given command-line input and optional timeout - let runner = lam input : String. lam timeoutMs : Option Float. - sysRunCommandWithTimingTimeout (optionMap _ms2s timeoutMs) [binary, input] "" "." - in - - let cleanup = lam. - exp.cleanup (); - inst.cleanup () - in +lang MExprTune = MExpr + TuneDepExhaustive end - (_tuneMethod options) options runner env dep inst exp.tempFile cleanup - exp.table - -lang MExprTune = MExpr + TuneBase end lang TestLang = - TuneDep + GraphColoring + MExprHoleCFA + DependencyAnalysis + + MExprTune + GraphColoring + MExprHoleCFA + DependencyAnalysis + NestedMeasuringPoints + ContextExpand + Instrumentation + BootParser + MExprSym + MExprPrettyPrint + MExprEval + MExprTypeCheck + MExprLowerNestedPatterns + MCoreCompileLang @@ -639,13 +613,7 @@ let test : Bool -> Bool -> TuneOptions -> Expr -> (LookupTable, Option SearchSta instrumented.cleanup (); cunit.cleanup () in - use TuneDep in - let tune = - switch options.method - case Exhaustive () then use TuneDepExhaustive in tuneDebug - end - in - let res = tune options runner env dep instrumented exp.tempFile cleanup exp.table ast in + let res = _tuneDebug options runner env dep instrumented exp.tempFile cleanup exp.table ast in cleanup (); res in