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

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