Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /smlnj-lib/trunk/SExp/sexp-pp.sml
ViewVC logotype

View of /smlnj-lib/trunk/SExp/sexp-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4685 - (download) (annotate)
Mon Aug 20 16:45:33 2018 UTC (9 months ago) by jhr
File size: 1274 byte(s)
  Added SExp pretty printer, plus a bug fix
(* sexp-pp.sml
 *
 * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *
 * A pretty printer for SExp values.
 *)

structure SExpPP : sig

    val output : TextIOPP.stream * SExp.value -> unit

  end = struct

    structure S = SExp
    structure PP = TextIOPP
    structure F = Format

    fun output (strm, sexp) = let
	  val str = PP.string strm
	  fun sp () = PP.space strm 1
	  fun ppList [] = str "()"
	    | ppList [v] = (
		PP.openHBox strm;
		  str "("; ppVal v; str ")";
		PP.closeBox strm)
	    | ppList (v1::v2::vr) = (
		PP.openHBox strm;
		  str "("; ppVal v1; sp();
		  PP.openHOVBox strm (PP.Rel 0);
		    ppVal v2;
		    List.app (fn v => (sp(); ppVal v)) vr;
		    str ")";
		  PP.closeBox strm;
		PP.closeBox strm)
	  and ppVal (S.LIST value) = ppList (value)
	    | ppVal (S.SYMBOL value) = str (Atom.toString value)
	    | ppVal (S.BOOL value) = str (if value then "#t" else "#f")
	    | ppVal (S.INT value) = str (F.format "%d" [F.LINT value])
	    | ppVal (S.FLOAT value) = str (F.format "%g" [F.REAL value])
	    | ppVal (S.STRING value) = str (concat ["\"", String.toString value, "\""])
	  in
	    PP.openVBox strm (PP.Abs 0);
	      ppVal sexp;
	      PP.newline strm;
	    PP.closeBox strm
	  end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0