% $Id: Desugar.oz,v 1.16 2012/01/17 11:50:53 leavens Exp leavens $ % Desugaring for part of the declarative subset of Oz % BUGS: this does not preserve positions! % AUTHOR: Gary T. Leavens \insert 'FreeVarIds.oz' \insert 'Conversions.oz' declare NOELSESUGAR = applyStmt(varId("Exception.raise") [atomExp('noElse')]) % the NOELSESUGAR should really be: % applyStmt(varId("Exception.raise") % [recordExp(atomExp('kernel') % [posFld(recordExp(atomExp('noElse') % nil))])]) % but that generates a translation that just confuses things too much! % historically we are interested in desugaring statements Desugar = DesugarStmt fun {DesugarProgram program(Qs ...)} program({Map Qs DesugarQuery}) end fun {DesugarQuery Q} case Q of seqQuery(S ...) then seqQuery({DesugarStmt S}) [] declareQuery(S ...) then declareQuery({DesugarStmt S}) [] declareInQuery(S1 S2 ...) then declareInQuery({DesugarStmt S1} {DesugarStmt S2}) end end fun {DesugarStmt 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}) [] unifyStmt(varId(V ...) Exp ...) then {DesugarExp Exp nil V} [] ifStmt(TestExp S1 S2 ...) then {UnnestExp TestExp {FreeVarIds Stmt} fun {$ V} ifStmt(varId(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(varId(PV) {Map ArgVs fun {$ V} varId(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 unifyStmt(varId(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([unifyStmt(varId(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 varId(V ...) then unifyStmt(varId(WhereItGoes) varId(V)) [] atomExp(A ...) then unifyStmt(varId(WhereItGoes) atomExp(A)) [] boolExp(B ...) then unifyStmt(varId(WhereItGoes) boolExp(B)) [] intLit(N ...) then unifyStmt(varId(WhereItGoes) intLit(N)) [] floatLit(N ...) then unifyStmt(varId(WhereItGoes) floatLit(N)) [] recordExp(LabelExp FieldList ...) then local Avoid = {Union {FreeVarIdsExp Exp} VarsToAvoid} in case LabelExp of atomExp(A ...) then {DesugarRecord atomExp(A) FieldList Avoid WhereItGoes} [] intLit(I ...) then {DesugarRecord intLit(I) FieldList Avoid WhereItGoes} [] boolExp(B ...) then {DesugarRecord boolExp(B) FieldList Avoid WhereItGoes} else {UnnestExp LabelExp Avoid fun {$ V} {DesugarRecord varId(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 unifyStmt(varId(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(varId(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 varId(WhereItGoes)|nil} {Union {Add {FreeVarIdsExp Exp} WhereItGoes} VarsToAvoid} fun {$ FV|ArgVs} applyStmt(varId(FV) {Map ArgVs fun {$ V} varId(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(varId(V) seqStmt([unifyStmt(varId(V) varId(VforExp)) S1]) ...) [] recordPat(atomExp(A) PFL ...) then local Avoid = {Union {UnionList {Map PFL DeclaredIdsPatField}} {Union {FreeVarIds S1} {Union {FreeVarIds S2} VarsToAvoid}}} dfields(newFields:NewPFL patNames:Names pats:Pats) = {IdFieldPatsFor PFL Avoid} in caseStmt(varId(VforExp) recordPat(atomExp(A) NewPFL) {CasesFor Names Pats S1 S2} S2) end else caseStmt(varId(VforExp) Pat S1 S2) end end fun {DesugarRecord LabelExp FieldList VarsToAvoid WhereItGoes} %% REQUIRES: LabelExp is a varId, 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} unifyStmt(varId(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(_ varId(V)) then {Iter Fs {Add VarsToAvoid V} FL|FLs} [] posFld(varId(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(Feat Exp ...) then {UnnestExp Exp VarsToAvoid fun {$ V} {ASTMaker colonFld(Feat varId(V))} end} [] posFld(Exp ...) then {UnnestExp Exp VarsToAvoid fun {$ V} {ASTMaker posFld(varId(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 varId(V ...) then {ASTMaker V} else local V = {Fresh "Unnest" VarsToAvoid} in localStmt(varId(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(varId(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(varId(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 PFL VarsToAvoid} %% ENSURES: Result is a record with 3 fields. The field %% newFields is the list of fields to use in the desugaring, %% patNames is the names that stand for nontrivial expressions, and %% pats is the nontrivial patterns. %% These are in the original order. %% Also the length of the exprNames and exprs lists are equal. fun {Iter PFL Fields Names Pats} fun {DoPat Pat Recur} case Pat of varIdPat(V ...) then {Recur varIdPat(V) Names Pats} [] OtherPat then local NewV = {Fresh "CasePat" {Union {AsSet Names} VarsToAvoid}} in {Recur varIdPat(NewV) NewV|Names OtherPat|Pats} end end end in case PFL of nil then dfields(newFields:{Reverse Fields} patNames:{Reverse Names} pats:{Reverse Pats}) [] colonFld(Feat Pat ...)|PFs then {DoPat Pat fun {$ NewExp NewNames NewPats} {Iter PFs colonFld(Feat NewExp)|Fields NewNames NewPats} end} [] posFld(Pat ...)|PFs then {DoPat Pat fun {$ NewExp NewNames NewPats} {Iter PFs posFld(NewExp)|Fields NewNames NewPats} end} end end in {Iter PFL nil nil nil} end