% $Id: Desugar.oz,v 1.10 2011/04/15 15:53:36 leavens Exp leavens $ % Desugaring for part of the declarative subset of Oz % AUTHOR: Gary T. Leavens \insert 'FreeVarIds.oz' \insert 'Conversions.oz' declare NOELSESUGAR = applyStmt(varIdExp("Exception.raise") [atomExp('noElse')]) % should really be: % applyStmt(varIdExp("Exception.raise") % [recordExp(atomExp('kernel') % [posFld(recordExp(atomExp('noElse') % nil))])]) % but that generates a translation that just confuses things too much! fun {Desugar Stmt} %% ENSURES: Result is an AST that is the desugared version of Stmt case Stmt of skipStmt(...) then skipStmt [] seqStmt(StmtList ...) then seqStmt({Map StmtList Desugar}) [] localStmt(V Body ...) then localStmt(V {Desugar Body}) [] assignStmt(V Exp ...) then {DesugarExp Exp nil V} [] ifStmt(TestExp S1 S2 ...) then {UnnestExp TestExp {FreeVarIds Stmt} fun {$ V} ifStmt(varIdExp(V) {Desugar S1} {Desugar S2}) end} [] caseStmt(Expr Pattern S1 S2 ...) then local FVs = {FreeVarIds Stmt} in {UnnestExp Expr FVs fun {$ VforExp} {UnnestCasePattern Pattern VforExp {Add FVs VforExp} {Desugar S1} {Desugar S2}} end} end [] applyStmt(ProcExp ArgExpList ...) then {UnnestExps ProcExp|ArgExpList {FreeVarIds Stmt} fun {$ PV|ArgVs} applyStmt(varIdExp(PV) {Map ArgVs fun {$ V} varIdExp(V) end}) end} [] namedFunStmt(Name Formals Body ...) then local Avoid = {Union {UnionList {Map Formals DeclaredIdsPattern}} {FreeVarIdsExp Body}} Result = {Fresh "Result" Avoid} FRs = {Append Formals [varIdPat(Result)]} dformals(newFormals:Vars patternNames:Names patterns:Pats) = {IdFormalsFor FRs {Add Avoid Result}} in assignStmt(Name procExp({Map Vars fun {$ V} varIdPat(V) end} {CasesFor Names Pats {DesugarExp Body {Union Vars {Add Avoid Result}} Result} {Desugar NOELSESUGAR}})) end [] inStmt(Pattern Exp Body ...) then {UnnestExp Exp {FreeVarIds Stmt} fun {$ V} PatIds = {AsList {DeclaredIdsPattern Pattern}} in {LocalsFor PatIds seqStmt([assignStmt(V {Pattern2Exp Pattern}) {Desugar Body}])} end} [] threadStmt(S ...) then threadStmt({Desugar S}) end end fun {DesugarExp Exp VarsToAvoid WhereItGoes} %% ENSURES: Result is a statement AST that places the result of %% desugaring Exp in WhereItGoes. %% Any new local variables used avoid all those in VarsToAvoid. case Exp of varIdExp(V ...) then assignStmt(WhereItGoes varIdExp(V)) [] atomExp(A ...) then assignStmt(WhereItGoes atomExp(A)) [] boolExp(B ...) then assignStmt(WhereItGoes boolExp(B)) [] numExp(N ...) then assignStmt(WhereItGoes numExp(N)) [] recordExp(LabelExp FieldList ...) then local Avoid = {Union {FreeVarIdsExp Exp} VarsToAvoid} in case LabelExp of atomExp(A ...) then {DesugarRecord atomExp(A) FieldList Avoid WhereItGoes} [] boolExp(B ...) then {DesugarRecord boolExp(B) FieldList Avoid WhereItGoes} else {UnnestExp LabelExp Avoid fun {$ V} {DesugarRecord varIdExp(V) FieldList {Add Avoid V} WhereItGoes} end} end end [] procExp(Formals Body ...) then local Avoid = {Union {UnionList {Map Formals DeclaredIdsPattern}} {Union {FreeVarIds Body} VarsToAvoid}} dformals(newFormals:Vars patternNames:Names patterns:Pats) = {IdFormalsFor Formals Avoid} in assignStmt(WhereItGoes procExp({Map Vars fun {$ V} varIdPat(V) end} {CasesFor Names Pats {Desugar Body} {Desugar NOELSESUGAR}})) end [] ifExp(TestExp E1 E2 ...) then local Avoid = {Union {FreeVarIdsExp Exp} VarsToAvoid} in {UnnestExp TestExp Avoid fun {$ V} ifStmt(varIdExp(V) {DesugarExp E1 {Add Avoid V} WhereItGoes} {DesugarExp E2 {Add Avoid V} WhereItGoes}) end} end [] caseExp(Expr Pattern E1 E2 ...) then local Avoid = {Union {FreeVarIdsExp Expr} VarsToAvoid} in {UnnestExp Expr Avoid fun {$ V} {UnnestCasePattern Pattern V {Add Avoid V} {DesugarExp E1 {Add Avoid V} WhereItGoes} {DesugarExp E2 {Add Avoid V} WhereItGoes}} end} end [] applyExp(FunExp ArgExpList ...) then {UnnestExps {Append FunExp|ArgExpList varIdExp(WhereItGoes)|nil} {Union {Add {FreeVarIdsExp Exp} WhereItGoes} VarsToAvoid} fun {$ FV|ArgVs} applyStmt(varIdExp(FV) {Map ArgVs fun {$ V} varIdExp(V) end}) end} [] threadExp(Expr ...) then threadStmt({DesugarExp Expr VarsToAvoid WhereItGoes}) end end fun {UnnestCasePattern Pat VforExp VarsToAvoid S1 S2} case Pat of varIdPat(V ...) then %% S2 will never execute, and can't desugar to case %% because a variable is not a kernel language pattern localStmt(V seqStmt([assignStmt(V varIdExp(VforExp)) S1]) ...) [] recordPat(A FL ...) then local Avoid = {Union {UnionList {Map FL FreeVarIdsField}} {Union {FreeVarIds S1} {Union {FreeVarIds S2} VarsToAvoid}}} dfields(newFields:NewFL exprNames:Names exprs:Exps) = {IdFieldPatsFor FL Avoid} in caseStmt(varIdExp(VforExp) recordPat(A NewFL) {CasesFor Names {Map Exps Exp2Pattern} S1 S2} S2) end else caseStmt(varIdExp(VforExp) Pat S1 S2) end end fun {DesugarRecord LabelExp FieldList VarsToAvoid WhereItGoes} %% REQUIRES: LabelExp is a varIdExp, an atomExp, or a boolExp %% ENSURES: Result is a statement that binds the record %% whose label is LabelExp and with field list FieldList to WhereItGoes. {DesugarFields FieldList VarsToAvoid fun {$ FL} assignStmt(WhereItGoes recordExp(LabelExp FL)) end} end fun {DesugarFields FieldList VarsToAvoid ASTMaker} %% ENSURES: Result is a statement that computes the value of the %% expression in the field, store it in a local, and then returns %% what ASTMaker returns when called on the fields that use the %% local names. Any new local variables used avoid all the %% identifiers in VarsToAvoid. fun {Iter Exps VarsToAvoid FLs} case Exps of nil then {ASTMaker {Reverse FLs}} [] F|Fs then {DesugarField F VarsToAvoid fun {$ FL} case FL of colonFld(_ varIdExp(V)) then {Iter Fs {Add VarsToAvoid V} FL|FLs} [] posFld(varIdExp(V)) then {Iter Fs {Add VarsToAvoid V} FL|FLs} end end} end end in {Iter FieldList VarsToAvoid nil} end fun {DesugarField Field VarsToAvoid ASTMaker} %% ENSURES: Result is a statement that computes the value of the %% expression in the field, store it in a local, and then returns %% what ASTMaker returns when called on the fields that use the %% local name. %% Any new local variables used avoid all the identifiers in VarsToAvoid. case Field of colonFld(Name Exp ...) then {UnnestExp Exp VarsToAvoid fun {$ V} {ASTMaker colonFld(Name varIdExp(V))} end} [] posFld(Exp ...) then {UnnestExp Exp VarsToAvoid fun {$ V} {ASTMaker posFld(varIdExp(V))} end} end end fun {UnnestExp Exp VarsToAvoid ASTMaker} %% ENSURES: Result is a statement that computes the value Exp in a local, %% and then performs what ASTMaker returns when called on that local's name. %% Any new local variables used avoid all the identifiers in VarsToAvoid. case Exp of varIdExp(V ...) then {ASTMaker V} else local V = {Fresh "Unnest" VarsToAvoid} in localStmt(V seqStmt([{DesugarExp Exp {Add VarsToAvoid V} V} {ASTMaker V}])) end end end fun {UnnestExps Exps VarsToAvoid ASTMaker} %% ENSURES: Result is a statement that computes the values of each expression %% Exps, stores them in locals, and and then performs what ASTMaker %% returns when called on the local names. %% Any new local variables used avoids all identifiers in VarsToAvoid. fun {Iter Exps VarsToAvoid Vars} case Exps of nil then {ASTMaker {Reverse Vars}} [] E|Es then {UnnestExp E VarsToAvoid fun {$ V} {Iter Es {Add VarsToAvoid V} V|Vars} end} end end in {Iter Exps VarsToAvoid nil} end fun {Fresh BaseName NamesToAvoid} %% ENSURES: Result is a fresh name that is either BaseName or BaseName %% with a numeric string appended. %% The returned name has the property that it is not one of NamesToAvoid. fun {Iter Num} FullName = {Append BaseName {IntToString Num}} in if {Not {IsMember NamesToAvoid FullName}} then FullName else {Iter Num+1} end end in %% The following if makes a special case to avoid suffixes if possible. %% This looks better, but isn't necessary. if {Not {IsMember NamesToAvoid BaseName}} then BaseName else {Iter 1} end end fun {LocalsFor Vars Stmt} %% ENSURES: Result wraps local statements to declare each variable %% in Vars around Stmt case Vars of nil then Stmt [] V|Vs then localStmt(V {LocalsFor Vs Stmt}) end end fun {CasesFor Names Pats S1 S2} %% REQUIRES: the length of Names and Pats is the same. %% ENSURES: Result wraps case statements to match each pattern in Pats %% around S1, using S2 for the non-matches case Names#Pats of nil#nil then S1 [] (N|Ns)#(P|Ps) then caseStmt(varIdExp(N) P {CasesFor Ns Ps S1 S2} S2) end end fun {IdFormalsFor Formals VarsToAvoid} %% ENSURES: Result is a record with 3 fields. The field %% newFormals is the names of the formals to use in the desugaring, %% patternNames is the names of the formals that stand for nontrivial %% patterns, and %% patterns is the nontrivial patterns. %% These are in the original order. %% Also the length of the patternNames and patterns lists are equal. fun {Iter Formals Vars Names Pats} case Formals of nil then dformals(newFormals:{Reverse Vars} patternNames:{Reverse Names} patterns:{Reverse Pats}) [] varIdPat(V ...)|Fs then {Iter Fs V|Vars Names Pats} [] OtherPat|Fs then local NewV = {Fresh "ArgPat" {Union {AsSet Names} VarsToAvoid}} in {Iter Fs NewV|Vars NewV|Names OtherPat|Pats} end end end in {Iter Formals nil nil nil} end fun {IdFieldPatsFor FL VarsToAvoid} %% ENSURES: Result is a record with 3 fields. The field %% newFields is the list of fields to use in the desugaring, %% exprNames is the names that stand for nontrivial expressions, and %% exprs is the nontrivial patterns. %% These are in the original order. %% Also the length of the exprNames and exprs lists are equal. fun {Iter FL Fields Names Exps} fun {DoExp Expr Recur} case Expr of varIdExp(V ...) then {Recur varIdExp(V) Names Exps} [] OtherExp then local NewV = {Fresh "CasePat" {Union {AsSet Names} VarsToAvoid}} in {Recur varIdExp(NewV) NewV|Names OtherExp|Exps} end end end in case FL of nil then dfields(newFields:{Reverse Fields} exprNames:{Reverse Names} exprs:{Reverse Exps}) [] colonFld(N Expr ...)|Fs then {DoExp Expr fun {$ NewExp NewNames NewExps} {Iter Fs colonFld(N NewExp)|Fields NewNames NewExps} end} [] posFld(Expr ...)|Fs then {DoExp Expr fun {$ NewExp NewNames NewExps} {Iter Fs posFld(NewExp)|Fields NewNames NewExps} end} end end in {Iter FL nil nil nil} end