Difference between revisions of "Embedding context free grammars"
Jump to navigation
Jump to search
Line 14: | Line 14: | ||
infixl 6 :| |
infixl 6 :| |
||
− | infixl 6 :& |
||
Line 51: | Line 50: | ||
Just (f r2) else Nothing |
Just (f r2) else Nothing |
||
parse _ _ = Nothing |
parse _ _ = Nothing |
||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
infixl 7 ~& |
infixl 7 ~& |
||
Line 80: | Line 73: | ||
(a :& b) |
(a :& b) |
||
(\((a,b,c,d,e),f) -> (a,b,c,d,e,f)) |
(\((a,b,c,d,e),f) -> (a,b,c,d,e,f)) |
||
⚫ | |||
⚫ | |||
+ | |||
⚫ | |||
Line 89: | Line 86: | ||
app = term ~& term |
app = term ~& term |
||
− | |||
⚫ | |||
− | |||
⚫ | |||
− | |||
⚫ | |||
term = FMap var Var :| abstraction :| parenedTerm |
term = FMap var Var :| abstraction :| parenedTerm |
Revision as of 19:50, 21 November 2006
Here's how to embed a context free grammar parser into haskell:
import Maybe
data Grammar a b where
NullParser :: Grammar a b
Check :: (a -> Bool) -> Grammar a a
(:|) :: (Grammar a b) -> (Grammar a b) -> Grammar a b
Push :: a -> (Grammar a b) -> Grammar a b
(:&) :: (Grammar a b) -> (Grammar a c) -> Grammar a (b,c)
FMap :: Grammar a c -> (c -> b) -> Grammar a b
infixl 6 :|
tok x = Check (x==)
parse :: [a] -> Grammar a b -> Maybe b
parse [c] (Check y) = if y c then Just c else Nothing
parse x (g :| g') =
let
r1 = parse x g
r2 = parse x g'
in
if isJust r1 then r1 else r2
parse (x:xs) (g :& g') =
let
r1 = parse xs ((Push x g) :& g')
r2 = parse [] g
r3 = parse (x:xs) g'
in
if isJust r1
then r1
else
if (isJust r2) && (isJust r3)
then Just (fromJust r2, fromJust r3)
else Nothing
parse x (Push c g) = parse (c:x) g
parse x (FMap y f) =
let
r1 = parse x y
in
if isJust r1 then
let r2 = fromJust r1
in
Just (f r2) else Nothing
parse _ _ = Nothing
infixl 7 ~&
infixl 7 ~&&
infixl 7 ~&&&
infixl 7 ~&&&&
(~&) = (:&)
a ~&& b = FMap
(a :& b)
(\((a,b),c) -> (a,b,c))
a ~&&& b = FMap
(a :& b)
(\((a,b,c),d) -> (a,b,c,d))
a ~&&&& b = FMap
(a :& b)
(\((a,b,c,d),e) -> (a,b,c,d,e))
a ~&&&&& b = FMap
(a :& b)
(\((a,b,c,d,e),f) -> (a,b,c,d,e,f))
and here's a lambda calculus parser
data Term = Var Char | App Term Term | Abs Char Term deriving Show
var =
(Check (\x -> x <= 'z' && x >= 'a'))
app = term ~& term
term = FMap var Var :| abstraction :| parenedTerm
parenedTerm = FMap
(tok '(' ~& term ~&& tok ')')
(\(a,b,c) -> b)
abstraction = FMap
(tok '\\' ~& var ~&& tok '.' ~&&& term)
(\(a,b,c,d) -> Abs b d)
top = FMap
(term ~& tok ';')
fst
main = print $ parse "\\x.x;" top