Commit ed85b0b7 authored by matthew-eads's avatar matthew-eads
Browse files

added support for tuples

parent 0a2ede14
......@@ -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
......
......@@ -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
......
......@@ -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 "(^[^:]*:)"
......
-----------------------------------------------------------------------------
-- |
-- 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)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment