X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/dac62e84b324d2187ec9b9882efa47125d5599a4..cd04086681583dd3fcc95b6e12ba312054dc590e:/src/print.sml diff --git a/src/print.sml b/src/print.sml dissimilarity index 78% index 9305714..eb7421d 100644 --- a/src/print.sml +++ b/src/print.sml @@ -1,132 +1,49 @@ -(* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006, Adam Chlipala - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - *) - -(* Pretty-printing Domtool configuration file ASTs *) - -structure Print :> PRINT = struct - -open Ast - -structure SM = TextIOPP - -structure PD = PPDescFn(SM) -open PD - -fun dBox ds = hovBox (PPS.Rel 1, ds) -fun dvBox ds = vBox (PPS.Rel 0, ds) -fun ivBox ds = vBox (PPS.Rel 1, ds) - -fun parenIf pn ds = - if pn then - dBox (string "(" :: ds @ [string ")"]) - else - dBox ds - -fun p_pred' pn (p, _) = - case p of - CRoot => string "Root" - | CConst s => string s - | CPrefix p => dBox [string "^", p_pred' true p] - | CNot p => dBox [string "!", p_pred' true p] - | CAnd (p1, p2) => - parenIf pn [p_pred' true p1, space 1, string "&", space 1, p_pred' true p2] - -val p_pred = p_pred' false - -fun p_predBoxed p = dBox [string "[", p_pred p, string "]"] - -fun p_typ' pn (t, _) = - case t of - TBase s => string s - | TList t => dBox [string "[", p_typ' false t, string "]"] - | TArrow (t1, t2) => - parenIf pn [p_typ' true t1, space 1, string "->", space 1, p_typ' true t2] - | TAction (p, r1, r2) => - parenIf pn [p_predBoxed p, space 1, p_record r1, space 1, - string "=>", space 1, p_record r2] - | TNested (p, t) => - parenIf pn [p_pred' false p, space 1, string "=>", space 1, p_typ' false t] - - | TError => string "" - | TUnif (_, ref (SOME t)) => p_typ' pn t - | TUnif (name, ref NONE) => string ("<" ^ name ^ ">") - -and p_record r = - case StringMap.foldri (fn (name, t, d) => - SOME (case d of - NONE => dBox [string name, space 1, - string ":", space 1, p_typ t] - | SOME d => dBox [dBox [string name, space 1, - string ":", space 1, p_typ t], - string ",", space 1, d])) - NONE r of - NONE => string "{}" - | SOME d => dBox [string "{", d, string "}"] - -and p_typ t = p_typ' false t - -fun p_exp (e, _) = - case e of - EInt n => string (Int.toString n) - | EString s => string (String.concat ["\"", String.toString s, "\""]) - | EList es => - (case foldr (fn (e, d) => - SOME (case d of - NONE => p_exp e - | SOME d => dBox [p_exp e, string ",", space 1, d])) - NONE es of - NONE => string "[]" - | SOME d => dBox [string "[", d, string "]"]) - - | ELam (x, NONE, e) => dBox [string "(\\", space 1, string x, space 1, - string "->", space 1, p_exp e, string ")"] - | ELam (x, SOME t, e) => dBox [string "(\\", space 1, string x, space 1, - string ":", space 1, - dBox [string "(", p_typ t, string ")"], - space 1, string "->", space 1, p_exp e, string ")"] - - | EVar x => string x - | EApp (e1, e2) => dBox [string "(", p_exp e1, break {nsp = 1, offset = 0}, p_exp e2, string ")"] - - | ESkip => string "_" - | ESet (x, e) => dBox [string x, space 1, string "=", space 1, p_exp e] - | EGet (x1, x2, e) => dBox [dBox [string x1, space 1, string "<-", - space 1, string x2, string ";", space 1], - p_exp e] - | ESeq es => dBox (valOf (foldr (fn (e, NONE) => SOME [p_exp e] - | (e, SOME ds) => SOME (dBox [p_exp e, string ";", space 1] :: ds)) - NONE es)) - | ELocal (e1, e2) => dBox [string "let", space 1, - p_exp e1, space 1, - string "in", space 1, - p_exp e2, space 1, - string "end"] - | EWith (e1, (ESkip, _)) => dBox [p_exp e1, space 1, string "with", space 1, string "end"] - | EWith (e1, e2) => dBox [p_exp e1, space 1, string "with", p_exp e2, space 1, string "end"] - -fun printd d = - let - val myStream = SM.openOut {dst = TextIO.stdOut, - wid = 80} - in - description (myStream, d); - SM.newline myStream; - SM.closeStream myStream - end - -end +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, Adam Chlipala + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +(* Pretty-printing Domtool configuration file ASTs *) + +signature PRINT_ARG = PRINTFN_INPUT where type rendering = unit + +structure PrintArg :> PRINT_ARG = struct + +structure SM = TextIOPP + +structure PD = PPDescFn(SM) +open PD + +val keyword = string +val punct = string +val field = string +val lit = string +val ident = string + +val context = string +val typ = string +val exp = string + +fun anchor (_, d) = d +fun link (_, d) = d + +type rendering = unit +fun openStream () = SM.openOut {dst = TextIO.stdOut, wid = 80} +fun closeStream s = (SM.newline s; SM.closeStream s) + +end + +structure Print = PrintFn(PrintArg)