Skip to content

Commit

Permalink
temp
Browse files Browse the repository at this point in the history
  • Loading branch information
KevinRansom committed Sep 12, 2024
1 parent 460b7f7 commit ce50c16
Showing 1 changed file with 21 additions and 16 deletions.
37 changes: 21 additions & 16 deletions src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -196,8 +196,8 @@ module Pass1_DetermineTLRAndArities =
let arity = Operators.min nFormals nMaxApplied
if atTopLevel then
Some (f, arity)
elif g.realsig then
None
//elif g.realsig then
// None
else if arity<>0 || not (isNil tps) then
Some (f, arity)
else
Expand All @@ -217,28 +217,32 @@ module Pass1_DetermineTLRAndArities =

let DetermineTLRAndArities g expr =
let xinfo = GetUsageInfoOfImplFile g expr
let fArities = Zmap.chooseL (SelectTLRVals g xinfo) xinfo.Defns
let fArities = List.filter (fst >> IsValueRecursionFree xinfo) fArities
// Do not TLR v if it is bound under a shouldinline defn
// There is simply no point - the original value will be duplicated and TLR'd anyway
let rejectS = GetValsBoundUnderShouldInline xinfo
let fArities = List.filter (fun (v, _) -> not (Zset.contains v rejectS)) fArities
(*-*)
let tlrS = Zset.ofList valOrder (List.map fst fArities)
let topValS = xinfo.TopLevelBindings (* genuinely top level *)
let topValS = Zset.filter (IsMandatoryNonTopLevel g >> not) topValS (* restrict *)
let rejects = GetValsBoundUnderShouldInline xinfo
let fArities =
xinfo.Defns
|> Zmap.chooseL (SelectTLRVals g xinfo)
|> List.filter (fst >> IsValueRecursionFree xinfo)
// Do not TLR v if it is bound under a shouldinline defn
// There is simply no point - the original value will be duplicated and TLR'd anyway
|> List.filter (fun (v, _) -> not (Zset.contains v rejects))

let tlrs = Zset.ofList valOrder (List.map fst fArities)
let topVals =
xinfo.TopLevelBindings // genuinely top level *)
|> Zset.filter (IsMandatoryNonTopLevel g >> not) // restrict

#if DEBUG
(* REPORT MISSED CASES *)
if verboseTLR then
let missed = Zset.diff xinfo.TopLevelBindings tlrS
let missed = Zset.diff xinfo.TopLevelBindings tlrs
missed |> Zset.iter (fun v -> dprintf "TopLevel but not TLR = %s\n" v.LogicalName)
(* REPORT OVER *)
#endif
let arityM = Zmap.ofList valOrder fArities
#if DEBUG
if verboseTLR then DumpArity arityM
#endif
tlrS, topValS, arityM
tlrs, topVals, arityM

(* NOTES:
For constants,
Expand Down Expand Up @@ -760,7 +764,6 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap<BindingGroupShari
let aenvExprFor v = exprForVal env.m (aenvFor v)

// build PackedReqdItems
let reqdTypars = env.reqdTypars
let aenvs = Zmap.values cmap
let pack = cmapPairs |> List.map (fun (v, aenv) -> mkInvisibleBind aenv (exprForVal env.m v))
let unpack =
Expand All @@ -785,7 +788,7 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap<BindingGroupShari
dprintf "tlr: packEnv unpack =%s\n" (showL (listL bindingL unpack))

// result
(fc, { ep_etps = Zset.elements reqdTypars
(fc, { ep_etps = [] //Zset.elements env.reqdTypars
ep_aenvs = aenvs
ep_pack = pack
ep_unpack = unpack}), carrierMaps
Expand Down Expand Up @@ -996,6 +999,7 @@ module Pass4_RewriteAssembly =
fBind

let fHatNewBinding (shortRecBinds: Bindings) (TBind(f, b, letSeqPtOpt)) =
printfn $"fHatNewBinding: f:{f} b:{b}"
let wf = Zmap.force f penv.arityM ("fHatNewBinding - arityM", nameOfVal)
let fHat = Zmap.force f penv.fHatM ("fHatNewBinding - fHatM", nameOfVal)

Expand Down Expand Up @@ -1092,6 +1096,7 @@ module Pass4_RewriteAssembly =
/// At free vals, fixup 0-call if it is an arity-met constant.
/// Other cases rewrite structurally.
let rec TransExpr (penv: RewriteContext) (z: RewriteState) expr: Expr * RewriteState =

penv.stackGuard.Guard <| fun () ->

match expr with
Expand Down

0 comments on commit ce50c16

Please sign in to comment.