don't swallow superfluous QUALIFIERS before operator

Frege · Feb 18, 2013 · 2c21740 · 2c21740
1 parent 3e38fbd
commit 2c21740
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 8 deletions.
diff --git a/frege/compiler/BaseTypes.fr b/frege/compiler/BaseTypes.fr
@@ -105,12 +105,12 @@ type Offset = Int
 type Flags = BitSet Flag
 
 --- the data structure for tokens along with string, line and columen info
-data Token = !Token { tokid :: TokenID,
-                      value :: String,
-                      line  :: Line,
-                      col   :: Indent,
-                      offset :: Offset  --- offset in characters, 0 originated at beginning of source code
-                      qual :: [Token]   --- up to 2 tokens that are CONID, qualifying an operator (only!)
+data Token = Token  { !tokid  :: TokenID,
+                      !value  :: String,
+                      !line   :: Line,
+                      !col    :: Indent,
+                      !offset :: Offset    --- offset in characters, 0 originated at beginning of source code
+                      !qual   :: [Token]   --- up to 2 tokens that are CONID, qualifying an operator (only!)
                        } where
     isComment Token{tokid}     = tokid.== COMMENT
     noComment Token{tokid}     = tokid.!= COMMENT

diff --git a/frege/compiler/Scanner.fr b/frege/compiler/Scanner.fr
@@ -639,10 +639,10 @@ substOp :: SMCT -> Tree String TokenID -> [Token] -> [Token]
 substOp start tree [] = []
 substOp start tree (q1:q2:ts)       -- this makes qualified operators look like single tokens
     | q1.tokid == QUALIFIER, q2.tokid == QUALIFIER = case substOp start tree ts of
-        (o:os) | o.tokid > LOP0, o.tokid < SOMEOP = o.{qual=[q1,q2]}:os
+        (o:os) | o.tokid > LOP0, o.tokid < SOMEOP, null o.qual = o.{qual=[q1,q2]}:os
         other = q1:q2:other
     | q1.tokid == QUALIFIER  = case substOp start tree (q2:ts) of
-        (o:os) | o.tokid > LOP0, o.tokid < SOMEOP = o.{qual=[q1]}:os
+        (o:os) | o.tokid > LOP0, o.tokid < SOMEOP, null o.qual = o.{qual=[q1]}:os
         other = q1:other
 
 substOp start tree (t:ts)

diff --git a/frege/prelude/Floating.fr b/frege/prelude/Floating.fr
@@ -34,19 +34,24 @@ instance Floating Double where
     -- the following 3 can't be inherited because Double.**, Double.tan and Double.tanh
     -- already exist as native functions and would be inherited from there
     x ** y              =  exp (log x * y)
+    --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Double'
     tan  x              =  sin  x / cos  x
+    --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Double'
     tanh x              =  sinh x / cosh x
 
 instance Floating Float where
     pi = Math.pi.float
     -- the following 3 can't be inherited because Float.**, Float.tan and Float.tanh
     -- already exist as native functions and would be inherited from there
+    --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     x ** y   = exp (log x * y)
     --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     tan  x   = sin  x / cos  x
     --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     tanh x   = sinh x / cosh x
+    --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     acos  f  = (Float.acos f).float
+    --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     asin  f  = (Float.asin f).float
     --- nowarn: already defined in @instance@ 'PrimitiveFloating' 'Float'
     atan  f  = (Float.atan f).float