added support for tuples

Imp.ast

@@ -10,6 +10,8 @@ data Exp = SET ID Exp
     | IF SimpleExp Exp Exp  
     | WHILE SimpleExp Exp  
     | BEGIN (List1 Exp)
+    | TUPY (Exp, Exp)
+    | LET [(String, Exp)] 
     
 data BinOp = Plus SimpleExp SimpleExp  
            | Mult SimpleExp SimpleExp  

gg-proto.cabal

@@ -5,7 +5,7 @@ description:         Please see README.md
 homepage:            https://github.cs.tufts.edu/siriusly/gg-proto
 author:              Matthew Eads
 build-type:          Simple
-extra-source-files:  AST.hs Unique.hs
+extra-source-files:  AST.hs 
 cabal-version:       >=1.10
 
 executable gg-proto
@@ -13,7 +13,8 @@ executable gg-proto
   main-is:             AST.hs
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:       base, array, haskell-src-meta, haskell-src-exts,
-                       haskell-src, template-haskell, regex-compat, containers, Unique
+                       haskell-src, template-haskell, regex-compat, containers, Unique,
+                       split
   default-language:    Haskell2010
 
 source-repository head

src/AST.hs

@@ -15,6 +15,7 @@ import Debug.Trace
 import Text.Regex
 import Data.List.Unique
 import Data.List
+import Data.List.Split
 
 type Grammar = String
 --               name  , [constructions]
@@ -48,24 +49,25 @@ conToRHS _ = error "conToRHS on not-NormalC not supported"
 
 -- flattenType :: Type -> String
 
--- tupleToString :: Type -> Type -> String
--- tupleToString t (ConT n) = flattenType t ++ showName n
+flattenTuple :: Type -> Type -> [Type]
+flattenTuple (TupleT n) t = [t]
+flattenTuple (AppT t1 t2) t3 = (flattenTuple t1 t2) ++ [t3]
 
 -- Converts a type to string, returns pair of the type in string form
 -- and any new rules it needed to produce (for tuples and lists)
 stypeToString :: StrictType -> (String, String)
 stypeToString (_, (ConT n)) = (showName n, "")
 stypeToString (_, (AppT ListT t)) = let (s, rs) = (stypeToString (IsStrict, t))
-                                        in (s ++ "*", (rs ++ makeMultiRules (AppT (ConT list0) t) s))
+                                        in (s ++ "*", (rs ++ "\n\n" ++ makeMultiRules (AppT (ConT list0) t) s))
 stypeToString (_, (AppT (ConT n) t)) = let (s, rs) = (stypeToString (IsStrict, t))
                                            c = if n == list0 then "*" else "+"
