Changeset 3690 for src/Pugs/Internals.hs

Timestamp:

05/23/05 00:47:22 (4 years ago)

Author:

iblech

svk:copy_cache_prev:

5201

Message:

* &::("infix:<[+]>") and &::("prefix:«+<<»") and co. work now.
* Removed a wrong test from operator_overloading.t.

Files:

• src/Pugs/Internals.hs (modified) (2 diffs)

src/Pugs/Internals.hs

@@ -65 +65 @@
     modifyTVar,
     unsafePerformSTM,
+    possiblyFixOperatorName,
 ) where
 
@@ -183 +184 @@
 -- instance MonadIO STM where
 --     liftIO = unsafeIOToSTM
+
+{-|
+Transform an operator name, for example @&infix:<+>@ or @&prefix:«[+]»@, into
+its internal name (@&infix:+@ and @&prefix:[+]@ respectively).
+-}
+possiblyFixOperatorName :: String -> String
+possiblyFixOperatorName name
+    -- It doesn't matter if we lookup &foo or &*foo.
+    | ('&':'*':rest) <- name = "&*" ++ fixName' rest
+    | ('&':rest)     <- name = "&"  ++ fixName' rest
+    | otherwise      = name
+    where
+    -- We've to strip the <>s for &infix:<...>, &prefix:<...>, and
+    -- &postfix:<...>.
+    -- The other &...:<...> things aren't that simple (e.g. circumfix.).
+    fixName' ('i':'n':'f':'i':'x':':':rest)         = "infix:"   ++ dropBrackets rest
+    fixName' ('p':'r':'e':'f':'i':'x':':':rest)     = "prefix:"  ++ dropBrackets rest
+    fixName' ('p':'o':'s':'t':'f':'i':'x':':':rest) = "postfix:" ++ dropBrackets rest
+    fixName' x                                      = x
+    -- We have to make sure that the last character(s) match the first one(s),
+    -- otherwise 4 <= 4 will stop working.
+    -- Kludge. <=> is ambigious.
+    dropBrackets "<=>" = "<=>"
+    -- «bar» --> bar
+    dropBrackets ('\171':(rest@(_:_)))    = if (last rest) == '\187' then init rest else '\171':rest
+    -- <<bar>> --> bar
+    dropBrackets ('<':'<':(rest@(_:_:_))) = if (last rest) == '>' && (last . init $ rest) == '>' then init . init $ rest else "<<" ++ rest
+    -- <bar> --> bar
+    dropBrackets ('<':(rest@(_:_)))       = if (last rest) == '>' then init rest else '<':rest
+    dropBrackets x                        = x