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@1:       | CAbs (e, x, k, c) => parenIf par (box [string "fn",
adamc@1:                                                space,
adamc@1:                                                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: 
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@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@1: 
adamc@1: val p_file = p_list_sep newline p_decl
adamc@1: 
adamc@1: end