Home My Page Projects Code Snippets Project Openings SML/NJ Bugs
Summary Activity Tracker Lists

[#274] Minor pretty printing glitch when printing structure specs

Date:
2020-10-18 17:20
Priority:
3
State:
Closed
Submitted by:
John Reppy (jhr)
Assigned to:
David MacQueen (dbm)
Machine Architecture:
All
Operating System:
All
Component:
Compiler
Resolution:
Fixed
Severity:
Cosmetic
OS Version:
SML/NJ Version:
110.98.1
Keywords:
Pretty printing
URL:
Transcript (of reproduction):
% sml lr0-items.sml Standard ML of New Jersey (64-bit) v110.98.1 [built: Tue Aug 25 16:59:36 2020] [opening lr0-items.sml] [autoloading] ... structure CanonicalSets : sig type t = (int * ?.ItemSet.Set.set) list val items : GrammarRep.t -> t val dump : GrammarRep.t -> t -> unit end structure Ex0 : sig val g : GrammarRep.t val cset : CanonicalSets.t end structure Ex1 : sig val g : GrammarRep.t val cset : CanonicalSets.t end -
Source (for reproduction):
(* lr0-items.sml * * COPYRIGHT (c) 2020 John Reppy (http://cs.uchicago.edu/~jhr) * All rights reserved. * * Compute the LR(0) items for a grammar. *) structure Token : sig eqtype t val token : string -> t val toString : t -> string val compare : t * t -> order structure Set : ORD_SET where type Key.ord_key = t end = struct datatype t = T of string val token = T fun toString (T t) = concat["\"", t, "\""] fun compare (T t1, T t2) = String.compare (t1, t2) structure Set = RedBlackSetFn ( struct type ord_key = t val compare = compare end) end structure Nonterm : sig eqtype t val nterm : string -> t val toString : t -> string val compare : t * t -> order structure Set : ORD_SET where type Key.ord_key = t structure Map : ORD_MAP where type Key.ord_key = t end = struct datatype t = NT of string val nterm = NT fun toString (NT t) = t fun compare (NT t1, NT t2) = String.compare (t1, t2) structure Set = RedBlackSetFn ( struct type ord_key = t val compare = compare end) structure Map = RedBlackMapFn ( struct type ord_key = t val compare = compare end) end structure GrammarRep : sig type token = Token.t type nterm = Nonterm.t datatype sym = TOK of token | NT of nterm type prod = nterm * sym list eqtype prod_id val compareId : prod_id * prod_id -> order type t val symToString : sym -> string val sameSym : sym * sym -> bool val make : prod list -> t val symbolsOf : t -> sym list val startOf : t -> nterm val prodOf : t -> prod_id -> prod val prodsOfNT : t -> nterm -> prod_id list end = struct structure TSet = Token.Set structure NSet = Nonterm.Set structure NMap = Nonterm.Map type token = Token.t type nterm = Nonterm.t datatype sym = TOK of token | NT of nterm type prod = nterm * sym list type prod_id = int val compareId = Int.compare datatype t = G of { nterms : nterm list, terms : token list, start : nterm, prods : prod vector, prodMap : nterm -> int list } fun sameSym (TOK t1, TOK t2) = (t1 = t2) | sameSym (NT nt1, NT nt2) = (nt1 = nt2) | sameSym _ = false fun symToString (TOK t) = Token.toString t | symToString (NT nt) = Nonterm.toString nt fun make (prods as (S', [NT S]) :: _) = let (* collect non terminals and terminals *) val (nts, toks, pMap) = let fun gather (pId, (lhs, rhs), (nts, toks, pMap)) = let val pMap = (case NMap.find(pMap, lhs) of SOME prods => NMap.insert(pMap, lhs, pId::prods) | NONE => NMap.insert(pMap, lhs, [pId]) (* end case *)) fun doSym (TOK tok, (nts, toks)) = (nts, TSet.add(toks, tok)) | doSym (NT nt, (nts, toks)) = (NSet.add(nts, nt), toks) val (nts, toks) = List.foldl doSym (NSet.add(nts, lhs), toks) rhs in (nts, toks, pMap) end in List.foldri gather (NSet.empty, TSet.empty, NMap.empty) prods end in G{ nterms = Nonterm.Set.toList nts, terms = Token.Set.toList toks, start = S', prods = Vector.fromList prods, prodMap = fn nt => NMap.lookup(pMap, nt) } end | make _ = raise Match fun symbolsOf (G{nterms, terms, ...}) = List.foldr (fn (tok, syms) => TOK tok :: syms) (List.map NT nterms) terms fun startOf (G{start, ...}) = start fun prodOf (G{prods, ...}) id = Vector.sub(prods, id) fun prodsOfNT (G{prodMap, ...}) = prodMap end structure Item : sig datatype t = ITEM of {pId : GrammarRep.prod_id, i : int} val compare : t * t -> order val toString : GrammarRep.t -> t -> string val initial : t end = struct local structure G = GrammarRep in datatype t = ITEM of {pId : G.prod_id, i : int} fun compare (ITEM itm1, ITEM itm2) = (case G.compareId(#pId itm1, #pId itm2) of EQUAL => Int.compare(#i itm1, #i itm2) | order => order (* end case *)) fun toString grm (ITEM{pId, i}) = let val (lhs, rhs) = G.prodOf grm pId val (prefix, suffix) = List.splitAt (rhs, i) in concat[ "[", Nonterm.toString lhs, " : ", String.concatWithMap " " G.symToString prefix, case (prefix, suffix) of ([], []) => "." | ([], _) => ". " | (_, []) => " ." | _ => " . " (* end case *), String.concatWithMap " " G.symToString suffix, "]" ] end val initial = ITEM{pId=0, i=0} end (* local *) end structure ItemSet = struct local structure G = GrammarRep structure Set = RedBlackSetFn ( struct type ord_key = Item.t val compare = Item.compare end) datatype item = datatype Item.t in open Set type t = Set.set fun closure gram items = let val prodOf = G.prodOf gram val prodsOf = G.prodsOfNT gram fun clos (ITEM{pId, i}, items) = let val (_, rhs) = prodOf pId in case List.drop(rhs, i) of G.NT nt :: _ => List.foldl (fn (pId, items) => add(items, ITEM{pId=pId, i=0})) items (prodsOf nt) | _ => items (* end case *) end fun iterate items = let val n = numItems items val items = Set.foldl clos items items in if numItems items > n then iterate items else items end in iterate items end fun initial gram = closure gram (singleton Item.initial) fun goto gram (items, sym) = let val closure = closure gram val prodOf = G.prodOf gram fun gather (ITEM{pId, i}, items) = let val (_, rhs) = prodOf pId in case List.drop(rhs, i) of sym' :: rest => if G.sameSym(sym, sym') then add(items, ITEM{pId=pId, i=i+1}) else items | _ => items (* end case *) end in closure (Set.foldl gather Set.empty items) end fun toString grm items = String.concat [ "{", String.concatWithMap "," (Item.toString grm) (toList items), "}" ] end (* local *) end structure CanonicalSets : sig type t = (int * ItemSet.set) list val items : GrammarRep.t -> t val dump : GrammarRep.t -> t -> unit end = struct (* maps keyed by item sets *) structure Map = RedBlackMapFn ( struct type ord_key = ItemSet.set val compare = ItemSet.compare end) type t = (int * ItemSet.set) list fun items gram = let val syms = GrammarRep.symbolsOf gram val nextId = ref 0 fun new (cset, items) = let val id = !nextId in nextId := id + 1; Map.insert (cset, items, id) end fun add (items, _, cset) = let fun goto (sym, cset) = let val items' = ItemSet.goto gram (items, sym) in if ItemSet.isEmpty items' then cset else if Map.inDomain(cset, items') then cset else new (cset, items') end in List.foldl goto cset syms end fun iterate cset = let val n = Map.numItems cset val cset = Map.foldli add cset cset in if Map.numItems cset > n then iterate cset else cset end val cset = iterate (new (Map.empty, ItemSet.initial gram)) val itemSets : t = Map.foldli (fn (items, id, sets) => (id, items)::sets) [] cset in ListMergeSort.sort (fn ((id1, _), (id2, _)) => Int.>(id1, id2)) itemSets end fun dump gram cset = let val items2s = ItemSet.toString gram fun pr (id, items) = print(concat[ StringCvt.padLeft #" " 2 (Int.toString id), ": ", items2s items, "\n" ]) in List.app pr cset end end; structure Ex0 : sig val g : GrammarRep.t val cset : CanonicalSets.t end = struct local datatype sym = datatype GrammarRep.sym fun nt s = NT(Nonterm.nterm s) fun tok s = TOK(Token.token s) fun prod (lhs, rhs) = (Nonterm.nterm lhs, rhs) in val g = GrammarRep.make (List.map prod [ ("S'", [nt "E"]), ("E", [nt "E", tok "+", nt "T"]), ("E", [nt "T"]), ("T", [tok "num"]) ]) val cset = CanonicalSets.items g end (* local *) end structure Ex1 = struct local datatype sym = datatype GrammarRep.sym fun nt s = NT(Nonterm.nterm s) fun tok s = TOK(Token.token s) fun prod (lhs, rhs) = (Nonterm.nterm lhs, rhs) in val g = GrammarRep.make (List.map prod [ ("S'", [nt "E"]), ("E", [nt "E", tok "+", nt "T"]), ("E", [nt "T"]), ("T", [tok "num"]), ("T", [tok "(", nt "E", tok ")"]) ]) val cset = CanonicalSets.items g end (* local *) end
Summary:
Minor pretty printing glitch when printing structure specs

Detailed description
There is an extra newline before the "sig" in the printing of "CanonicalSets" and an extra blank line between the "end" of "CanonicalSets" and the "Ex0" structure.

Comments:

Message  ↓
Date: 2020-12-22 22:03
Sender: John Reppy

Fixed for 110.99

Attached Files:

Attachments:
Size Name Date By Download
10 KiBlr0-items.sml2020-10-18 17:20jhrlr0-items.sml

Changes

Field Old Value Date By
status_idOpen2020-12-22 22:03jhr
close_dateNone2020-12-22 22:03jhr
ResolutionAccepted As Bug2020-12-22 22:03jhr
File Added19: lr0-items.sml2020-10-18 17:20jhr