(* ast-pp.sml * * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu) * * COPYRIGHT (c) 2015 The University of Chicago * All rights reserved. * * Pretty printing for the AST representation. *) structure ASTPP : sig val output : TextIO.outstream * AST.program -> unit end = struct structure PP = TextIOPP structure TU = TypeUtil val indent = PP.Abs 2 fun ppList ppFn (left, sep, right) (ppStrm, list) = let fun sp () = PP.space ppStrm 1 val string = PP.string ppStrm fun pp [] = string right | pp [x] = (ppFn(ppStrm, x); string right) | pp (x::xs) = (ppFn(ppStrm, x); string sep; sp(); pp xs) in string left; pp list end (* print type arguments; we use "#" to denote differentiation arguments, "$" to denote * shape arguments, and "%" to denote dimension arguments. *) fun ppTyArgs (ppStrm, mvs) = let val string = PP.string ppStrm fun ppTyArg (_, mv) = (case mv of Types.TYPE tv => string(TU.toString(TU.resolve tv)) | Types.DIFF dv => string("#"^TU.diffToString(TU.resolveDiff dv)) | Types.SHAPE sv => string("$"^TU.shapeToString(TU.resolveShape sv)) | Types.DIM dv => string("%"^TU.dimToString(TU.resolveDim dv)) (* end case *)) in ppList ppTyArg ("<", ";", ">") (ppStrm, mvs) end fun ppExp (ppStrm, e) = let fun sp () = PP.space ppStrm 1 val string = PP.string ppStrm fun var x = string(Var.nameOf x) fun ppIndex (ppStrm, NONE) = PP.string ppStrm ":" | ppIndex (ppStrm, SOME e) = ppExp (ppStrm, e) fun pp e = (case e of AST.E_Var x => var x | AST.E_Lit lit => string (Literal.toString lit) | AST.E_Tuple es => ppArgs (ppStrm, es) | AST.E_Apply(f, [], args, _) => (var f; sp(); ppArgs (ppStrm, args)) | AST.E_Apply(f, mvs, args, _) => ( var f; ppTyArgs (ppStrm, mvs); sp(); ppArgs (ppStrm, args)) | AST.E_Cons es => ( ppList ppExp ("[", ",", "]") (ppStrm, es)) | AST.E_Seq es => ( ppList ppExp ("{", ",", "}") (ppStrm, es)) | AST.E_Slice(e, indices, _) => ( pp e; ppList ppIndex ("[", ",", "]") (ppStrm, indices)) | AST.E_Cond(e1, e2, e3, _) => ( pp e2; sp(); string "if"; sp(); pp e1; sp(); string "else"; sp(); pp e3) | AST.E_LoadNrrd(mvs, name, ty) => ( case TU.pruneHead ty of Types.T_Image _ => string "loadImage" | _ => raise Fail "impossible" (* end case *); ppTyArgs (ppStrm, mvs); sp(); string(concat["(\"", name, "\")"])) | AST.E_Coerce{dstTy, e, ...} => ( PP.openHBox ppStrm; string "("; string(TU.toString dstTy); string ")"; PP.closeBox ppStrm; case e of AST.E_Var _ => pp e | AST.E_Lit _ => pp e | AST.E_Tuple _ => pp e | AST.E_Cons _ => pp e | AST.E_Seq _ => pp e | _ => (string "("; pp e; string ")") (* end case *)) (* end case *)) in pp e end and ppArgs (ppStrm, args) = ppList ppExp ("(", ",", ")") (ppStrm, args) fun ppVarDecl ppStrm (AST.VD_Decl(x, e)) = let fun sp () = PP.space ppStrm 1 val string = PP.string ppStrm in PP.openHBox ppStrm; case Var.kindOf x of AST.InputVar => (string "input"; sp()) | AST.StrandOutputVar => (string "output"; sp()) | _ => () (* end case *); string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x); sp(); string "="; sp(); ppExp(ppStrm, e); string ";"; PP.closeBox ppStrm end fun ppBlock (ppStrm, stms) = let fun sp () = PP.space ppStrm 1 fun nl () = PP.newline ppStrm val string = PP.string ppStrm fun var x = string(Var.nameOf x) fun ppStmt stmt = (case stmt of AST.S_Block stms => ppBlock (ppStrm, stms) | AST.S_Decl vdcl => (ppVarDecl ppStrm vdcl; nl()) | AST.S_IfThenElse(e, AST.S_Block stms, AST.S_Block[]) => ( PP.openHBox ppStrm; string "if"; sp(); ppExp(ppStrm, e); sp(); ppBlock (ppStrm, stms); PP.closeBox ppStrm) | AST.S_IfThenElse(e, s1, AST.S_Block[]) => ( PP.openVBox ppStrm indent; PP.openHBox ppStrm; string "if"; sp(); ppExp(ppStrm, e); PP.closeBox ppStrm; nl(); ppStmt s1; PP.closeBox ppStrm; nl()) | AST.S_IfThenElse(e, AST.S_Block stms1, AST.S_Block stms2) => ( PP.openHBox ppStrm; string "if"; sp(); ppExp(ppStrm, e); sp(); ppBlock (ppStrm, stms1); PP.closeBox ppStrm; PP.openHBox ppStrm; string "else"; sp(); ppBlock (ppStrm, stms2); PP.closeBox ppStrm) | AST.S_IfThenElse(e, AST.S_Block stms1, s2) => ( PP.openHBox ppStrm; string "if"; sp(); ppExp(ppStrm, e); sp(); ppBlock (ppStrm, stms1); PP.closeBox ppStrm; string "else"; PP.openVBox ppStrm indent; nl(); ppStmt s2; PP.closeBox ppStrm) | AST.S_IfThenElse(e, s1, AST.S_Block stms2) => raise Fail "FIXME" | AST.S_IfThenElse(e, s1, s2) => ( PP.openVBox ppStrm indent; PP.openHBox ppStrm; string "if"; sp(); ppExp(ppStrm, e); PP.closeBox ppStrm; nl(); ppStmt s1; PP.closeBox ppStrm; nl(); PP.openVBox ppStrm indent; string "else"; nl(); ppStmt s2; PP.closeBox ppStrm; nl()) | AST.S_Assign(x, e) => ( PP.openHBox ppStrm; var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";"; PP.closeBox ppStrm; nl()) | AST.S_New(strand, args) => ( PP.openHBox ppStrm; string "new"; sp(); string(Atom.toString strand); sp(); ppArgs (ppStrm, args); string ";"; PP.closeBox ppStrm; nl()) | AST.S_Die => (string "die;"; nl()) | AST.S_Stabilize => (string "stabilize;"; nl()) | AST.S_Return e => ( PP.openHBox ppStrm; string "return"; sp(); ppExp(ppStrm, e); string ";"; PP.closeBox ppStrm; nl()) | AST.S_Print args => ( PP.openHBox ppStrm; string "print"; sp(); ppArgs (ppStrm, args); string ";"; PP.closeBox ppStrm; nl()) (* end case *)) in PP.openVBox ppStrm (PP.Abs 0); string "{"; nl(); PP.openVBox ppStrm indent; List.app ppStmt stms; PP.closeBox ppStrm; string "}"; nl(); PP.closeBox ppStrm end fun ppParams (ppStrm, params) = let fun sp () = PP.space ppStrm 1 val string = PP.string ppStrm in ppList (fn (_, x) => (string(TU.toString(#2(Var.typeOf x))); sp(); string(Var.nameOf x))) ("(", ",", ")") (ppStrm, params) end fun ppStrand (ppStrm, AST.Strand{name, params, state, methods}) = let fun sp () = PP.space ppStrm 1 fun nl () = PP.newline ppStrm val string = PP.string ppStrm fun var x = string(Var.nameOf x) fun ppMethod (AST.M_Method(name, AST.S_Block stms)) = ( nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, stms)) | ppMethod (AST.M_Method(name, stm)) = ( nl(); string(StrandUtil.nameToString name); nl(); ppBlock (ppStrm, [stm])) in PP.openHBox ppStrm; string "strand"; sp(); string(Atom.toString name); sp(); ppParams (ppStrm, params); PP.closeBox ppStrm; nl(); PP.openVBox ppStrm indent; string "{"; List.app (fn vdcl => (nl(); ppVarDecl ppStrm vdcl)) state; List.app ppMethod methods; PP.closeBox ppStrm; nl(); string "}"; nl() end fun ppDecl ppStrm = let fun sp () = PP.space ppStrm 1 fun nl () = PP.newline ppStrm val string = PP.string ppStrm fun var x = string(Var.nameOf x) fun ppDesc NONE = () | ppDesc (SOME desc) = ( string(concat["(\"", String.toString desc, "\")"]); sp()) in fn AST.D_Input(x, desc, NONE) => ( PP.openHBox ppStrm; string "input"; sp(); ppDesc desc; string(TU.toString(#2(Var.typeOf x))); sp(); var x; string ";"; PP.closeBox ppStrm; nl()) | AST.D_Input(x, desc, SOME e) => ( PP.openHBox ppStrm; string "input"; sp(); ppDesc desc; string(TU.toString(#2(Var.typeOf x))); sp(); var x; sp(); string "="; sp(); ppExp(ppStrm, e); string ";"; PP.closeBox ppStrm; nl()) | AST.D_Var vdcl => (ppVarDecl ppStrm vdcl; nl()) | AST.D_Func(f, params, body) => ( PP.openHBox ppStrm; string "function"; sp(); string(TU.toString(TU.rngOf(Var.monoTypeOf f))); sp(); var f; sp(); ppParams (ppStrm, params); PP.closeBox ppStrm; nl(); case body of AST.S_Block stms => ppBlock (ppStrm, stms) | stm => ppBlock (ppStrm, [stm]) (* end case *)) | AST.D_Strand def => ppStrand (ppStrm, def) | AST.D_InitialArray(create, iters) => (* FIXME *) () | AST.D_InitialCollection(create, iters) => (* FIXME *) () end fun output (outS, AST.Program{props, decls}) = let val ppStrm = PP.openOut {dst = outS, wid = 120} in PP.openVBox ppStrm (PP.Abs 0); PP.string ppStrm "/* Program start */"; PP.newline ppStrm; PP.openHBox ppStrm; PP.string ppStrm "properties:"; PP.space ppStrm 1; PP.string ppStrm (StrandUtil.propsToString props); PP.newline ppStrm; PP.closeBox ppStrm; List.app (ppDecl ppStrm) decls; PP.string ppStrm "/* Program end */"; PP.newline ppStrm; PP.closeBox ppStrm; PP.closeStream ppStrm end end