Structure literal tokens

Author: nspin

asl/src/ARM/MRAS/ASL/Parser/Lexer.x

@@ -125,12 +125,12 @@ asl :-
 "("   { tok TokLParen    }
 ")"   { tok TokRParen    }
 
-@bin    { str TokBin       }
-@mask   { str TokMask      }
-@int    { str TokInt       }
-@hex    { str TokHex       }
-@real   { str TokReal      }
-@string { str TokString    }
+@bin    { str (TokBin  . readBin)  }
+@mask   { str (TokMask . readMask) }
+@int    { str (TokInt  . read)     }
+@hex    { str (TokHex  . read)     }
+@real   { str (TokReal . readReal) }
+@string { str TokString            }
 
 @ident  { ident }
 
@@ -232,6 +232,6 @@ lexer :: (Token -> P a) -> P a
 lexer = (>>=) tokenP
 -- lexer f = do
 --    t <- tokenP
---    trace (show t) (f t)
+--    show t `trace` f t
 
 }

asl/src/ARM/MRAS/ASL/Parser/Parser.y

@@ -250,10 +250,10 @@ alt ::                                                   { (Maybe ([Pattern], Ma
     | 'otherwise' possibly_empty_block                   { (Nothing, $2)                                }
 
 pattern ::                         { Pattern             }
-    : INT                          { PatInt 0            }
-    | HEX                          { PatHex 0            }
-    | BIN                          { PatBin []           }
-    | MASK                         { PatMask []          }
+    : INT                          { PatInt $1           }
+    | HEX                          { PatHex $1           }
+    | BIN                          { PatBin $1           }
+    | MASK                         { PatMask $1          }
     | IDENT                        { PatIdent (Ident $1) }
     | '(' pattern csl_pattern ')'  { PatTuple ($2 :| $3) }
     ;
@@ -296,11 +296,11 @@ nonempty_block ::              { NonEmpty Statement }
 -- Expressions
 
 aexpr ::                                                { Expr                 }
-    : INT                                               { ExprInt 0            }
-    | HEX                                               { ExprHex 0            }
-    | REAL                                              { ExprReal 0           }
-    | BIN                                               { ExprBin []           }
-    | MASK                                              { ExprMask []          }
+    : INT                                               { ExprInt $1           }
+    | HEX                                               { ExprHex $1           }
+    | REAL                                              { ExprReal $1          }
+    | BIN                                               { ExprBin $1           }
+    | MASK                                              { ExprMask $1          }
     | STRING                                            { ExprStr $1           }
     | qualident                                         { ExprId $1            }
     | qualident '(' csl_expr ')'                        { ExprApp $1 $3        }

asl/src/ARM/MRAS/ASL/Parser/Tokens.hs

@@ -3,10 +3,14 @@
 
 module ARM.MRAS.ASL.Parser.Tokens
     ( Token(..)
+    , readBin
+    , readMask
+    , readReal
     ) where
 
 import Data.Bool
 import Data.Maybe
+import Data.Ratio
 import Control.DeepSeq
 import GHC.Generics (Generic)
 
@@ -17,11 +21,11 @@ data Token =
     | TokIndent
     | TokDedent
 
-    | TokInt       String
-    | TokHex       String
-    | TokReal      String
-    | TokBin       String
-    | TokMask      String
+    | TokInt       Integer
+    | TokHex       Integer
+    | TokReal      Rational
+    | TokBin       [Bool]
+    | TokMask      [Maybe Bool]
     | TokString    String
     | TokIdent     String
     | TokTident    String
@@ -122,3 +126,14 @@ readMaskBit :: Char -> Maybe Bool
 readMaskBit '1' = Just True
 readMaskBit '0' = Just False
 readMaskBit 'x' = Nothing
+
+readBin :: String -> [Bool]
+readBin = map readBit . filter (/= ' ') . init . tail
+
+readMask :: String -> [Maybe Bool]
+readMask = map readMaskBit . filter (/= ' ') . init . tail
+
+readReal :: String -> Rational
+readReal x = read before % 1 + read after % 10^(length after)
+  where
+    (before, '.':after) = span (/= '.') x

asl/test/Recon.hs

@@ -36,22 +36,31 @@ parseDefsM asl = StateT $ ExceptT . return . parseDefs asl
 parseStmtsM :: Monad m => String -> StateT [String] (ExceptT PError m) [Statement]
 parseStmtsM asl = StateT $ \s -> ExceptT (return (fmap (, s) (parseStmts s asl)))
 
-needle = "LExprDots"
+infIx :: Eq a => [a] -> [a] -> Maybe Int
+infIx needle = fmap fst . find (isPrefixOf needle . snd) . zip [0..] . tails
+
+around :: Eq a => Int -> [a] -> [a] -> Maybe [a]
+around n needle haystack = flip fmap (infIx needle haystack) $ \i -> take n (drop i haystack)
+
+n = 60
+needle = "TyExprApp"
 
 recon :: IO ()
 recon = do
     r <- runExceptT . flip runStateT [] $ do
         liftIO (readFile "test/prelude.asl") >>= parseDefsM
         forM_ (topoSort sharedps) $ \ps -> do
             ast <- parseDefsM (_shared_ps_code ps)
-            when (needle `isInfixOf` (show ast)) $ do
-                liftIO . putStrLn $ "sharedps: " ++ _shared_ps_name ps
+            case around n needle (show ast) of
+                Nothing -> return ()
+                Just arnd -> liftIO $ putStrLn $ "sharedps: " ++ _shared_ps_name ps ++ ": " ++ arnd
         forM_ (base ++ fpsimd) $ \insn -> do
             let pss = insn ^.. (insn_classes.traverse._2 <> insn_ps).traverse
             forM_ pss $ \ps -> do
                 ast <- parseStmtsM (_ps_code ps)
-                when (needle `isInfixOf` (show ast)) $ do
-                    liftIO . putStrLn $ "insn: " ++ _insn_file insn
+                case around n needle (show ast) of
+                    Nothing -> return ()
+                    Just arnd -> liftIO $ putStrLn $ "insn: " ++ _insn_file insn ++ ": " ++ arnd
     case r of
         Left err -> die (show err)
         Right _ -> return ()