Tweaks to parser

Introduce [,,,] syntax for anonymous tuples (an alias for "tuple(,,,)").
Modify rule span information to avoid subsequent whitespace.

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index f10376b4825354e2e2f376e59f5890efe4a586c3..9b188911e43941b622cecc9f070340c2ddc63f15 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -326,11 +326,14 @@ term = token $ choice
                         <* (notFollowedBy $ char '(')
 
         , try $ nullaryStar
+        ,       spanned $ nakedbrak
         ,       spanned $ parenfunc
         ]
  where
   parenfunc = TFunctor <$> parseFunctor
-                       <*>  parens (tlexpr `sepBy` symbolic ',')
+                       <*> parens (tlexpr `sepBy` symbolic ',')
+
+  nakedbrak = TFunctor "tuple" <$> brackets (tlexpr `sepBy` symbolic ',')
 
   mkta ty te = TAnnot (AnnType ty) te
 
@@ -421,17 +424,17 @@ genericAggregators = token
  ) <?> "Aggregator"
 
 rule :: (DeltaParsing m, LookAheadParsing m, MonadReader DLCfg m)
-     => m Rule
+     => m (Spanned Rule)
 rule = token $ do
   h@(_ :~ hs) <- term
   choice [ do
-            _    <- try (char '.' <* lookAhead whiteSpace)
-            return (Rule h "|=" (TFunctor "true" [] :~ hs))
+            (_ :~ ds) <- try (spanned (char '.') <* lookAhead whiteSpace)
+            return (Rule h "|=" (TFunctor "true" [] :~ ds) :~ (hs <> ds))
          , do
-            aggr <- token $ join $ asks dlc_aggrs
-            body <- tfexpr
-            _    <- char '.'
-            return (Rule h aggr body)
+            aggr    <- token $ join $ asks dlc_aggrs
+            body    <- tfexpr
+            _ :~ ds <- spanned (char '.')
+            return (Rule h aggr body :~ (hs <> ds))
          ]
 
 ------------------------------------------------------------------------}}}
@@ -683,7 +686,7 @@ pragma = token $
 dline :: (MonadReader DLCfg m, DeltaParsing m, LookAheadParsing m)
       => m (Spanned PLine)
 dline = spanned (choice [ PLPragma <$> pragma
-                        , PLRule <$> spanned rule
+                        , PLRule <$> rule
                         ])
 
 configureParser :: (DeltaParsing m, LookAheadParsing m)
@@ -708,7 +711,7 @@ testGenericAggr :: (DeltaParsing m, LookAheadParsing m)
 testGenericAggr = genericAggregators
 
 testRule   :: (DeltaParsing m, LookAheadParsing m)
-           => DLCfg -> m Rule
+           => DLCfg -> m (Spanned Rule)
 testRule   = configureParser rule
 
 testPragma :: (DeltaParsing m, LookAheadParsing m)

diff --git a/src/Dyna/ParserHS/Selftest.hs b/src/Dyna/ParserHS/Selftest.hs
index cfbbda48c000cd9cabca61372400d2856180411c..86d346df8796f1e960a16a51749b2ef74594e749 100644 (file)
--- a/src/Dyna/ParserHS/Selftest.hs
+++ b/src/Dyna/ParserHS/Selftest.hs
@@ -155,6 +155,20 @@ case_colonFunctor = e @=? (term pvv)
        :~ Span (Columns 0 0) (Columns 17 17) pvv
   pvv = "possible(Var:Val)"
 
+case_bracketTuple :: Assertion
+case_bracketTuple = e @=? (term s)
+ where
+  e = TFunctor "tuple"
+        [ _tNumeric (Left 1) :~ Span (Columns 1 1) (Columns 2 2) s
+        , TFunctor "+"
+            [ _tNumeric (Left 2) :~ Span (Columns 3 3) (Columns 4 4) s
+            , _tNumeric (Left 3) :~ Span (Columns 5 5) (Columns 6 6) s
+            ]
+           :~ Span (Columns 3 3) (Columns 6 6) s
+        ]
+       :~ Span (Columns 0 0) (Columns 7 7) s
+  s = "[1,2+3]"
+
 -- case_nullaryStar :: Assertion
 -- case_nullaryStar = e @=? (term gs)
 --  where
