From 025eebf61df21cf1f6c2e936a07db5f9deede21e Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Fri, 21 Mar 2008 21:10:47 +0000
Subject: [PATCH] Added support for giving ranges an explicit type in Rain

---
 common/TestUtils.hs        |  3 +++
 frontends/ParseRain.hs     | 22 +++++++++++++++++++---
 frontends/ParseRainTest.hs | 11 +++++++++++
 3 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/common/TestUtils.hs b/common/TestUtils.hs
index e8c08cb..ace132d 100644
--- a/common/TestUtils.hs
+++ b/common/TestUtils.hs
@@ -269,6 +269,7 @@ data ExprHelper =
   | DirVar A.Direction String
   | Lit A.Expression
   | EHTrue
+  | Range A.Type ExprHelper ExprHelper
 
 buildExprPattern :: ExprHelper -> Pattern
 buildExprPattern = (stopCaringPattern emptyMeta) . mkPattern . buildExpr
@@ -281,6 +282,8 @@ buildExpr (Var n) = A.ExprVariable emptyMeta $ variable n
 buildExpr (DirVar dir n) = A.ExprVariable emptyMeta $ (A.DirectedVariable emptyMeta dir $ variable n)
 buildExpr (Lit e) = e
 buildExpr EHTrue = A.True emptyMeta
+buildExpr (Range t begin end) = A.ExprConstr emptyMeta $ A.RangeConstr emptyMeta t
+  (buildExpr begin) (buildExpr end)
 
 -- | A simple definition of a variable
 simpleDef :: String -> A.SpecType -> A.NameDef
diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs
index b99a888..ebe6673 100644
--- a/frontends/ParseRain.hs
+++ b/frontends/ParseRain.hs
@@ -34,7 +34,7 @@ import qualified LexRain as L
 import Metadata
 import ParseUtils
 import Pass
-
+import Utils
 
 type RainState = CompState
 type RainParser = GenParser L.Token RainState
@@ -233,9 +233,25 @@ literal = do {lr <- stringLiteral ; return $ A.Literal (findMeta lr) (A.List A.B
           <|> listLiteral
           <?> "literal"
 
+maybeParse :: RainParser a -> RainParser (Maybe a)
+maybeParse p = option Nothing (p >>* Just)
+
 range :: RainParser A.Expression
-range = try $ do {m <- sLeftQ ; begin <- literal; sDots ; end <- literal ;
-  sRightQ ; return $ A.ExprConstr m $ A.RangeConstr m (A.List A.Any) begin end}
+range = try $ do m <- sLeftQ
+                 optTy <- maybeParse $ try $ do t <- dataType
+                                                m <- sColon
+                                                return (t, m)
+                 begin <- literal
+                 sDots
+                 end <- literal
+                 sRightQ
+                 case optTy of
+                   Just (t, mc) -> return $ A.ExprConstr m $ A.RangeConstr m
+                     (A.List t)
+                     (A.Conversion mc A.DefaultConversion t begin)
+                     (A.Conversion mc A.DefaultConversion t end)
+                   Nothing -> return $ A.ExprConstr m $ A.RangeConstr m
+                     (A.List A.Any) begin end
 
 expression :: RainParser A.Expression
 expression
diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs
index 17ea95a..9dab13c 100644
--- a/frontends/ParseRainTest.hs
+++ b/frontends/ParseRainTest.hs
@@ -46,6 +46,7 @@ import qualified LexRain as L
 import Metadata (Meta,emptyMeta)
 import qualified ParseRain as RP
 import Pattern
+import TagAST
 import TestUtils
 import TreeUtils
 
@@ -196,6 +197,8 @@ testExprs =
    passE (code,index,expr) = pass(code,RP.expression,assertPatternMatch ("testExprs " ++ show index) (buildExprPattern expr))
    failE x = fail (x,RP.expression)
 
+--TODO add support for shared ? and shared !, as well as any2any channels etc
+
 testLiteral :: [ParseTest A.Expression]
 testLiteral =
  [
@@ -277,9 +280,17 @@ testRange =
     A.ExprConstr m $ A.RangeConstr m (A.List A.Any) (intLiteral 0) (intLiteral 10000))
   ,pass("[-3..-1]", RP.expression, assertPatternMatch "testRange 2" $ pat $
     A.ExprConstr m $ A.RangeConstr m (A.List A.Any) (intLiteral $ -3) (intLiteral $ -1))
+  ,pass("[sint16: 0..1]", RP.expression, rangePattern 4 (A.List A.Int16)
+    (buildExprPattern $ Cast A.Int16 (Lit $ intLiteral 0))
+    (buildExprPattern $ Cast A.Int16 (Lit $ intLiteral 1)))
+  
   --For now, at least, this should fail:
   ,fail("[0..x]", RP.expression)
  ]
+ where
+   rangePattern :: Int -> A.Type -> Pattern -> Pattern -> (A.Expression -> Assertion)
+   rangePattern n t start end = assertPatternMatch ("testRange " ++ show n) $
+     mExprConstr $ mRangeConstr t start end
 
 --Helper function for ifs:
 makeIf :: [(A.Expression,A.Process)] -> A.Process