Add [,,,|Rest] syntax support to parser

diff --git a/examples/expected/lists.py.out b/examples/expected/lists.py.out
index 65239f2cd6633e86c9dc42ac85f2e24aa8e53a4c..fce6f441ed09189a196a00def5d68498096cc1c8 100644 (file)
--- a/examples/expected/lists.py.out
+++ b/examples/expected/lists.py.out
@@ -7,3 +7,7 @@ f/1
 ===
 f([1, 2])                      := true
 
+goal/1
+======
+goal([2])                      := true
+

diff --git a/examples/lists.dyna b/examples/lists.dyna
index cbcae50f80d500cb09e6a23a19fe18ba44b66547..c1bb6e3b3791df1801d0261de6366448cddece5a 100644 (file)
--- a/examples/lists.dyna
+++ b/examples/lists.dyna
@@ -1,4 +1,5 @@
-
 f([1,2]).
 
 a := [1,2].
+
+goal(X) := f([1|X]).

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index bd82186ff1fca36dff3f5de9085f52131b067449..553f27b1eaea1da7c0d4a0cb4983188959b90785 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -109,9 +109,13 @@ mkEOT s0 f0 = EOT $ addFailSafe $ interpSpec M.empty $ M.toList s0
    where
     go (p,f) = mapInOrCons p (interpret f o)
 
-  interpret (PFIn a) = flip Infix a . bf . spanned . bsf . symbol
-  interpret PFPre    = Prefix       . uf . spanned . bsf . symbol
-  interpret PFPost   = Postfix      . uf . spanned . bsf . symbol
+  interpret (PFIn a) = flip Infix a . bf . interpCore
+  interpret PFPre    = Prefix       . uf . interpCore
+  interpret PFPost   = Postfix      . uf . interpCore
+
+  -- Make operators use the longest match
+  interpCore s = try (spanned (bsf (symbol s))
+                      <* notFollowedBy (oneOfSet usualpunct))
 
   addFailSafe = if f0 then (++ failSafe) else id
 
@@ -329,20 +333,44 @@ term = token $ choice
         ,       nakedbrak
         ,       spanned $ parenfunc
         ]
+        <?> "Term"
  where
+  mkta ty te = TAnnot (AnnType ty) te
+
   parenfunc = TFunctor <$> parseFunctor
                        <*> parens (tlexpr `sepBy` symbolic ',')
 
-  nakedbrak = listify <$> spanned (brackets (tlexpr `sepBy` symbolic ','))
+  nakedbrak = listify <$> tlist
    where
-    listify (xs :~ s) = 
-      let (xs' :~ s') = foldr (\a@(_ :~ sa) b@(_ :~ sb) -> TFunctor "cons" [a,b] :~ (sa <> sb))
-                              (TFunctor "nil" [] :~ r s)
+    tlist = spanned (brackets ((,) <$> (tlistexpr `sepEndBy` symbolic ',')
+                                       <*> (optional (symbolic '|' *> tlexpr))
+                                  ))
+
+    listify ((xs,ml) :~ s) =
+      let (xs' :~ s') = foldr (\a@(_ :~ sa) b@(_ :~ sb) ->
+                                TFunctor "cons" [a,b] :~ (sa <> sb))
+                              (maybe (TFunctor "nil" [] :~ r s) id ml)
                               xs
       in (xs' :~ (s <> s'))
     r (Span _ e b) = Span e e b
 
-  mkta ty te = TAnnot (AnnType ty) te
+
+  -- XXX Ick ick ick ick... there must be a more general answer, even if
+  -- involves patching ekmett-parsers to understand something more like
+  -- DOPP.
+  --
+  -- XREF:TLEXPR
+  tlistexpr = do
+    ot <- asks dlc_opertab
+    (buildExpressionParser (maskPipe (unEOT ot)) term) <?> "List Expression"
+   where
+    maskPipe ot = fmap (fmap mkpf) ot
+
+    mkpf (Infix m a) = Infix (nfp >> m) a
+    mkpf (Prefix m)  = Prefix (nfp >> m)
+    mkpf (Postfix m)  = Postfix (nfp >> m)
+
+  nfp = notFollowedBy (symbolic '|' *> notFollowedBy (oneOfSet usualpunct))
 
 -- | Sometimes we require that a character not be followed by whitespace
 -- and satisfy some additional predicate before we pass it off to some other parser.
@@ -397,17 +425,18 @@ bf f = do
   (x:~spx)  <- f
   pure (\a@(_:~spa) b@(_:~spb) -> (TFunctor x [a,b]):~(spa <> spx <> spb))
 
-
+-- XREF:TLEXPR
 tlexpr :: (DeltaParsing m, LookAheadParsing m, MonadReader DLCfg m)
        => m (Spanned Term)
-tlexpr = asks dlc_opertab >>= flip buildExpressionParser term . unEOT
+tlexpr = (asks dlc_opertab >>= flip buildExpressionParser term . unEOT)
+         <?> "Core Expression"
 
 moreETable :: (LookAheadParsing m, DeltaParsing m) => [[Operator m (Spanned Term)]]
-moreETable = [ [ Infix  (bf (spanned $ bsf $ symbol "is"      )) AssocNone  ]
-             , [ Infix  (bf (spanned $ bsf $ symbol ","       )) AssocRight ]
+moreETable = [ [ Infix  (bf (spanned $ bsf $ symbol dynaEvalAssignOper)) AssocNone  ]
+             , [ Infix  (bf (spanned $ bsf $ symbol dynaConjOper      )) AssocRight ]
              -- , [ Infix  (bf (spanned $       commaOper        )) AssocRight ]
-             , [ Infix  (bf (spanned $ bsf $ symbol "whenever")) AssocNone
-               , Infix  (bf (spanned $ bsf $ symbol "for"     )) AssocNone  ]
+             , map (\x -> Infix  (bf (spanned $ bsf $ symbol x)) AssocNone)
+                   dynaRevConjOpers
              ]
 
 -- | Full Expression

diff --git a/src/Dyna/ParserHS/Selftest.hs b/src/Dyna/ParserHS/Selftest.hs
index 6046736e7b091de1416cb803227d85f161d972df..ea6d5628f786769e4e37c5661cf34f8c1ff45987 100644 (file)
--- a/src/Dyna/ParserHS/Selftest.hs
+++ b/src/Dyna/ParserHS/Selftest.hs
@@ -155,8 +155,8 @@ 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)
+case_list :: Assertion
+case_list = e @=? (term s)
  where
   e = TFunctor "cons"
         [ _tNumeric (Left 1) :~ Span (Columns 1 1) (Columns 2 2) s
@@ -173,6 +173,25 @@ case_bracketTuple = e @=? (term s)
        :~ Span (Columns 0 0) (Columns 7 7) s
   s = "[1,2+3]"
 
+case_list_bar :: Assertion
+case_list_bar = e @=? (term s)
+ where
+  e = TFunctor "cons"
+        [ _tNumeric (Left 1) :~ Span (Columns 1 1) (Columns 2 2) s
+        , TFunctor "cons"
+                   [ 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
+                       , TVar "X" :~ Span (Columns 7 7) (Columns 8 8) s
+                       ]
+           :~ Span (Columns 3 3) (Columns 8 8) s
+        ]
+       :~ Span (Columns 0 0) (Columns 8 8) s
+  s = "[1,2+3|X]"
+
+
 -- case_nullaryStar :: Assertion
 -- case_nullaryStar = e @=? (term gs)
 --  where