Hi,
I am trying to implement a set of 4 modules that blend the action of a monk moving up a mountain on day 1 and returning down by the same path on day 2 [1][2]. The code should reflect the fact that there is some time and place which is common to the two days where the monk would *meets himself*.
My Haskell code is based on a Maude version[3][4]. Only 3 times and places are considered in the code; start, meet, and end called 1,2, and 3 (e.g. the start time for the upward journey is timeu1).
Using qualified elements, I can get the meets function to give the correct results, but I cannot get the location function to work.
Is it possible the get  meets to work without qualification? Any suggestions in getting  location to work?

Regards,
Pat

 

-- *** MODULE 1
module  MONKONMOVE where
data  Monk =  Monk String deriving (Eq,Show)
data  TimeOfDay =   TimeOfDay String deriving (Eq,Show)
data  LocationOnPath = LocationOnPath String deriving (Eq,Show)
meets :: Monk -> Monk -> TimeOfDay -> TimeOfDay -> LocationOnPath -> LocationOnPath -> Bool
meets m1 m2 t1 t2 l1 l2  = if (not(m1 == m2) && (t1 == t2) && (l1 == l2))
                                         then True
                                         else False

-- I am not sure that I actually need a type class, I just put it here to stop compiler errors.
class LOCATION m t l where
 location :: m -> t -> l

 

-- *** MODULE 2
module MONKONMOVEUP  where
import  MONKONMOVE
monku :: Monk
monku = Monk "munku"
timeu1 :: TimeOfDay
timeu1 =  TimeOfDay "timeu1"
timeu2  :: TimeOfDay
timeu2 = TimeOfDay "timeu2"
timeu3 :: TimeOfDay
timeu3 = TimeOfDay "timeu3"
locationu1 :: LocationOnPath
locationu1 =  LocationOnPath "locationu1"
locationu2 :: LocationOnPath
locationu2 =  LocationOnPath "locationu2"
locationu3 :: LocationOnPath
locationu3 = LocationOnPath  "locationu3"

instance LOCATION  Monk TimeOfDay  LocationOnPath where
 location monku timeu1  = locationu1
 location monku timeu2  = locationu2
 location monku timeu3  = locationu3

 

-- *** MODULE 3

module  MONKONMOVEDOWN where
import  MONKONMOVE
monkd :: Monk
monkd =  Monk "munkd"
timed1 :: TimeOfDay
timed1 = TimeOfDay "timed1"
timed2  :: TimeOfDay
timed2 = TimeOfDay "timed2"
timed3 :: TimeOfDay
timed3 = TimeOfDay "timeu3"
locationd1 :: LocationOnPath
locationd1 =  LocationOnPath "locationd3"
locationd2 :: LocationOnPath
locationd2 =  LocationOnPath "locationd2"
locationd3 :: LocationOnPath
locationd3 = LocationOnPath "locationd1"

instance LOCATION  Monk TimeOfDay  LocationOnPath where
 location monkd timed1  = locationd3
 location monkd timed2  = locationd2
 location monkd timed3  = locationd1
 

-- *** MODULE 4

module MONKMEETSHIMSELF where
import  MONKONMOVEUP
import  MONKONMOVEDOWN
-- There is one time and location in common
locationd2 = locationu2
timed2 = timeu2
-- The start of one journey is the end of the other and visa versa
locationd1 = locationu3
locationd3 = locationu1
timed1 = timeu1
timed3 = timeu3

-- The following are executable in MONKMEETSHIMSELF, but all the elements must be qualified their module name.
meets monku monkd timeu2 timed2 locationu2 locationd2  -- true
meets monku monkd timeu2 timed2 locationu2 locationd3  -- false

-- For example
MONKONMOVE.meets monku monkd MONKONMOVEUP.timeu2 MONKMEETSHIMSELF.timed2 MONKONMOVEUP.locationu2 MONKMEETSHIMSELF.locationd2

 

 -- I cannot get the location function to work in MONKMEETSHIMSELF
location monku timeu2 == location monkd timed2 – should be true
location monkd timed2 -- should be locationd2

 

 

[1] http://markturner.org/blending.html
[2] http://cseweb.ucsd.edu/~goguen/pps/taspm.pdf
[3] http://lists.cs.uiuc.edu/pipermail/maude-help/2010-December/000456.html
[4] http://lists.cs.uiuc.edu/pipermail/maude-help/2010-December/000462.html