--  Copyright (C) 2000 Panagiotis Manolios
 
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
 
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
 
--  You should have received a copy of the GNU General Public License
--  along with this program; if not, write to the Free Software
--  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

--  This program can be used to enumerate the strings in a regular
--  expression with respect to any regular preorder.  See the paper
--  for the details.

--  Written by Panagiotis Manolios who can be reached as follows.
 
--  Email: pete@cs.utexas.edu
 
--  Postal Mail:
--  Department of Computer Sciences
--  Taylor Hall 2.124 [C0500]
--  The University of Texas at Austin
--  Austin, TX 78712-1188 USA


infix 0 <<=

-- A regular preorder that is total.
x <<= y 
  =  let lenx = length x
         leny = length y
     in (lenx < leny) || ((lenx == leny) && (x <= y))

data Reg a = Nil | E | L a | U (Reg a) (Reg a) |
             C (Reg a) (Reg a) | S (Reg a)
           deriving Show

enum Nil       = []      -- The empty language        
enum E         = [[]]	 -- The language containing []
enum (L l)     = [[l]]	 -- The language containing l
enum (U p q)   = enumUnion p q
enum (C p q)   = enumConcat p q
enum (S p)     = enumStar p

enumUnion p q  = removeDups (merge (enum p) (enum q))

removeDups []      = []
removeDups (x0:xs) = x0:removeDups [z|z<-xs, z /= x0]

merge [] y            = y
merge x []            = x
merge (x0:xs) (y0:ys) 
  | x0 <<= y0         = x0 : merge xs (y0:ys)
  | otherwise         = y0 : merge (x0:xs) ys

enumConcat p q = removeDups (multiMerge (enum p) (enum q))

multiMerge [] _  = []
multiMerge _  [] = []
multiMerge ep eq = matrixMerge (map makeRow ep)
                 where makeRow p = map (p++) eq

matrixMerge [r]        = r
matrixMerge (r0:r1:mx) = a:matrixMerge (r01:mx)
                       where (a:r01) = merge r0 r1
enumStar p
  | epNoE == []  = [[]]
  | otherwise    = ps 
  where epNoE    = [z|z <- (enum p), z /= []]
        ps       = removeDups ([] : (multiMerge epNoE ps))

compress []      = []
compress (x:xs)  = x : compress(dropWhile (== x) xs)

{--

Below we define the following regular expressions:

r0.  Nil
r1.  E
r2.  E*
r3.  Nil*

r4.  a
r5.  b
r6.  a*
r7.  a|b
r8.  a|b|E
r9.  (a|b)*
r10. (a|b|E)*
r11. (ab)*

r12. 0
r13. 4
r14. 1
r15. 0*4*1*
r16. (11|0)*(00|1)*
r17. (1|01)*(E|0|00)
r18. ((1|01)*(E|0|00))*

--}

r0   = Nil
r1   = E
r2   = S E
r3   = S Nil

r4   = L 'a'
r5   = L 'b'
r6   = S r4
r7   = U r4 r5
r8   = U r7 E
r9   = S r7
r10  = S r8
r11  = S (C r4 r5)

r12  = L 0
r13  = L 4
r14  = L 1
r15  = C (C (S r12) (S r13)) (S r14)
r16  = C (S (U (C r14 r14) r12))
         (S (U (C r12 r12) r14))
r17  = C (S (U r14 (C r12 r14)))
         (U (U E r12) (C r12 r12))
r18  = S (C (S (U r14 (C r12 r14)))
            (U (U E r12) (C r12 r12)))


{--
-- Here are two other preorders.


-- This order relates everything.
_ <<= _      = True


-- This order is the component-wise order on a,b
x <<= y
 = xas < yas || (xas == yas && xbs <= ybs)
   where xas = num 'a' x
         xbs = num 'b' x
         yas = num 'a' y
         ybs = num 'b' y
         num n x = length [z|z<-x, z==n]


-- This is the subsequence order, which is not a regular preorder.
[] <<= _      = True
_  <<= []     = False
(x0:xs) <<= (y0:ys)
  | x0 == y0  = xs <<= ys
  | otherwise = (x0:xs) <<= ys
--}