Command disabled: index

Go to: Tool Homepage - Downloads - User Guide - Examples

Example of transformation on Parnas's KWIC program (original transformation by W. Griswold)

We re-implement Griswold's example of program restructuring in order to change the primary axis of modularity (example coming form Parnas).

Reference : W. G. Griswold, “Program Restructuring as an Aid to Software Maintenance”, Ph.D. Thesis, Technical Report 91-08-04, Department of Computer Science and Engineering, University of Washington, July 1991.

The source code is available in the download section. The archive from the download section contains:

  • The view of the program which is modular with respect to functions;
  • The transformation to get a behavior equivalent program but modular with respect to data constructors;
  • The transformation to transform the data-centered architecture of the program into to the function-centered architecture.

Function-oriented view

module Input where
import PreludeExt
 
 
putfile linelist = putfile_aux linelist emptylist
 
    where
 
      insline [] linestorage = linestorage
      insline line linestorage = line : linestorage
 
      putfile_aux [] accu = accu
      putfile_aux (e:r) accu = putfile_aux r (insline e accu)
module Shifter where
import PreludeExt
import Input 
import Array
 
 
default_value = (0,0) 
 
cssetup::[[String]]-> (Int , Int, Array Int (Int,Int))
cssetup linestorage =
    cssetup_aux 0 0 circ_index_0
 
    where 
      circ_index_0 = array (0,numcslines) [(i, default_value) | i <- [0..numcslines]]
 
      numlines = length linestorage
 
      numcslines = allwords linestorage 
          where
            allwords ls = allwords_aux ls 0
                where  
                  allwords_aux [] sum = sum
                  allwords_aux (e:r) sum = allwords_aux r (sum + length e)
 
      cssetup_aux cslineno lineno circ_index= 
          if lineno /= numlines
          then 
              let aux2 cslineno_arg wordno circ_index = 
	              if wordno /= numwords
	              then  aux2 (cslineno_arg + 1) (wordno + 1) (circ_index//[(cslineno_arg,(lineno, wordno))])
		      else (cslineno_arg, circ_index)
 
                          where  
                            numwords = length (nth linestorage lineno)        
	      in 
                let (cslineno', circ_index') = aux2 cslineno 0 circ_index
	        in
	          cssetup_aux cslineno' (lineno + 1) circ_index'
          else (cslineno, lineno, circ_index)
module Alphabet where
import PreludeExt
import Input 
import Shifter 
import Array
 
 
alph:: Array Int (Int,Int) -> [[String]] -> Array Int (Int,Int)
alph circ_index line_storage = qalph 0 (numitems - 1) (alph_aux 0 alph_index0 circ_index)
 
  where
 
    numitems = snd (bounds circ_index) 
 
    alph_index0 = array (0,numitems) [(i,default_value) | i <- [0..numitems]]
 
    alph_aux i aindex cindex = 
	if i /= numitems
	then alph_aux (i+1) (aindex//[(i,(cindex!i))]) cindex
	else aindex
 
 
    csline_inf shift1 shift2 ls  = inf_aux 0
          where
 
            csword (lno,fwno) wordno ls =
	          nth (nth ls lno) (mod (fwno + wordno) (length (nth ls lno)))
 
            cswords shift ls =
	          length (nth ls (fst shift)) 
 
            lasti  = min (cswords shift1 ls) (cswords shift2 ls)
 
            inf_aux i = 
                let maxed_ = (i == lasti) 
                    cword1 = csword shift1 i ls
                    cword2 = csword shift2 i ls
                in 
	          if (maxed_ || (not (cword1 == cword2)))
	          then 
	              if maxed_ 
                      then lasti <= (cswords shift2 ls)
                      else cword1 <= cword2
	          else inf_aux (i+1)
 
 
    swap_indices::Array Int (Int,Int) -> Int -> Int -> Array Int (Int,Int)
    swap_indices vec i j = 
          let tempi = vec!i 
              tempj = vec!j
          in 
            vec // [(i,tempj),(j,tempi)] 
 
 
    qsplit start end split alph_index =
            let (l,aind) = qsplit_aux (start+1) end start (swap_indices alph_index start split) 
                aind2    = swap_indices aind split (l-1)
            in (aind2, l-1)
 
                where
 
                  qsplit_aux low high split alph_index  =
	              if not (low > high)
	              then 
	                  if csline_inf (alph_index!low) (alph_index!split) line_storage
	                  then qsplit_aux (low+1) high split alph_index
	                  else qsplit_aux low (high-1) split (swap_indices alph_index low high)
	              else (low, alph_index)
 
 
    qalph start end alph_index= 
            if start < end
            then
	        let 
                    split = start 
	            (aindex,middle) = qsplit start end split alph_index
	            aindex' = qalph start (middle-1) aindex 
                in
	          qalph (middle+1) end aindex'
            else alph_index
module Output where
import PreludeExt
import Input 
import Alphabet
import Array
 
string_of_list l = foldl (\ a b -> a ++ b) "" l
 
 
allalphcslines line_storage alph_index = allalphcslines_aux 0 ""
    where
      allalphcslines_aux i accu =
          if i /= numcslines
          then let s = string_of_list (csline (alph_index!i) line_storage)
               in allalphcslines_aux (i+1) (accu ++ "\n" ++ s)
          else accu
              where
                numcslines = snd (Array.bounds alph_index)             
 
      csline (lno,fwno) ls =  reverse (csline_aux [] 0)
            where
              csline_aux revcs i =
	          if (i /= wrdcnt)
	          then csline_aux ((nth (nth ls lno) (mod (i + fwno)  wrdcnt)) : revcs) (i+1)
	          else revcs
 
              wrdcnt = length (nth ls lno)
module Main where
import PreludeExt
import Input 
import Shifter 
import Alphabet 
import Output
 
l = putfile [ ["a","b","c","d"] , ["one"] , ["hey", "this" , "is" , "different"] , ["a","b","c","d"] ] 
 
(a,b,s) = cssetup l 
 
s' = alph s l 
 
res = allalphcslines l s' 
 
main = putStrLn res

Data-oriented view

This view is the result of the transformation.

module LineStorage where
 import PreludeExt
 
 
 allwords ls = allwords_aux ls 0
     where  
       allwords_aux [] sum = sum
       allwords_aux (e:r) sum = allwords_aux r (sum + length e)
 
 line ls lno = nth ls lno
 
 emptyStorage = emptylist
 
 ls_words nth linestorage lineno = length (nth linestorage lineno)
 
 ls_lines linestorage = length linestorage
 
 insline [] linestorage = linestorage
 insline line linestorage = line : linestorage
 module Input where
import PreludeExt
import LineStorage (insline,emptyStorage)
 
 
putfile linelist = putfile_aux linelist emptyStorage
 
    where
 
 
      putfile_aux [] accu = accu
      putfile_aux (e:r) accu = putfile_aux r (insline e accu)
module Shifter where
import PreludeExt
import Input 
import Array
import LineStorage (ls_lines,ls_words,line,allwords)
 
 
printable_csline (lno,fwno) ls =  reverse (csline_aux [] 0)
      where
        csline_aux revcs i =
	          if (i /= wrdcnt)
	          then csline_aux ((nth (line ls lno) (mod (i + fwno) wrdcnt)) : revcs) (i+1)
	          else revcs
 
        wrdcnt = length (line ls lno) 
 
csline cindex i = cindex ! i
 
cslines circ_index = snd (bounds circ_index)
 
csline_inf shift1 shift2 ls  = inf_aux 0
      where
 
 
 
        lasti  = min (cswords shift1 ls) (cswords shift2 ls)
 
        inf_aux i = 
            let maxed_ = (i == lasti) 
                cword1 = csword shift1 i ls
                cword2 = csword shift2 i ls
            in 
	          if (maxed_ || (not (cword1 == cword2)))
	          then 
	              if maxed_ 
                  then lasti <= (cswords shift2 ls)
                  else cword1 <= cword2
	          else inf_aux (i+1)
 
cswords shift ls =
	          length (line ls (fst shift)) 
 
 
csword (lno,fwno) wordno ls =
	          (nth (line ls lno)
                (mod (fwno + wordno) (length (line ls lno))))
 
 
 
default_value = (0,0) 
 
cssetup::[[String]]-> (Int , Int, Array Int (Int,Int))
cssetup linestorage =
    cssetup_aux 0 0 circ_index_0
 
    where 
      circ_index_0 = array (0,numcslines) [(i, default_value) | i <- [0..numcslines]]
 
      numlines = (ls_lines linestorage)
 
      numcslines = allwords linestorage 
 
 
      cssetup_aux cslineno lineno circ_index= 
          if lineno /= numlines
          then 
              let aux2 cslineno_arg wordno circ_index = 
	              if wordno /= numwords
	              then  aux2 (cslineno_arg + 1) (wordno + 1) (circ_index//[(cslineno_arg,(lineno, wordno))])
		      else (cslineno_arg, circ_index)
 
                          where  
                            numwords = (ls_words nth linestorage lineno)        
 
	      in 
                let (cslineno', circ_index') = aux2 cslineno 0 circ_index
	        in
	          cssetup_aux cslineno' (lineno + 1) circ_index'
          else (cslineno, lineno, circ_index)
module Alphabet where
import PreludeExt
import Input 
import Shifter 
import Array
 
 
alphcslines alph_index = snd (Array.bounds alph_index)
 
alphcsline (!) alph_index i = alph_index ! i
 
alph:: Array Int (Int,Int) -> [[String]] -> Array Int (Int,Int)
alph circ_index line_storage = qalph 0 (numitems - 1) (alph_aux 0 alph_index0 circ_index)
 
  where
 
    numitems = (cslines circ_index) 
 
 
    alph_index0 = array (0,numitems) [(i,default_value) | i <- [0..numitems]]
 
    alph_aux i aindex cindex = 
	if i /= numitems
	then alph_aux (i+1) (aindex//[(i,((csline cindex i)))]) cindex
	else aindex
 
 
 
 
 
    swap_indices::Array Int (Int,Int) -> Int -> Int -> Array Int (Int,Int)
    swap_indices vec i j = 
          let tempi = vec!i 
              tempj = vec!j
          in 
            vec // [(i,tempj),(j,tempi)] 
 
 
    qsplit start end split alph_index =
            let (l,aind) = qsplit_aux (start+1) end start (swap_indices alph_index start split) 
                aind2    = swap_indices aind split (l-1)
            in (aind2, l-1)
 
                where
 
                  qsplit_aux low high split alph_index  =
	              if not (low > high)
	              then 
	                  if csline_inf (alph_index!low) (alph_index!split) line_storage
	                  then qsplit_aux (low+1) high split alph_index
	                  else qsplit_aux low (high-1) split (swap_indices alph_index low high)
	              else (low, alph_index)
 
 
    qalph start end alph_index= 
            if start < end
            then
	        let 
                    split = start 
	            (aindex,middle) = qsplit start end split alph_index
	            aindex' = qalph start (middle-1) aindex 
                in
	          qalph (middle+1) end aindex'
            else alph_index
module Output where
import PreludeExt
import Input 
import Alphabet hiding ()
import Array
import Shifter (printable_csline)
 
string_of_list l = foldl (\ a b -> a ++ b) "" l
 
 
allalphcslines line_storage alph_index = allalphcslines_aux 0 ""
    where
      allalphcslines_aux i accu =
          if i /= numcslines
          then let s = string_of_list (printable_csline ((alphcsline (!) alph_index i)) line_storage)
 
               in allalphcslines_aux (i+1) (accu ++ "\n" ++ s)
          else accu
              where
                numcslines = (alphcslines alph_index)
module Main where
import PreludeExt
import Input 
import Shifter 
import Alphabet 
import Output
 
l = putfile [ ["a","b","c","d"] , ["one"] , ["hey", "this" , "is" , "different"] , ["a","b","c","d"] ] 
 
(a,b,s) = cssetup l 
 
s' = alph s l 
 
res = allalphcslines l s' 
 
main = putStrLn res

Transformation script

;; The haskell initial program differs from Griswold's Scheme implementation.
;; The main differences are :
;;  - there are no references to global mutable variables (no state monad),
;;  - modules are syntactically defined.
 
;; Remark : In the data-oriented architecture, it would be better to aim at 
;;  an abstract data-type for line storages.
 
;; Move out function insline (p.171)
(haskell-refac-makeGlobalOfLocalIn "putfile" "insline" "Input")
(haskell-refac-moveDefBetweenModules "insline" "Input" "LineStorage" )
 
;; Extract function lines (p.171)
(haskell-refac-newDefFunAppIn "numlines" "length" "1" "ls_lines" "Shifter")
(haskell-refac-makeGlobalOfLocalIn "cssetup" "ls_lines" "Shifter")
(haskell-refac-moveDefBetweenModules "ls_lines" "Shifter" "LineStorage" )
 
;; Extract function words (p.171) & fold its occurences (p.178)
(haskell-refac-newDefFunAppIn "numwords" "length" "1" "ls_words" "Shifter")
(haskell-refac-makeGlobalOfLocalIn "cssetup" "ls_words" "Shifter")
(haskell-refac-foldToplevelDefinition "ls_words" "Shifter")
(haskell-refac-moveDefBetweenModules "ls_words" "Shifter" "LineStorage" )
 
;; The empty line storage is abstracted (instead of empty list)
(haskell-refac-newDefIdentIn "putfile" "emptylist" "emptyStorage" "Input")
(haskell-refac-makeGlobalOfLocalIn "putfile" "emptyStorage" "Input")
(haskell-refac-moveDefBetweenModules "emptyStorage" "Input" "LineStorage" )
 
;; move csline_inf and expose csword & cswords (p.173)
(haskell-refac-makeGlobalOfLocalIn "alph" "csline_inf" "Alphabet")
(haskell-refac-moveDefBetweenModules "csline_inf" "Alphabet" "Shifter" ) 
(haskell-refac-makeGlobalOfLocalIn "csline_inf" "csword" "Shifter")
(haskell-refac-makeGlobalOfLocalIn "csline_inf" "cswords" "Shifter")
 
;; Extract cslines (p.173)
(haskell-refac-newDefFunAppIn "numitems" "snd" "1" "cslines" "Alphabet")
(haskell-refac-makeGlobalOfLocalIn "alph" "cslines" "Alphabet")
(haskell-refac-moveDefBetweenModules "cslines" "Alphabet" "Shifter" )
 
;; Extract cslines (p.173)
(haskell-refac-newDefInfixAppIn "alph_aux" "!" "csline" "Alphabet")
(haskell-refac-makeGlobalOfLocalIn "alph" "csline" "Alphabet")
(haskell-refac-moveDefBetweenModules "csline" "Alphabet" "Shifter" )
 
;; Rename csline and move it to the shift module (p.175)
(haskell-refac-renameLocal "csline" "Output" "printable_csline")
(haskell-refac-makeGlobalOfLocalIn "allalphcslines" "printable_csline" "Output") 
(haskell-refac-moveDefBetweenModules "printable_csline" "Output" "Shifter" )
 
;; Extract alphcsline (p.175)
(haskell-refac-newDefInfixAppIn "allalphcslines_aux" "!" "alphcsline" "Output")
(haskell-refac-makeGlobalOfLocalIn "allalphcslines" "alphcsline" "Output") ;; pb with HaRe : even : is abstracted while lifting
(haskell-refac-moveDefBetweenModules "alphcsline" "Output" "Alphabet" )
 
;; Extract alphcslines (p.175)
(haskell-refac-newDefFunAppIn "numcslines" "snd" "1" "alphcslines" "Output")
(haskell-refac-makeGlobalOfLocalIn "allalphcslines" "alphcslines" "Output")
(haskell-refac-moveDefBetweenModules "alphcslines" "Output" "Alphabet" )
 
;; Fold the occurences of line (p.178)
;; Some syntactic occurence do not match the intended use of line.
;; These instances are unfolded to revert to the original code
;; (the state of the program is temporary not satisfactory before the unfolding).
(haskell-refac-newDefFunAppInTo "csword" "nth" "2" "ls" "line" "Shifter")
(haskell-refac-makeGlobalOfLocalIn "csword" "line" "Shifter") 
(haskell-refac-foldToplevelDefinition "line" "Shifter")
(haskell-refac-foldToplevelDefinition "line" "Shifter") ;; a second time to fold nested occurences
(haskell-refac-unfoldInstanceIn "line" "printable_csline" "Shifter")
(haskell-refac-unfoldInstanceIn "line" "csword" "Shifter")
(haskell-refac-moveDefBetweenModules "line" "Shifter" "LineStorage" )
 
;; Move out allwords (p.179)
(haskell-refac-makeGlobalOfLocalIn "cssetup" "allwords" "Shifter")
(haskell-refac-moveDefBetweenModules "allwords" "Shifter" "LineStorage"  )
internet/view_switcher/examples/kwic.txt · Last modified: 2011/04/18 08:53 by cohen-j