Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.scl.compiler / tests / org / simantics / scl / compiler / tests / scl / Parsing.scl

diff --git a/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Parsing.scl b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Parsing.scl
new file mode 100644 (file)
index 0000000..0ca342a
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Parsing.scl
@@ -0,0 +1,62 @@
+import "Prelude"\r
+\r
+"""\r
+Parser is a function from a string and a position in the\r
+string to a possible semantics of a substring and the \r
+end of the substring.\r
+"""\r
+data Parser a = Parser (String -> Integer -> Maybe (a, Integer))\r
+\r
+runParser :: Parser a -> String -> Integer -> Maybe (a, Integer)\r
+runParser (Parser f) = f \r
+\r
+instance Functor Parser where\r
+    fmap f (Parser p) = Parser (\input pos -> match p input pos with\r
+        Nothing -> Nothing\r
+        Just (a, newPos) -> Just (f a, newPos)\r
+    )\r
+\r
+instance Monad Parser where\r
+    return x = Parser (\_ pos -> Just (x, pos))    \r
+    (pa >>= f) = Parser (\input pos -> match runParser pa input pos with\r
+        Nothing -> Nothing\r
+        Just (a, newPos) -> runParser (f a) input newPos\r
+    )  \r
+\r
+(|||) :: Parser a -> Parser a -> Parser a\r
+Parser a ||| Parser b = Parser (\input pos -> match a input pos with\r
+    Nothing -> b input pos\r
+    Just x -> Just x\r
+) \r
+\r
+keyword :: String -> Parser ()\r
+keyword word = Parser (\input pos ->\r
+    if regionMatches word 0 input pos (length word)\r
+      then Just ((), pos + (length word))\r
+      else Nothing\r
+)\r
+\r
+data List a = Nil | Cons a (List a)\r
+\r
+listSepL :: Parser () -> Parser a -> Parser (List a)\r
+listSepL sep el = mdo\r
+    head <- el\r
+    tail <- (sep >> listSepL sep el) ||| return Nil\r
+    return (Cons head tail) \r
+\r
+fromList :: List a -> [a]\r
+fromList = unfoldr gen\r
+  where\r
+    gen Nil        = Nothing\r
+    gen (Cons h t) = Just (h, t)\r
+    \r
+listSep :: Parser () -> Parser a -> Parser [a]    \r
+listSep sep el = fmap fromList (listSepL sep el) \r
+\r
+aOrB = (keyword "a" >> return "a") ||| (keyword "b" >> return "b")\r
+\r
+myParser = listSep (keyword ",") aOrB\r
+\r
+main = show (runParser myParser "a,b,b,a" 0)\r
+--\r
+Just (["a", "b", "b", "a"], 7)
\ No newline at end of file