@@ -200,7 +214,7 @@ test_aggregators = hUnitTestToTests $ TestList
                                                (\_ -> return ()))
         [".", ". ", "+=3", "+3=", "+=a", "+a=" ]
   , TestLabel "custom accept" $
-      let r = unsafeParse (testRule cdlc) r1
+      let r :~ _ = unsafeParse (testRule cdlc) r1
       in r ~=? Rule (TFunctor "a" [] :~ Span (Columns 0 0) (Columns 2 2) r1)
                     "+="
                     (TFunctor "b" [] :~ Span (Columns 5 5) (Columns 6 6) r1)
@@ -220,10 +234,10 @@ test_aggregators = hUnitTestToTests $ TestList
 -- Rules                                                                {{{
 
 progrule :: ByteString -> Spanned Rule
-progrule = unsafeParse (whiteSpace *> spanned (testRule defDLC <* eof))
+progrule = unsafeParse (whiteSpace *> (testRule defDLC <* eof))
 
 progrules :: ByteString -> [Spanned Rule]
-progrules = unsafeParse (whiteSpace *> many (spanned (testRule defDLC)) <* eof)
+progrules = unsafeParse (whiteSpace *> many (testRule defDLC) <* eof)
 
 oneshotRules :: ByteString -> [(RuleIx, Spanned Rule)]
 oneshotRules = xlate . unsafeParse (oneshotDynaParser Nothing)
@@ -236,7 +250,7 @@ case_ruleFact = e @=? (progrule sr)
   e  = Rule
        (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 4 4) sr)
        "|="
-       (TFunctor "true" [] :~ Span (Columns 0 0) (Columns 4 4) sr)
+       (TFunctor "true" [] :~ Span (Columns 4 4) (Columns 5 5) sr)
       :~ ts
   ts = Span (Columns 0 0) (Columns 5 5) sr
   sr = "goal."
@@ -368,7 +382,9 @@ case_rules = e @=? (progrules sr)
         (_tNumeric (Left 2) :~ Span (Columns 22 22) (Columns 24 24) sr)
        :~ s2
       ]
-  s1 = Span (Columns 0 0) (Columns 12 12) sr
+  -- Here and elsewhere, it is important that the rules not abut!  The
+  -- whitespace separating them is not to be counted in either one.
+  s1 = Span (Columns 0 0) (Columns 11 11) sr
   s2 = Span (Columns 12 12) (Columns 25 25) sr
   sr = "goal += 1 . laog min= 2 ."
 
@@ -391,7 +407,7 @@ case_rules_with_ruleix_pragmas = e @=? (oneshotRules sr)
         )
       ]
 
-  s1 = Span (Columns 13 13) (Columns 24 24) sr
+  s1 = Span (Columns 13 13) (Columns 23 23) sr
   s2 = Span (Columns 24 24) (Columns 36 36) sr
   sr = ":- ruleix 5. goal += 1. laog min= 2."
 
@@ -416,7 +432,7 @@ case_rulesWhitespace = e @=? (progrules sr)
   l1 = " += 1 .\n"
   l2 = "%test \n"
   l3 = " goal += 2 ."
-  s1 = Span (Columns 2 2) (Lines 3 1 31 1) l0
+  s1 = Span (Columns 2 2) (Lines 1 7 22 7) l0
   s2 = Span (Lines 3 1 31 1) (Lines 3 12 42 12) l3
   sr = B.concat [l0,l1,l2,l3]
 
@@ -438,7 +454,7 @@ case_rulesDotExpr = e @=? (progrules sr)
          (_tNumeric (Left 1) :~ Span (Columns 25 25) (Columns 27 27) sr)
         :~ s2
        ]
-  s1 = Span (Columns 0 0) (Columns 17 17) sr
+  s1 = Span (Columns 0 0) (Columns 16 16) sr
   s2 = Span (Columns 17 17) (Columns 28 28) sr
   sr = "goal += foo.bar. goal += 1 ."