Wire up oper pragmas.

They're a little unpleasant, but it works.  While here, correct the
documentation.

diff --git a/docs/sphinx/manual/pragmas.rst b/docs/sphinx/manual/pragmas.rst
index e7d3095ae0ddefd56c027822d9ab5685a90f04cc..647a80237fafe0f841b8f2e730609bb31c6d6bd1 100644 (file)
--- a/docs/sphinx/manual/pragmas.rst
+++ b/docs/sphinx/manual/pragmas.rst
@@ -134,12 +134,14 @@ Adding an operator
 
 The ``:-oper add`` pragma takes three arguments: the fixity, priority, and
 lexeme that makes up the operator.  Fixities are specified as ``pre``,
-``post`` or ``in``.  Priorities are natural numbers, with higher numbers
-binding tighter.  Lexemes are either bare words or singly-quoted functors.
+``post`` or ``in``.  In the case of ``in``, one of ``left``, ``right``, or
+``non`` must be specified for the associativity.  Priorities are natural
+numbers, with higher numbers binding tighter.  Lexemes are either bare words
+or singly-quoted functors.
 
 Examples::
 
-  :-oper add in 6 + .
+  :-oper add in left 6 + .
   :-oper add pre 9 - .
 
 Removing an operator

diff --git a/src/Dyna/ParserHS/OneshotDriver.hs b/src/Dyna/ParserHS/OneshotDriver.hs
index 0ad2f78d5cf93022eb75a5508f4b24e3631a8f14..7a48603349e9c683d16cdbb85085db827d1a88f7 100644 (file)
--- a/src/Dyna/ParserHS/OneshotDriver.hs
+++ b/src/Dyna/ParserHS/OneshotDriver.hs
@@ -32,6 +32,7 @@ import           Dyna.ParserHS.Parser
 import           Dyna.ParserHS.Types
 import           Dyna.Term.SurfaceSyntax
 import           Dyna.Term.TTerm
+import           Dyna.XXX.DataUtils
 import           Dyna.XXX.Trifecta (prettySpanLoc)
 import           Text.Parser.LookAhead
 import           Text.Trifecta
@@ -173,9 +174,15 @@ pcsProcPragma (PMode (PNWA n as) pmf pmt :~ s) = do
       $ M.lookup n mm
 pcsProcPragma (PRuleIx r :~ _) = pcs_ruleix .= r
 
-pcsProcPragma (p@(POperAdd _ _ _) :~ s) = sorryPragma p s
-pcsProcPragma (p@(POperDel _) :~ s) = sorryPragma p s
+pcsProcPragma (POperAdd fx prec sym :~ _) = do
+  pcs_operspec %= mapInOrCons (BU.toString sym) (prec,fx)
+  update_pcs_ot
 
+pcsProcPragma (POperDel sym :~ _) = do
+  pcs_operspec %= M.filterWithKey (\k _ -> k /= (BU.toString sym))
+  update_pcs_ot
+
+sorryPragma :: Pragma -> Span -> a
 sorryPragma p s = dynacSorry $ "Cannot handle pragma"
                              PP.<//> (PP.text $ show p)
                              PP.<//> "at"

diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs
index 553f27b1eaea1da7c0d4a0cb4983188959b90785..167a6d92eee45c39295b6cc5f90c396387accbd3 100644 (file)
--- a/src/Dyna/ParserHS/Parser.hs
+++ b/src/Dyna/ParserHS/Parser.hs
@@ -247,11 +247,11 @@ dynaPfxOperStyle = IdentifierStyle
 -- dual purpose as an operator and rule separator.
 -- Comma similarly has special handling due to its
 -- nature as term and subgoal separator.
-dynaOperStyle :: TokenParsing m => IdentifierStyle m
+dynaOperStyle :: (TokenParsing m, Monad m) => IdentifierStyle m
 dynaOperStyle = IdentifierStyle
   { _styleName = "Infix Operator"
   , _styleStart   = oneOfSet $ usualpunct CS.\\ CS.fromList ".,"
-  , _styleLetter  = oneOfSet $ usualpunct
+  , _styleLetter  = oneOfSet (usualpunct CS.\\ CS.fromList ".")
   , _styleReserved = mempty
   , _styleHighlight = Operator
   , _styleReservedHighlight = ReservedOperator
@@ -592,8 +592,8 @@ pragmaBody = token $ choice
                         <*  symbol "=="
                         <*> parseInst
 
-  parseOper = choice [ try $ symbol "add" *> parseOperAdd
-                     , try $ symbol "del" *> parseOperDel
+  parseOper = choice [ symbol "add" *> parseOperAdd
+                     , symbol "del" *> parseOperDel
                      , parseOperAdd
                      ]
 
@@ -601,8 +601,10 @@ pragmaBody = token $ choice
       parseOperAdd = do
                (fx,n) <- fixity
                prec   <- natural
+               when (prec > fromIntegral (maxBound :: Int))
+                    $ unexpected "huge number"
                sym    <- n
-               return $ POperAdd fx prec sym
+               return $ POperAdd fx (fromIntegral prec) sym
 
       parseOperDel = POperDel <$> afx
                          

diff --git a/src/Dyna/ParserHS/Types.hs b/src/Dyna/ParserHS/Types.hs
index 76c0cbe67041d8d7cc4067f8cb2ca12404d43cfc..f16d54b3cf87594eededf2dc5041a2a8a20ace7f 100644 (file)
--- a/src/Dyna/ParserHS/Types.hs
+++ b/src/Dyna/ParserHS/Types.hs
@@ -76,7 +76,7 @@ data Pragma = PBackchain DFunctAr
                     ParsedModeInst
                 -- ^ Declare a mode: name, input, and output
 
-            | POperAdd Fixity Integer B.ByteString
+            | POperAdd Fixity Int B.ByteString
                 -- ^ Add an operator
 
             | POperDel B.ByteString