% $Id: DesugarTest.oz,v 1.17 2012/01/17 11:50:53 leavens Exp leavens $ % AUTHOR: Gary T. Leavens \insert 'Desugar.oz' \insert 'Unparse.oz' \insert 'TestingNoStop.oz' %% from the course library declare % A helping procedure to eliminate repitition in the testing below proc {DSTest Expected AST} %% ENSURES: Desugaring and the expected output are shown, and compared UPAST = {VirtualString.toString {UnparseStmt AST}} in {System.showInfo ""} {System.showInfo "Desugar(" # UPAST # ")"} local StrExpected = {VirtualString.toString Expected} Ans = {Desugar AST} UPAns = {UnparseStmt Ans} Same = {VirtualString.toString UPAns} == StrExpected in {System.showInfo " == " # UPAns} if {Not Same} then {System.showInfo "Expected: " # StrExpected} end {Assert Same} end end {StartTesting 'DesugarTest $Revision: 1.17 $'} {DSTest "skip" skipStmt } {DSTest "local A in skip end" localStmt(varId('A') skipStmt) } {DSTest "A = B" unifyStmt(varId('A') varId('B')) } {DSTest "A = 3" unifyStmt(varId('A') intLit(3)) } {DSTest "A = 3 B = C" seqStmt([unifyStmt(varId('A') intLit(3)) unifyStmt(varId('B') varId('C'))]) } {DSTest "A = 3 B = C E = A" seqStmt([unifyStmt(varId('A') intLit(3)) unifyStmt(varId('B') varId('C')) unifyStmt(varId('E') varId('A'))]) } {DSTest "if B then skip else skip end" ifStmt(varId('B') skipStmt skipStmt) } {DSTest "local Unnest in Unnest = true if Unnest then skip else skip end end" ifStmt(boolExp(true) skipStmt skipStmt) } {DSTest "local Unnest in Unnest = true if Unnest then R = true else S = false end end" ifStmt(boolExp(true) unifyStmt(varId('R') boolExp(true)) unifyStmt(varId('S') boolExp(false))) } {DSTest "if X then A = B else skip end" ifStmt(varId('X') unifyStmt(varId('A') varId('B')) skipStmt) } {DSTest "if X then A = B else D = Z end" ifStmt(varId('X') unifyStmt(varId('A') varId('B')) unifyStmt(varId('D') varId('Z'))) } {DSTest "local A in A = B end" localStmt(varId('A') unifyStmt(varId('A') varId('B'))) } {DSTest "local X in X = C skip end" caseStmt(varId('C') varIdPat('X') skipStmt skipStmt) } {DSTest "case C of ok then skip else skip end" caseStmt(varId('C') atomPat(ok) skipStmt skipStmt) } {DSTest "local X in X = C B = X end" caseStmt(varId('C') varIdPat('X') unifyStmt(varId('B') varId('X')) skipStmt) } {DSTest "local X in X = C B = X end" caseStmt(varId('C') varIdPat('X') unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) } {DSTest "case C of nowXisFree then B = X else D = 7 end" caseStmt(varId('C') atomPat(nowXisFree) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) } {DSTest "local Q in Q = C B = X end" caseStmt(varId('C') varIdPat('Q') unifyStmt(varId('B') varId('X')) unifyStmt(varId('Z') varId('Q'))) } {DSTest "case C of foo() then B = X else D = 7 end" caseStmt(varId('C') recordPat(atomExp(foo) nil) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') intLit(7))) } {DSTest "case C of foo(1:X 2:Y) then B = X else D = Y end" caseStmt(varId('C') recordPat(atomExp(foo) [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') varId('Y'))) } {DSTest "case C of foo(f1:X f2:Y) then B = X else D = Y end" caseStmt(varId('C') recordPat(atomExp(foo) [colonFld(atomExp(f1) varIdPat('X')) colonFld(atomExp(f2) varIdPat('Y'))]) unifyStmt(varId('B') varId('X')) unifyStmt(varId('D') varId('Y'))) } {DSTest "case C of foo(f1:CasePat)" # " then case CasePat of bar(f2:X f3:Y f4:Z)" # " then B = X if Z then D = Y else skip end else skip end" # " else skip end" caseStmt(varId('C') recordPat(atomExp(foo) [colonFld(atomExp(f1) recordPat(atomExp(bar) [colonFld(atomExp(f2) varIdPat('X')) colonFld(atomExp(f3) varIdPat('Y')) colonFld(atomExp(f4) varIdPat('Z'))]))]) seqStmt([unifyStmt(varId('B') varId('X')) ifStmt(varId('Z') unifyStmt(varId('D') varId('Y')) skipStmt)]) skipStmt) } {DSTest "case C of foo(f1:CasePat)" # " then case CasePat of bar(f2:X f3:Y f4:Q)" # " then B = X if Z then D = Y else skip end else skip end" # " else skip end" caseStmt(varId('C') recordPat(atomExp(foo) [colonFld(atomExp(f1) recordPat(atomExp(bar) [colonFld(atomExp(f2) varIdPat('X')) colonFld(atomExp(f3) varIdPat('Y')) colonFld(atomExp(f4) varIdPat('Q'))]))]) seqStmt([unifyStmt(varId('B') varId('X')) ifStmt(varId('Z') unifyStmt(varId('D') varId('Y')) skipStmt)]) skipStmt) } {DSTest "{P}" applyStmt(varId('P') nil) } {DSTest "{Map Ls F}" applyStmt(varId('Map') [varId('Ls') varId('F')]) } {DSTest "local Unnest in Unnest = 3 {Browse Unnest} end" applyStmt(varId('Browse') [intLit(3)]) } {DSTest "local Unnest in" # " local Unnest1 in" # " Unnest1 = 3" # " local Unnest2 in" # " Unnest2 = nil" # " Unnest = '|'(1:Unnest1 2:Unnest2)" # " end" # " end" # " {Map Unnest F}" # " end" applyStmt(varId('Map') [recordExp(atomExp('|') [posFld(intLit(3)) posFld(atomExp(nil))]) varId('F')]) } {DSTest "local Unnest in" # " local Unnest1 in" # " Unnest1 = 3" # " local Unnest2 in" # " Unnest2 = nil" # " Unnest = '|'(1:Unnest1 2:Unnest2)" # " end" # " end" # " local Unnest1 in" # " Unnest1 = proc {$ X R} {Browse X} R = X end" # " {Map Unnest Unnest1}" # " end" # " end" applyStmt(varId('Map') [recordExp(atomExp('|') [posFld(intLit(3)) posFld(atomExp(nil))]) procExp([varIdPat('X') varIdPat('R')] seqStmt([applyStmt(varId('Browse') [varId('X')]) unifyStmt(varId('R') varId('X'))]))]) } {DSTest "Three = proc {$ R} R = 3 end" unifyStmt(varId('Three') procExp([varIdPat('R')] unifyStmt(varId('R') intLit(3)))) } {DSTest "Three = proc {$ Result} Result = 3 end" namedFunStmt('Three' nil intLit(3)) } {DSTest "Add = proc {$ X Y Result} {Plus X Y Result} end" namedFunStmt('Add' [varIdPat('X') varIdPat('Y')] applyExp(varId('Plus') [varId('X') varId('Y')])) } {DSTest "Add = proc {$ X Y Result} {Plus X X Z Result} end" namedFunStmt('Add' [varIdPat('X') varIdPat('Y')] applyExp(varId('Plus') [varId('X') varId('X') varId('Z')])) } {DSTest "F = proc {$ X Result} Result = proc {$ F R} {F A R} end end" namedFunStmt('F' [varIdPat('X')] procExp([varIdPat('F') varIdPat('R')] unifyStmt(varId('R') applyExp(varId('F') [varId('A')])))) } {DSTest "InTest = proc {$ Tree R}" # " local X in local Y in" # " Tree = node(1:X 2:Y) {Plus X Y R}" # " end end end" unifyStmt(varId('InTest') procExp([varIdPat('Tree') varIdPat('R')] inStmt(recordPat(atomExp(node) [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) varId('Tree') unifyStmt(varId('R') applyExp(varId('Plus') [varId('X') varId('Y')]))))) } {DSTest "local Unnest in" # " Unnest = noElse" # " {Exception.raise Unnest}" # " end" applyStmt(varId("Exception.raise") [atomExp('noElse')]) } {DSTest "local Unnest in local Unnest1 in" # " Unnest1 = noElse()" # " Unnest = kernel(1:Unnest1)" # " end" # " {Exception.raise Unnest}" # " end" applyStmt(varId("Exception.raise") [recordExp(atomExp('kernel') [posFld(recordExp(atomExp('noElse') nil))])]) } {DSTest "First = proc {$ ArgPat Result} case ArgPat of '#'(1:X 2:Y) then Result = X else local Unnest in Unnest = noElse {Exception.raise Unnest} end end end" namedFunStmt('First' [recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])] varId('X')) } {DSTest "RevPair = proc {$ ArgPat Result} case ArgPat of '#'(1:X 2:Y) then Result = '#'(1:Y 2:X) else local Unnest in Unnest = noElse {Exception.raise Unnest} end end end" namedFunStmt('RevPair' [recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])] recordExp(atomExp('#') [posFld(varId('Y')) posFld(varId('X'))])) } {DSTest "RevPair = proc {$ P Result} case P of '#'(1:X 2:Y) then Result = '#'(1:Y 2:X) else Result = error end end" namedFunStmt('RevPair' [varIdPat('P')] caseExp(varId('P') recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))]) recordExp(atomExp('#') [posFld(varId('Y')) posFld(varId('X'))]) atomExp(error))) } {DSTest "T = proc {$ N Result}" # " local Unnest in {Odd N Unnest}" # " if Unnest" # " then local Unnest1 in" # " local Unnest2 in" # " local Unnest3 in" # " Unnest3 = 3" # " {Mult Unnest3 N Unnest2}" # " end" # " local Unnest3 in" # " Unnest3 = 1" # " {Plus Unnest2 Unnest3 Unnest1}" # " end" # " end" # " local Unnest2 in" # " Unnest2 = 2" # " {Div Unnest1 Unnest2 Result}" # " end" # " end" # " else" # " local Unnest1 in" # " Unnest1 = 2" # " {Div N Unnest1 Result}" # " end" # " end" # " end" # " end" namedFunStmt('T' [varIdPat('N')] ifExp(applyExp(varId('Odd') [varId('N')]) applyExp(varId('Div') [applyExp(varId('Plus') [applyExp(varId('Mult') [intLit(3) varId('N')]) intLit(1)]) intLit(2)]) applyExp(varId('Div') [varId('N') intLit(2)]))) } local ParsedFigExample = % (Figure 2 of homework 3a) namedFunStmt('AddToEach' [recordPat(atomExp('#') [posFld(varIdPat('A')) posFld(varIdPat('B'))]) varIdPat('Ls')] caseExp(varId('Ls') recordPat(atomExp('|') [posFld(recordPat(atomExp('#') [posFld(varIdPat('X')) posFld(varIdPat('Y'))])) posFld(varIdPat('T'))]) recordExp(atomExp('|') [posFld(recordExp(atomExp('#') [posFld(applyExp(varId('Plus') [varId('A') varId('X')])) posFld(applyExp(varId('Plus') [varId('B') varId('Y')]))])) posFld(applyExp(varId('AddToEach') [recordExp(atomExp('#') [posFld(varId('A')) posFld(varId('B'))]) varId('T')]))]) atomExp(nil))) in {DSTest "AddToEach = proc {$ ArgPat Ls Result}" # " case ArgPat of '#'(1:A 2:B) then" # " case Ls of '|'(1:CasePat 2:T) then" # " case CasePat of '#'(1:X 2:Y) then" # " local Unnest in" # " local Unnest1 in" # " {Plus A X Unnest1}" # " local Unnest2 in" # " {Plus B Y Unnest2}" # " Unnest = '#'(1:Unnest1 2:Unnest2)" # " end" # " end" # " local Unnest1 in" # " local Unnest2 in" # " Unnest2 = '#'(1:A 2:B)" # " {AddToEach Unnest2 T Unnest1}" # " end" # " Result = '|'(1:Unnest 2:Unnest1)" # " end" # " end" # " else" # " Result = nil" # " end" # " else Result = nil" # " end" # " else local Unnest in Unnest = noElse {Exception.raise Unnest} end" # " end" # " end" ParsedFigExample } end {DSTest "thread skip end" threadStmt(skipStmt)} {DSTest "thread local Unnest in Unnest = 3 local X in Unnest = X {P X} end end end" threadStmt(inStmt(varIdPat('X') intLit(3) applyStmt(varId('P') [varId('X')])))} {DSTest "thread X = 7 end" unifyStmt(varId('X') threadExp(intLit(7)))} {DSTest "local Unnest in thread Unnest = 7 end {P Unnest} end" applyStmt(varId('P') [threadExp(intLit(7))])} {DoneTesting}