adamc@1: (* Copyright (c) 2008, Adam Chlipala adamc@1: * All rights reserved. adamc@1: * adamc@1: * Redistribution and use in source and binary forms, with or without adamc@1: * modification, are permitted provided that the following conditions are met: adamc@1: * adamc@1: * - Redistributions of source code must retain the above copyright notice, adamc@1: * this list of conditions and the following disclaimer. adamc@1: * - Redistributions in binary form must reproduce the above copyright notice, adamc@1: * this list of conditions and the following disclaimer in the documentation adamc@1: * and/or other materials provided with the distribution. adamc@1: * - The names of contributors may not be used to endorse or promote products adamc@1: * derived from this software without specific prior written permission. adamc@1: * adamc@1: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@1: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@1: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@1: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adamc@1: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@1: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@1: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@1: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@1: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@1: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@1: * POSSIBILITY OF SUCH DAMAGE. adamc@1: *) adamc@1: adamc@1: (* Pretty-printing Laconic/Web *) adamc@1: adamc@4: structure SourcePrint :> SOURCE_PRINT = struct adamc@1: adamc@1: open Print.PD adamc@1: open Print adamc@1: adamc@4: open Source adamc@1: adamc@1: fun p_kind' par (k, _) = adamc@1: case k of adamc@1: KType => string "Type" adamc@1: | KArrow (k1, k2) => parenIf par (box [p_kind' true k1, adamc@1: space, adamc@1: string "->", adamc@1: space, adamc@1: p_kind k2]) adamc@1: | KName => string "Name" adamc@1: | KRecord k => box [string "{", p_kind k, string "}"] adamc@1: adamc@1: and p_kind k = p_kind' false k adamc@1: adamc@1: fun p_explicitness e = adamc@1: case e of adamc@1: Explicit => string "::" adamc@1: | Implicit => string ":::" adamc@1: adamc@1: fun p_con' par (c, _) = adamc@1: case c of adamc@1: CAnnot (c, k) => box [string "(", adamc@1: p_con c, adamc@1: space, adamc@1: string "::", adamc@1: space, adamc@1: p_kind k, adamc@1: string ")"] adamc@1: adamc@1: | TFun (t1, t2) => parenIf par (box [p_con' true t1, adamc@1: space, adamc@1: string "->", adamc@1: space, adamc@1: p_con t2]) adamc@1: | TCFun (e, x, k, c) => parenIf par (box [string x, adamc@1: space, adamc@1: p_explicitness e, adamc@1: space, adamc@1: p_kind k, adamc@1: space, adamc@1: string "->", adamc@1: space, adamc@1: p_con c]) adamc@1: | TRecord (CRecord xcs, _) => box [string "{", adamc@1: p_list (fn (x, c) => adamc@1: box [p_con x, adamc@1: space, adamc@1: string ":", adamc@1: space, adamc@1: p_con c]) xcs, adamc@1: string "}"] adamc@1: | TRecord c => box [string "$", adamc@1: p_con' true c] adamc@1: adamc@1: | CVar s => string s adamc@1: | CApp (c1, c2) => parenIf par (box [p_con c1, adamc@1: space, adamc@1: p_con' true c2]) adamc@8: | CAbs (x, k, c) => parenIf par (box [string "fn", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: string "::", adamc@8: space, adamc@8: p_kind k, adamc@8: space, adamc@8: string "=>", adamc@8: space, adamc@8: p_con c]) adamc@1: adamc@1: | CName s => box [string "#", string s] adamc@1: adamc@1: | CRecord xcs => box [string "[", adamc@1: p_list (fn (x, c) => adamc@1: box [p_con x, adamc@1: space, adamc@1: string "=", adamc@1: space, adamc@1: p_con c]) xcs, adamc@1: string "]"] adamc@1: | CConcat (c1, c2) => parenIf par (box [p_con' true c1, adamc@1: space, adamc@1: string "++", adamc@1: space, adamc@1: p_con c2]) adamc@1: adamc@1: and p_con c = p_con' false c adamc@1: adamc@8: fun p_exp' par (e, _) = adamc@8: case e of adamc@8: EAnnot (e, t) => box [string "(", adamc@8: p_exp e, adamc@8: space, adamc@8: string ":", adamc@8: space, adamc@8: p_con t, adamc@8: string ")"] adamc@8: adamc@14: | EPrim p => Prim.p_t p adamc@8: | EVar s => string s adamc@8: | EApp (e1, e2) => parenIf par (box [p_exp e1, adamc@8: space, adamc@8: p_exp' true e2]) adamc@8: | EAbs (x, NONE, e) => parenIf par (box [string "fn", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: string "=>", adamc@8: space, adamc@8: p_exp e]) adamc@8: | EAbs (x, SOME t, e) => parenIf par (box [string "fn", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: string ":", adamc@8: space, adamc@8: p_con t, adamc@8: space, adamc@8: string "=>", adamc@8: space, adamc@8: p_exp e]) adamc@8: | ECApp (e, c) => parenIf par (box [p_exp e, adamc@8: space, adamc@8: string "[", adamc@8: p_con c, adamc@8: string "]"]) adamc@8: | ECAbs (exp, x, k, e) => parenIf par (box [string "fn", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: p_explicitness exp, adamc@8: space, adamc@8: p_kind k, adamc@8: space, adamc@8: string "=>", adamc@8: space, adamc@8: p_exp e]) adamc@8: adamc@12: | ERecord xes => box [string "{", adamc@12: p_list (fn (x, e) => adamc@12: box [p_con x, adamc@12: space, adamc@12: string "=", adamc@12: space, adamc@12: p_exp e]) xes, adamc@12: string "}"] adamc@12: | EField (e, c) => box [p_exp' true e, adamc@12: string ".", adamc@12: p_con' true c] adamc@12: adamc@12: adamc@8: and p_exp e = p_exp' false e adamc@8: adamc@1: fun p_decl ((d, _) : decl) = adamc@1: case d of adamc@1: DCon (x, NONE, c) => box [string "con", adamc@1: space, adamc@1: string x, adamc@1: space, adamc@1: string "=", adamc@1: space, adamc@1: p_con c] adamc@1: | DCon (x, SOME k, c) => box [string "con", adamc@1: space, adamc@1: string x, adamc@1: space, adamc@1: string "::", adamc@1: space, adamc@1: p_kind k, adamc@1: space, adamc@1: string "=", adamc@1: space, adamc@1: p_con c] adamc@8: | DVal (x, NONE, e) => box [string "val", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: string "=", adamc@8: space, adamc@8: p_exp e] adamc@8: | DVal (x, SOME t, e) => box [string "val", adamc@8: space, adamc@8: string x, adamc@8: space, adamc@8: string ":", adamc@8: space, adamc@8: p_con t, adamc@8: space, adamc@8: string "=", adamc@8: space, adamc@8: p_exp e] adamc@1: adamc@1: val p_file = p_list_sep newline p_decl adamc@1: adamc@1: end