--
-- cabra.hs
-- Interpreter for the Cabra Programming Language
-- Chris Pressey, Cat's Eye Technologies
--
-- $Id$
--

--
-- Copyright (c)2007 Cat's Eye Technologies.  All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
--
--  1. Redistributions of source code must retain the above copyright
--     notices, this list of conditions and the following disclaimer.
--  2. Redistributions in binary form must reproduce the above copyright
--     notices, this list of conditions, and the following disclaimer in
--     the documentation and/or other materials provided with the
--     distribution.
--  3. Neither the names of the copyright holders nor the names of their
--     contributors may be used to endorse or promote products derived
--     from this software without specific prior written permission. 
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE
-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-- POSSIBILITY OF SUCH DAMAGE.
--


-----------------------------------------------------------------------
-- ========================== Data types =========================== --
-----------------------------------------------------------------------

import qualified Data.Set as Set

data Cabra = Skip
           | UnSet Integer
           | Set Integer
           | Bottom
           | IfSet Integer Cabra Cabra
           | Par Cabra Cabra
           | Seq Cabra Cabra
    deriving (Show, Ord, Eq)


-----------------------------------------------------------------------
-- =========================== Execution =========================== --
-----------------------------------------------------------------------

interpret :: Cabra -> (Set.Set Integer) -> ((Set.Set Integer), Integer)

interpret (Set x) input =
    let
        cycles = if (Set.member x input) then 1 else x
    in
        (Set.union input (Set.singleton x), cycles)

interpret (UnSet x) input = (Set.difference input (Set.singleton x), 1)

interpret (IfSet x a b) input =
    if (Set.member x input) then
        interpret a input
    else
        interpret b input

interpret (Seq a b) input =
    let
        (output_a, cycles_a) = interpret a input
        (output_b, cycles_b) = interpret b output_a
    in
        (output_b, cycles_a + cycles_b)

interpret (Par a b) input =
    let
        (output_a, cycles_a) = interpret a input
        (output_b, cycles_b) = interpret b input
    in
        if (cycles_a < cycles_b) then
            (output_a, cycles_a)
        else
            if (cycles_b < cycles_a) then
                (output_b, cycles_b)
            else
                if (a < b) then  -- lexicographic tiebreaker
                    (output_a, cycles_a)
                else
                    (output_b, cycles_b)

interpret Skip input = (input, 0)

interpret Bottom input = interpret Bottom input

run prog input =
    let
        (output, cycles) = interpret prog (Set.fromList input)
    in
        Set.elems output


-----------------------------------------------------------------------
-- =========================== Test Cases ========================== --
-----------------------------------------------------------------------

test 1 =
    Seq (Set 5) (Set 23)

test 2 =
    IfSet 5 (Seq (UnSet 5) (Set 6)) Skip

test 3 =
    Par (IfSet 100 (Set 300) Skip)
        (Seq (UnSet 100) (Set 10))

--
-- Tests for right-distributivity.
--

test 4 =
    Seq
        (Par (Set 1) (Set 2))
        (IfSet 1 (IfSet 2 (Set 3) Skip) Skip)

test 5 =
    Par
        (Seq (Set 1) (IfSet 1 (IfSet 2 (Set 3) Skip) Skip))
        (Seq (Set 2) (IfSet 1 (IfSet 2 (Set 3) Skip) Skip))

test 6 =
    Seq
        (Par (Set 4) (UnSet 4))
        (IfSet 4 (Seq (UnSet 4) (Set 6)) (Set 5))

test 7 =
    Par
        (Seq (Set 4)   (IfSet 4 (Seq (UnSet 4) (Set 6)) (Set 5)))
        (Seq (UnSet 4) (IfSet 4 (Seq (UnSet 4) (Set 6)) (Set 5)))