-                                       in (s ++ c, (rs ++ makeMultiRules (AppT (ConT n) t) s))
-{-stypeToString (_, (AppT (ConT n) t)) = if n == (mkName "List0") then
-                                           (stypeToString (IsStrict, t)) ++ "*"
-                                       else if n == (mkName "List1") then
-                                                (stypeToString (IsStrict, t)) ++ "+"
-                                       else error ("type " ++ (show n) ++ " not supported")-}
--- stypeToString (_, (AppT t1 t2) = tupleToString t1 t2
+                                       in (s ++ c, (rs ++ "\n\n" ++ makeMultiRules (AppT (ConT n) t) s))
+stypeToString (_, (AppT t1 t2)) = let ts = flattenTuple t1 t2 
+                                      ts' = map (stypeToString . (\x -> (IsStrict, x))) ts
+                                      (s, rs) = ((foldr (\(x, y) a -> (fixMultis x) ++ "\\" ++ a) "" ts'),
+                                                 (foldr (\(x, y) a -> y ++ a) "" ts'))
+                                      rs' = rs ++ "\n" ++ (makeTupleRules s)
+                                  in ((filter ((/=) '\\') s), rs')
 stypeToString (_, t) = error ("stypeToString of " ++ (show t) ++ " not yet supported")
 
 showDecT :: DecT -> String
@@ -85,13 +87,14 @@ myappend :: String -> String -> String
 myappend s1 s2 = s1 ++ " " ++ s2
 
 -- produces a string of form {$1 $2 ... $n}
-makeNums :: Int -> Int -> String
-makeNums _ 0 = "}"
-makeNums i n = " $"++(show (i-n+1))++(makeNums i (n-1))
+makeNums :: Int -> Int -> String -> String
+makeNums _ 0 _ = ""
+makeNums i 1 sep = "$" ++ (show i) 
+makeNums i n sep = "$" ++ (show (i-n+1)) ++ sep ++ (makeNums i (n-1) sep)
 
 -- produces the construction -> {EXP $1 $2} from the given RHS rule
 rrhs :: RHS -> String
-rrhs (RHS s ts) = "\t{" ++ s ++ (makeNums (length ts) (length ts))
+rrhs (RHS s ts) = "\t{" ++ s ++ " " ++ (makeNums (length ts) (length ts) " ") ++ "}"
 
 isMulti :: String -> Bool
 isMulti "*" = True
@@ -137,6 +140,11 @@ makeMultiRules (AppT (ConT listt) t) s =
            (if i == 0 then "|\t{[]}" else ("| " ++ (strip s) ++ "\t{[$1]}"))
 makeMultiRules _ _ = undefined
 
+makeTupleRules :: String -> String
+makeTupleRules s = let ts = splitOn "\\" s
+                   in (filter ((/=) '\\') s) ++ ": " ++ (foldr (\x a -> x ++ " " ++ a) "" ts)
+                      ++ "\t{(" ++ (makeNums ((length ts)-1) ((length ts)-1) ", ")
+                      ++ ")}"
 
 makeTab :: String -> String
 makeTab s = let helper 0 a = a
@@ -157,10 +165,13 @@ decTToRule (DecT n rhs) =
 makeRules :: [DecT] -> String
 makeRules decs = foldr (\dec acc -> (decTToRule dec) ++ "\n" ++ acc) "" decs 
 
+cleanNLs' :: String -> String
+cleanNLs' ('\n':'\n':'\n':s) = cleanNLs' ('\n':'\n':s)
+cleanNLs' (x:s) = x:(cleanNLs' s)
+cleanNLs' [] = ""
+
 cleanNLs :: String -> String
-cleanNLs ('\n':'\n':'\n':s) = cleanNLs ('\n':'\n':s)
-cleanNLs (x:s) = x:(cleanNLs s)
-cleanNLs [] = ""
+cleanNLs s = cleanNLs' (dropWhile ((==) '\n') s)
 
 cleanMulti :: String -> String
 cleanMulti s = let regex = mkRegex "(^[^:]*:)"

src/Unique.hs

------------------------------------------------------------------------------
--- |
--- Module      :  Data.List.Unique
--- Copyright   :  (c) Volodymyr Yaschenko
--- License     :  BSD3
---
--- Maintainer  :  ualinuxcn@gmail.com
--- Stability   :  Unstable
--- Portability :  portable
---
--- Library provides the functions to find unique and duplicate elements in the list
-
-module Data.List.Unique
-   (
-     sortUniq
-   , repeated
-   , repeatedBy
-   , unique
-   , count
-   , count_
-   , countElem
-   )
-   where
-
-
-import           Data.List           (group, groupBy, sort, sortBy)
-
-import           Control.Applicative (liftA2)
-import           Data.Function       (on)
-import           Data.List.Extra     (nubOrd)
-import           Data.Tuple          (swap)
-
--- | 'sortUniq' sorts the list and removes the duplicates of elements. Example:
---
--- > sortUniq "foo bar" == " abfor"
-
-sortUniq :: Ord a => [a] -> [a]
-sortUniq = sort . nubOrd
-
-sg :: Ord a => [a] -> [[a]]
-sg = group . sort
-
-filterByLength :: Ord a => (Int -> Bool) -> [a] -> [[a]]
-filterByLength p = filter (p . length) . sg
-
--- | 'repeated' finds only the elements that are present more than once in the list. Example:
---
--- > repeated  "foo bar" == "o"
-
-repeated :: Ord a => [a] -> [a]
-repeated = repeatedBy (>1)
-
--- | The repeatedBy function behaves just like repeated, except it uses a user-supplied equality predicate.
---
--- > repeatedBy (>2) "This is the test line" == " eist"
-
-repeatedBy :: Ord a => (Int -> Bool) -> [a] -> [a]
-repeatedBy p = map head . filterByLength p
-
--- | 'unique' gets only unique elements, that do not have duplicates.
--- It sorts them. Example:
---
--- > unique  "foo bar" == " abfr"
-
-unique :: Ord a => [a] -> [a]
-unique = concat . filterByLength (==1)
-
-lh :: [a] -> (a, Int)
-lh = liftA2 (,) head length
-
--- | 'count' of each element in the list, it sorts by keys (elements). Example:
---
--- > count "foo bar" == [(' ',1),('a',1),('b',1),('f',1),('o',2),('r',1)]
-
-count :: Ord a => [a] -> [(a, Int)]
-count = map lh . sg
-
--- | 'count_' of each elements in the list, it sorts by their number. Example:
---
--- > count_ "foo bar" == [(' ',1),('a',1),('b',1),('f',1),('r',1),('o',2)]
-
-count_ :: Ord a => [a] -> [(a, Int)]
-count_ = sortBy (compare `on` snd) . count
-
--- | 'occurrences' finds all elements of each occurrences.
-
--- occurrences :: Ord a => [a] -> [(1,a)]
--- occurrences =
-
--- | 'countElem' gets the number of occurrences of the specified element. Example:
---
--- > countElem 'o' "foo bar" == 2
-
-countElem :: Eq a => a -> [a] -> Int
-countElem x = length . filter (== x)