bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Parsing.scl

   1 import "Prelude"\r
   2 \r
   3 """\r
   4 Parser is a function from a string and a position in the\r
   5 string to a possible semantics of a substring and the \r
   6 end of the substring.\r
   7 """\r
   8 data Parser a = Parser (String -> Integer -> Maybe (a, Integer))\r
   9 \r
  10 runParser :: Parser a -> String -> Integer -> Maybe (a, Integer)\r
  11 runParser (Parser f) = f \r
  12 \r
  13 instance Functor Parser where\r
  14     fmap f (Parser p) = Parser (\input pos -> match p input pos with\r
  15         Nothing -> Nothing\r
  16         Just (a, newPos) -> Just (f a, newPos)\r
  17     )\r
  18 \r
  19 instance Monad Parser where\r
  20     return x = Parser (\_ pos -> Just (x, pos))    \r
  21     (pa >>= f) = Parser (\input pos -> match runParser pa input pos with\r
  22         Nothing -> Nothing\r
  23         Just (a, newPos) -> runParser (f a) input newPos\r
  24     )  \r
  25 \r
  26 (|||) :: Parser a -> Parser a -> Parser a\r
  27 Parser a ||| Parser b = Parser (\input pos -> match a input pos with\r
  28     Nothing -> b input pos\r
  29     Just x -> Just x\r
  30 ) \r
  31 \r
  32 keyword :: String -> Parser ()\r
  33 keyword word = Parser (\input pos ->\r
  34     if regionMatches word 0 input pos (length word)\r
  35       then Just ((), pos + (length word))\r
  36       else Nothing\r
  37 )\r
  38 \r
  39 data List a = Nil | Cons a (List a)\r
  40 \r
  41 listSepL :: Parser () -> Parser a -> Parser (List a)\r
  42 listSepL sep el = mdo\r
  43     head <- el\r
  44     tail <- (sep >> listSepL sep el) ||| return Nil\r
  45     return (Cons head tail) \r
  46 \r
  47 fromList :: List a -> [a]\r
  48 fromList = unfoldr gen\r
  49   where\r
  50     gen Nil        = Nothing\r
  51     gen (Cons h t) = Just (h, t)\r
  52     \r
  53 listSep :: Parser () -> Parser a -> Parser [a]    \r
  54 listSep sep el = fmap fromList (listSepL sep el) \r
  55 \r
  56 aOrB = (keyword "a" >> return "a") ||| (keyword "b" >> return "b")\r
  57 \r
  58 myParser = listSep (keyword ",") aOrB\r
  59 \r
  60 main = show (runParser myParser "a,b,b,a" 0)\r
  61 --\r
  62 Just (["a", "b", "b", "a"], 7)