Changeset 6682

Timestamp:

09/04/05 09:32:39 (3 years ago)

Author:

luqui

Message:

Created a warning that warns when you try to export an operator. The problem
came up with Set that exported &infix:<->, thus *overriding* the default
numeric minus, and causing wacky infinite loops all over the place!

Location:

src/Pugs

Files:

• Compile.hs (modified) (2 diffs)
• Internals.hs (modified) (2 diffs)
• Parser.hs (modified) (4 diffs)

src/Pugs/Compile.hs

@@ -18 +18 @@
     TParam(..),
     EnterClass(..),
-    die, varText,
+    die, varText
 ) where
 import Pugs.AST
@@ -390 +390 @@
     compile val = return $ PVal val
 
-die :: (MonadIO m, Show a) => String -> a -> m b
-die x y = do
-    warn x y
-    liftIO $ exitFailure
-
-warn :: (MonadIO m, Show a) => String -> a -> m ()
-warn str val = liftIO $ do
-    hPutStrLn stderr $ "*** " ++ str ++ ":\n    " ++ show val
-
 -- utility functions
 padSort :: (Var, [(TVar Bool, TVar VRef)]) -> (String, [(a, b)]) -> Ordering

src/Pugs/Internals.hs

@@ -72 +72 @@
     maybeM,
     safeMode,
+    warn,
+    die,
 ) where
 
@@ -147 +149 @@
     "Internal error:\n    " ++ s ++ "\nPlease file a bug report."
 
+die :: (MonadIO m, Show a) => String -> a -> m b
+die x y = do
+    warn x y
+    liftIO $ exitFailure
+
+warn :: (MonadIO m, Show a) => String -> a -> m ()
+warn str val = liftIO $ do
+    hPutStrLn stderr $ "*** " ++ str ++ ":\n    " ++ show val
+
 split :: (Eq a) => [a] -> [a] -> [[a]]
 split []  _   = internalError "splitting by an empty list"

src/Pugs/Parser.hs

@@ -34 +34 @@
 import Pugs.Parser.Number
 import Pugs.Parser.Unsafe
+
+fixities :: [String]
+fixities = words " prefix: postfix: infix: circumfix: coerce: self: term: postcircumfix: rule_modifier: trait_verb: trait_auxiliary: scope_declarator: statement_control: infix_postfix_meta_operator: postfix_prefix_meta_operator: prefix_postfix_meta_operator: infix_circumfix_meta_operator: "
+
+isOperatorName :: String -> Bool
+isOperatorName ('&':opa@(_:opb)) = isOperatorName' opa || isOperatorName' opb
+    where
+    isOperatorName' :: String -> Bool
+    isOperatorName' oper = or (map (flip isPrefixOf oper) fixities)
+isOperatorName _ = False
 
 -- Lexical units --------------------------------------------------
@@ -369 +379 @@
 ruleSubDeclaration :: RuleParser Exp
 ruleSubDeclaration = rule "subroutine declaration" $ do
-    -- namePos <- getPosition
+    namePos <- getPosition
     (scope, typ, isMulti, styp, name) <- tryChoice
         [ ruleSubScopedWithContext
@@ -421 +431 @@
         isBuiltin = ("builtin" `elem` traits)
         isExported = ("export" `elem` traits)
+        
+    -- XXX this belongs in semantic analysis, not in the parser
+    -- also, maybe we should only warn when you try to export an
+    -- operator that is "standard"
+    -- XXX I can't figure out how to do this without trace
+    when (isExported && isOperatorName name) $
+        trace 
+            ("You probably don't want to export an operator name; instead\n\
+  define a new variant on the new operator (eg. multi sub *infix:<+>):" 
+                ++ show name ++ " at " ++ show namePos)
+            (return ())
+            
     -- Don't add the sub if it's unsafe and we're in safemode.
     if "unsafe" `elem` traits && safeMode then return emptyExp else case scope of
@@ -464 +486 @@
             <|> between (char '\171') (char '\187') (many1 $ satisfy (/= '\187'))
     return $ fixity ++ name
-    where
-    fixities = words " prefix: postfix: infix: circumfix: coerce: self: term: postcircumfix: rule_modifier: trait_verb: trait_auxiliary: scope_declarator: statement_control: infix_postfix_meta_operator: postfix_prefix_meta_operator: prefix_postfix_meta_operator: infix_circumfix_meta_operator: "