% $Id: Unparse.oz,v 1.20 2012/01/17 11:50:53 leavens Exp leavens $ % Unparser for a subset of Oz % AUTHOR: Gary T. Leavens \insert 'SeparatedBy.oz' \insert 'Position.oz' \insert 'AtomStringRep.oz' declare fun {UnparseToString Prog} %% ENSURES: Result is a string representing Prog {VirtualString.toString {Unparse Prog}} end fun {Unparse Prog} %% ENSURES: Result is a virtual string representing Prog case Prog of program(Qs ...) then {BlankSeparate {Map Qs UnparseQuery}} [] parseError(coord: POS) then "Parse-Error at "#{PositionMsg POS} [] parseError then "Parse-Error!" end end fun {UnparseQuery Q} %% ENSURES: Result is a virtual string representing the given query case Q of seqQuery(Stmt ...) then {UnparseStmt Stmt} [] declareInQuery(Stmt1 Stmt2 ...) then "declare "#{UnparseStmt Stmt1}#" in "#{UnparseStmt Stmt2} [] declareQuery(Stmt ...) then "declare "#{UnparseStmt Stmt} end end fun {UnparseStmt Stmt} %% ENSURES: Result is a virtual string representing Stmt case Stmt of skipStmt then "skip" [] skipStmt(...) then "skip" [] seqStmt(StmtList ...) then {BlankSeparate {Map StmtList UnparseStmt}} [] localStmt(varId(V ...) Body ...) then {BlankSeparate ["local" V "in" {UnparseStmt Body} "end"]} [] unifyStmt(varId(V ...) Exp ...) then V # " = " # {UnparseExp Exp} [] ifStmt(TestExp S1 S2 ...) then {BlankSeparate ["if" {UnparseExp TestExp} "then" {UnparseStmt S1} "else" {UnparseStmt S2} "end"]} [] caseStmt(Exp Pattern S1 S2 ...) then {BlankSeparate ["case" {UnparseExp Exp} "of" {UnparsePattern Pattern} "then" {UnparseStmt S1} "else" {UnparseStmt S2} "end"]} [] applyStmt(ProcExp ArgExpList ...) then {UnparseApply ProcExp ArgExpList} [] threadStmt(S ...) then {BlankSeparate ["thread" {UnparseStmt S} "end"]} [] namedFunStmt(Name Formals Body ...) then {UnparseF "fun" Name Formals {UnparseExp Body}} [] inStmt(Pattern Exp Body ...) then {BlankSeparate [{UnparsePattern Pattern} "=" {UnparseExp Exp} "in" {UnparseStmt Body}]} end end fun {UnparseBool B} if B then "true" else "false" end end fun {UnparseExp Exp} %% ENSURES: Result is a virtual string representing Exp case Exp of varId(V ...) then V [] atomExp(A ...) then {UnparseAtom A} [] boolExp(B ...) then {UnparseBool B} [] intLit(N ...) then {IntToString N} [] floatLit(N ...) then {FloatToString N} [] recordExp(LabelExp FieldList ...) then {UnparseRecord {UnparseExp LabelExp} FieldList} [] procExp(Formals Body ...) then {UnparseF "proc" '$' Formals {UnparseStmt Body}} [] ifExp(TestExp E1 E2 ...) then {BlankSeparate ["if" {UnparseExp TestExp} "then" {UnparseExp E1} "else" {UnparseExp E2} "end"]} [] caseExp(Exp Pattern E1 E2 ...) then {BlankSeparate ["case" {UnparseExp Exp} "of" {UnparsePattern Pattern} "then" {UnparseExp E1} "else" {UnparseExp E2} "end"]} [] threadExp(E ...) then {BlankSeparate ["thread" {UnparseExp E} "end"]} [] applyExp(FunExp ArgExpList ...) then {UnparseApply FunExp ArgExpList} end end fun {UnparseAtom A} %% ENSURES: Result is a virtual string for the atom A {AtomStringRep A} end fun {UnparsePattern Pat} %% ENSURES: Result is a virtual string representing Pat case Pat of varIdPat(V ...) then V [] atomPat(A ...) then {UnparseAtom A} [] boolPat(B ...) then if B then "true" else "false" end [] recordPat(atomExp(Atom ...) FieldList ...) then {UnparseRecordPat Atom FieldList} end end fun {UnparseRecordPat Label FieldList} %% ENSURES: Result is a virtual string representing a record pattern {UnparseLabel Label} # "(" # {BlankSeparate {List.mapInd FieldList UnparseFieldPat}} # ")" end fun {UnparseFieldPat Index Field} %% ENSURES: Result is a virtual string representing Field case Field of colonFld(Feat Pat ...) then {UnparseFeature Feat} # ":" # {UnparsePattern Pat} [] posFld(Pat ...) then {IntToString Index} # ":" # {UnparsePattern Pat} end end fun {UnparseField Index Field} %% ENSURES: Result is a virtual string representing Field case Field of colonFld(Feat Exp ...) then {UnparseFeature Feat} # ":" # {UnparseExp Exp} [] posFld(Exp ...) then {Value.toVirtualString Index 3 3} # ":" # {UnparseExp Exp} end end fun {UnparseFeature Feat} %% ENSURES: Result is a virtual string corresponding to Feat case Feat of atomExp(A ...) then {UnparseAtom A} [] intLit(I ...) then {IntToString I} [] boolExp(B ...) then {UnparseBool B} end end fun {BlankSeparate LoVS} %% ENSURES: Result is a virtual string corresponding %% to the list of virtual strings LoStr, with elements separated by blanks case LoVS of nil then "" [] S|Rest then S # {FoldR Rest fun {$ Str VSforRest} " " # Str # VSforRest end ""} end end % Common code for unparsing functions and procedures. fun {UnparseF Type Name Formals UnparsedBody} %% ENSURES: Result is a virtual string representing a fun or proc local Nm in Nm = if {IsAtom Name} then {AtomToString Name} else Name end Type # " {" # Nm # (if Formals == nil then "" else " " end) # {BlankSeparate {Map Formals UnparsePattern}} # "} " # UnparsedBody # " end" end end % Common code for unparsing apply statements and expressions fun {UnparseApply FE ArgExpList} %% ENSURES: Result is a virtual string representing FE applied to ArgExpList "{" # {UnparseExp FE} # (if ArgExpList == nil then "" else " " end) # {BlankSeparate {Map ArgExpList UnparseExp}} # "}" end fun {UnparseLabel Label} case Label of atomExp(A ...) then {UnparseAtom A} [] atomPat(A ...) then {UnparseAtom A} [] A andthen {IsAtom A} then {UnparseAtom A} else Label end end fun {UnparseRecord Label FieldList} %% ENSURES: Result is a virtual string representing a record expression {UnparseLabel Label} # "(" # {BlankSeparate {List.mapInd FieldList UnparseField}} # ")" end % the following uses sugars for # and |, but is unused above fun {UnparseRecordWithSugars Label FieldList} %% ENSURES: Result is a virtual string representing a record expression if (Label == "|" orelse Label == "#") andthen {Length FieldList} == 2 andthen {All FieldList fun {$ F} case F of posFld(_) then true else false end end} then {UnparseExp FieldList.1.1} # Label # {UnparseExp FieldList.2.1.1} else {UnparseRecord Label FieldList} end end