Skip to content

Commit

Permalink
temp
Browse files Browse the repository at this point in the history
  • Loading branch information
KevinRansom committed Sep 11, 2024
1 parent 6e9da14 commit 1fa9978
Showing 1 changed file with 53 additions and 3 deletions.
56 changes: 53 additions & 3 deletions src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -969,6 +969,9 @@ module Pass4_RewriteAssembly =
// let f<tps> vss = fHat<f_freeTypars> f_freeVars vss
// let fHat<tps> f_freeVars vss = f_body[<f_freeTypars>, f_freeVars]
let TransTLRBindings penv (binds: Bindings) =

printfn $"TransTLRBindings:\t\t{binds}"

let g = penv.g
if isNil binds then [], [] else
let fc = BindingGroupSharingSameReqdItems binds
Expand Down Expand Up @@ -1035,6 +1038,9 @@ module Pass4_RewriteAssembly =
if penv.topValS.Contains(bind.Var) then AdjustBindToValRepr penv.g bind

let TransBindings xisRec penv (binds: Bindings) =

printfn $"TransBindings:\t\t{xisRec}\t\t{binds}"

let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS)
let fclass = BindingGroupSharingSameReqdItems tlrBs

Expand All @@ -1059,6 +1065,9 @@ module Pass4_RewriteAssembly =
//-------------------------------------------------------------------------

let TransApp penv (fx, fty, tys, args, m) =

printfn $"TransApp:\t\t{fx}\t\t{fty}\t\t{tys}\t\tRange:{m}"

// Is it a val app, where the val f is TLR with arity wf?
// CLEANUP NOTE: should be using a mkApps to make all applications
match fx with
Expand Down Expand Up @@ -1090,6 +1099,9 @@ 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 =

printfn $"TransExpr:\t\t{expr}"

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

match expr with
Expand Down Expand Up @@ -1198,6 +1210,9 @@ module Pass4_RewriteAssembly =
/// Walk over linear structured terms in tail-recursive loop, using a continuation
/// to represent the rebuild-the-term stack
and TransLinearExpr penv z expr (contf: Expr * RewriteState -> Expr * RewriteState) =

printfn $"TransLinearExpr:\t\t{expr}"

match expr with
| Expr.Sequential (e1, e2, dir, m) ->
let e1, z = TransExpr penv z e1
Expand Down Expand Up @@ -1261,17 +1276,26 @@ module Pass4_RewriteAssembly =
contf (TransExpr penv z expr)

and TransMethod penv (z: RewriteState) (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) =

printfn $"TransMethod:\t\t{vs}\t\t{e}\t\t{m}"

let z = EnterInner z
let e, z = TransExpr penv z e
let z = ExitInner z
TObjExprMethod(slotsig, attribs, tps, vs, e, m), z

and TransBindingRhs penv z (TBind(v, e, letSeqPtOpt)) : Binding * RewriteState =

printfn $"TransBindingRhs:\t\t{e}"

let shouldInline = v.ShouldInline
let z, e = EnterShouldInline shouldInline z (fun z -> TransExpr penv z e)
TBind (v, e, letSeqPtOpt), z

and TransDecisionTree penv z x: DecisionTree * RewriteState =

printfn $"TransDecisionTree:\t\t{x}"

match x with
| TDSuccess (es, n) ->
let es, z = List.mapFold (TransExpr penv) z es
Expand All @@ -1293,16 +1317,30 @@ module Pass4_RewriteAssembly =
TDSwitch (e, cases, dflt, m), z

and TransDecisionTreeTarget penv z (TTarget(vs, e, flags)) =

printfn $"TransDecisionTreeTarget:\t\t{vs}\t\t{e}"

let z = EnterInner z
let e, z = TransExpr penv z e
let z = ExitInner z
TTarget(vs, e, flags), z

and TransValBinding penv z bind = TransBindingRhs penv z bind
and TransValBinding penv z bind =

printfn $"TransBindingRhs:\t\t{bind}"

TransBindingRhs penv z bind

and TransValBindings penv z binds = List.mapFold (TransValBinding penv) z binds
and TransValBindings penv z binds =

printfn $"TransBindingRhs:\t\t{binds}"

List.mapFold (TransValBinding penv) z binds

and TransModuleContents penv (z: RewriteState) x: ModuleOrNamespaceContents * RewriteState =

printfn $"TransBindingRhs:\t\t{x}"

match x with
| TMDefRec(isRec, opens, tycons, mbinds, m) ->
let mbinds, z = TransModuleBindings penv z mbinds
Expand All @@ -1319,9 +1357,16 @@ module Pass4_RewriteAssembly =
| TMDefOpens _ ->
x, z

and TransModuleBindings penv z binds = List.mapFold (TransModuleBinding penv) z binds
and TransModuleBindings penv z binds =

printfn $"TransBindingRhs:\t\t{binds}"

List.mapFold (TransModuleBinding penv) z binds

and TransModuleBinding penv z x =

printfn $"TransBindingRhs:\t\t{x}"

match x with
| ModuleOrNamespaceBinding.Binding bind ->
let bind, z = TransValBinding penv z bind
Expand All @@ -1331,6 +1376,9 @@ module Pass4_RewriteAssembly =
ModuleOrNamespaceBinding.Module(nm, rhs), z

let TransImplFile penv z (CheckedImplFile (fragName, pragmas, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode)) =

printfn $"TransImplFile:\t\t{fragName}"

let contentsR, z = TransModuleContents penv z contents
(CheckedImplFile (fragName, pragmas, signature, contentsR, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode)), z

Expand Down Expand Up @@ -1374,6 +1422,8 @@ let MakeTopLevelRepresentationDecisions ccu g expr =
let z = Pass4_RewriteAssembly.rewriteState0
Pass4_RewriteAssembly.TransImplFile penv z expr

printfn $"Finished"

// pass5: copyExpr to restore "each bound is unique" property
// aka, copyExpr
if verboseTLR then dprintf "copyExpr------\n"
Expand Down

0 comments on commit 1fa9978

Please sign in to comment.