1.1 --- a/experiments/haskell/matcher.hs	Sat May 13 00:20:51 2006 +1200
     1.2 +++ b/experiments/haskell/matcher.hs	Tue Feb 07 11:34:20 2012 -0500
     1.3 @@ -54,13 +54,16 @@
     1.4  ident = P.identifier tngTokenizer
     1.5  integer = P.integer tngTokenizer
     1.6  punct s = do string s; whiteSpace; return ()
     1.7 +operator = P.operator tngTokenizer
     1.8 +comma = P.comma tngTokenizer
     1.9  
    1.10  readAST = readApp
    1.11  readApp = do (part : parts) <- sepBy1 readSimple whiteSpace; return $ foldl AstApp part parts
    1.12 -readMap = try (do entries <- sepBy readMapEntry whiteSpace; return $ AstObject entries)
    1.13 +readSquare =     try (do entries <- sepBy readMapEntry whiteSpace; return $ AstObject entries)
    1.14 +             <|> try (do entries <- sepBy readApp comma; return $ buildList entries)
    1.15  readMapEntry = do l <- readSimple; punct ":"; r <- readSimple; return (l, r)
    1.16  readSimple =    do punct "("; v <- readAST; punct ")"; return v
    1.17 -            <|> do punct "["; m <- readMap; punct "]"; return m
    1.18 +            <|> do punct "["; m <- readSquare; punct "]"; return m
    1.19              <|> do string "+"; i <- ident; readBinding i
    1.20              <|> do punct "_"; return AstDiscard
    1.21              <|> do i <- integer; return $ AstLiteral $ LitInt i
    1.22 @@ -70,6 +73,9 @@
    1.23  readBinding i =     do punct "@"; v <- readSimple; return $ AstBinding i v
    1.24                  <|> (return $ AstBinding i AstDiscard)
    1.25  
    1.26 +buildList [] = AstObject []
    1.27 +buildList (x:xs) = (AstAtom "cons" `AstApp` x) `AstApp` buildList xs
    1.28 +
    1.29  sepList s [] = ""
    1.30  sepList s [x] = x
    1.31  sepList s (x:xs) = x ++ s ++ sepList s xs
    1.32 @@ -288,7 +294,7 @@
    1.33  eval' exp = eval [] (readTng exp)
    1.34  
    1.35  baseEnv = [ def "cons" "[+car: [+cdr: [First: car Rest: cdr]]]"
    1.36 -          , def "map" "[+f: loop=[(cons +a +d): (cons (f a) (loop d)) Nil:Nil]]"
    1.37 +          , def "map" "[+f: loop=[(cons +a +d): (cons (f a) (loop d)) +x: x]]"
    1.38            , defPrim "add" $ \(VLiteral (LitInt i)) -> p $ \(VLiteral (LitInt j)) -> VLiteral (LitInt (i + j))
    1.39            ]
    1.40      where def nm exp = def' nm $ eval' exp