--- a/experiments/haskell/matcher.hs Sat May 13 00:20:51 2006 +1200
+++ b/experiments/haskell/matcher.hs Sat May 13 03:31:10 2006 +1200
@@ -54,13 +54,16 @@
ident = P.identifier tngTokenizer
integer = P.integer tngTokenizer
punct s = do string s; whiteSpace; return ()
+operator = P.operator tngTokenizer
+comma = P.comma tngTokenizer
readAST = readApp
readApp = do (part : parts) <- sepBy1 readSimple whiteSpace; return $ foldl AstApp part parts
-readMap = try (do entries <- sepBy readMapEntry whiteSpace; return $ AstObject entries)
+readSquare = try (do entries <- sepBy readMapEntry whiteSpace; return $ AstObject entries)
+ <|> try (do entries <- sepBy readApp comma; return $ buildList entries)
readMapEntry = do l <- readSimple; punct ":"; r <- readSimple; return (l, r)
readSimple = do punct "("; v <- readAST; punct ")"; return v
- <|> do punct "["; m <- readMap; punct "]"; return m
+ <|> do punct "["; m <- readSquare; punct "]"; return m
<|> do string "+"; i <- ident; readBinding i
<|> do punct "_"; return AstDiscard
<|> do i <- integer; return $ AstLiteral $ LitInt i
@@ -70,6 +73,9 @@
readBinding i = do punct "@"; v <- readSimple; return $ AstBinding i v
<|> (return $ AstBinding i AstDiscard)
+buildList [] = AstObject []
+buildList (x:xs) = (AstAtom "cons" `AstApp` x) `AstApp` buildList xs
+
sepList s [] = ""
sepList s [x] = x
sepList s (x:xs) = x ++ s ++ sepList s xs
@@ -288,7 +294,7 @@
eval' exp = eval [] (readTng exp)
baseEnv = [ def "cons" "[+car: [+cdr: [First: car Rest: cdr]]]"
- , def "map" "[+f: loop=[(cons +a +d): (cons (f a) (loop d)) Nil:Nil]]"
+ , def "map" "[+f: loop=[(cons +a +d): (cons (f a) (loop d)) +x: x]]"
, defPrim "add" $ \(VLiteral (LitInt i)) -> p $ \(VLiteral (LitInt j)) -> VLiteral (LitInt (i + j))
]
where def nm exp = def' nm $ eval' exp