|
|
Go to: [[internet:view_switcher|Tool Homepage]] - [[internet:view_switcher:download|Downloads]] - [[internet:view_switcher:user_guide|User Guide]] - [[internet:view_switcher:examples|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 [[internet:view_switcher:download|download]] section. The archive from the [[internet:view_switcher:download|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 =====
|
|
|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
|
|
|
|
|
|
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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
|
|
|
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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
|
|
|
</code>|
|
|
|
|
|
|
|
|
|
===== Data-oriented view =====
|
|
|
|
|
|
This view is the result of the transformation.
|
|
|
|
|
|
|<code haskell>
|
|
|
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
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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
|
|
|
</code>|
|
|
|
|<code haskell>
|
|
|
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)
|
|
|
|
|
|
</code>|
|
|
|
|<code haskell>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
|
|
|
</code>|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
===== Transformation script =====
|
|
|
|
|
|
<code lisp>
|
|
|
;; 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" )
|
|
|
</code> |
|
|
\ No newline at end of file |