From 66833ebe8a1cc4dea51bcff822e2af1d94543b63 Mon Sep 17 00:00:00 2001
From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Sun, 30 Jun 2013 02:59:41 -0400
Subject: [PATCH] Wire up oper pragmas.

They're a little unpleasant, but it works.  While here, correct the
documentation.
---
 docs/sphinx/manual/pragmas.rst     |  8 +++++---
 src/Dyna/ParserHS/OneshotDriver.hs | 11 +++++++++--
 src/Dyna/ParserHS/Parser.hs        | 12 +++++++-----
 src/Dyna/ParserHS/Types.hs         |  2 +-
 4 files changed, 22 insertions(+), 11 deletions(-)

diff --git a/docs/sphinx/manual/pragmas.rst b/docs/sphinx/manual/pragmas.rst
index e7d3095..647a802 100644
--- 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 0ad2f78..7a48603 100644
--- 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 553f27b..167a6d9 100644
--- 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 76c0cbe..f16d54b 100644
--- 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
-- 
2.50.1