John D. Ramsdell wrote: On Nov 17, 2007 3:04 PM, apfelmus <[EMAIL PROTECTED] <mailto:[EMAIL PROTECTED]>> wrote:
Unfortunately, I don't have Paulson's book (or any other ML book :) at home. I'm too lazy to figure out the specification from the source code, I guess the code is too opaque, as my colleague claimed. Yes, a bit opaque. The variable names are not descriptive enough and not documented. I have just rewritten your code with mostly trivial changes all of which clarify what the code is doing in each expression. For instance, blocksize and space* were both measured relative to "margin" instead of simply using the column number. The file is both att > {-# LANGUAGE BangPatterns #-} > > -- Author: Chris Kuklewicz > -- > -- This is a rewrite of John D. Ramsdell Pretty.hs code on > -- haskell-cafe mailing list > > -- Changelog from Pretty.hs > -- All Pretty elements have a length field (lazy at the moment) > -- Inlined logic of 'blanks' and used new 'prepend' instead > -- Replaced blocksize by startColumn == margin - blocksize > -- Replaced space by colunmIn == margin-space > -- Documented what 'after' means > module Blocks(Pretty,str,brk,spc,blo,cat,pr) where > > -- All of the len's are non-negative, guaranteed by smart constructors > data Pretty = Str { len :: Int, string :: String} > | Brk { len :: Int } > | Blo { len :: Int, indentBy :: Int, parts :: [Pretty] } > > str s = Str (length s) s > > brk n | n < 0 = error ("Cannot have negative width brk! n = " ++ show n) > | otherwise = Brk n > > spc = brk 1 > > blo indent es | indent < 0 = error ("Cannot have negative width blo! indent = > " ++ show indent) > | otherwise = Blo (sum (map len es)) indent es > > cat = blo 0 > > {-# INLINE pr #-} > pr :: Int -> Pretty -> (String->String) > pr margin e sRest = let {startColumn = 0; after = 0; columnIn = 0} > in snd (printing margin startColumn after [e] (columnIn, > sRest)) > > {-# INLINE printing #-} > printing :: Int -> Int -> Int -> [Pretty] -> (Int,String) -> (Int,String) > -- margin is the desired maximum line length and must be non-negative > -- startColumn, columnIn, column', and columnOut are all non-negative, > -- but any of them may be greater than margin > printing margin | margin < 0 = error ("Cannot have non-positive margin! > margin == "++show margin) > | otherwise = block where > > -- startColumn is the "current amount of indent after newline" > -- after is how much must be laid after the (e:es) and before the next > break, non-negative > block !startColumn !after = layout where > > -- (e:es) are the items to layout before 'sIn' > -- columnIn is the starting column for laying out 'e' > -- columnOut is the column after the (e:es) have been laid out > layout [] columnIn'sIn'pair = columnIn'sIn'pair > layout (e:es) (!columnIn,sIn) = (columnOut,sOut) where > > (columnOut,s') = layout es (column',sIn) > > -- column' is the column to use after when laying out es, after laying > out e > (column',sOut) = > case e of > Str n str -> (columnIn+n, showString str s') > Brk n | columnIn + n + breakDist es after <= margin -> (columnIn+n, > prepend n ' ' s') > | 0 <= startColumn -> (startColumn, '\n':prepend startColumn > ' ' s') > | otherwise -> (0, '\n':s') > Blo _n indent es' -> let startColumn' = indent + columnIn > after' = breakDist es after > in block startColumn' after' es' (columnIn,s') > > -- Trivial helper function to prepend 'n' copies of character 'c' > {-# INLINE prepend #-} > prepend n c s | n < 0 = error ("prepend called with "++show n++" < 0 !") > | otherwise = loop n where loop 0 = s > loop n = c : loop (pred n) > > -- after >=0 implies breakDist _ after >= 0 > -- Note that contained Blo's are assumed to layout in one line without using > any internal breaks. > breakDist :: [Pretty] -> Int -> Int > breakDist esIn !after = accum esIn 0 where > accum [] beforeBrk = beforeBrk + after > accum (Brk {}:_) beforeBrk = beforeBrk > accum (e : es) beforeBrk = accum es (beforeBrk + len e) > > test1 = putStrLn $ > pr 5 (blo 3 [str "Hello",spc,str "World!" > ,blo 3 [str "Goodbye",spc,str "Space!"] > ,spc,cat [str "The",spc,str "End"]]) "" > > test2 = putStrLn $ > pr 12 (blo 3 [str "Hello",spc,str "World!",spc > ,blo 3 [str "Goodbye",spc,str "Space!"] > ,spc,cat [str "The",spc,str "End"]]) "" > > test3 = putStrLn $ > pr 12 (blo 3 [str "Hello",spc,str "World!" > ,blo 3 [str "Goodbye",spc,str "Space!"] > ,spc,cat [str "The",spc,str "End"]]) "" > > > {- > *Blocks> test1 > Hello > World!Goodbye > Space! > The > End > *Blocks> test2 > Hello World! > Goodbye > Space! > The End > *Blocks> test3 > Hello > World!Goodbye > Space! > The End > -} _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe