Difference between revisions of "Embedding context free grammars"

From HaskellWiki
Jump to navigation Jump to search
m
 
(4 intermediate revisions by 3 users not shown)
Line 1: Line 1:
 
Here's how to embed a context free grammar parser into haskell:
  
Here's how to embed a context free grammar parser into haskell:
 
<haskell>
  
<haskell>
  +
−
data Grammar b where
  
  +
−
Ref :: Grammar c
  
  +
import Maybe
−
Tok :: Char -> Grammar c
  
  +
data Grammar a b where
−
Check :: (Char -> Bool) -> Grammar c
  
−
Fix :: Grammar a -> Grammar c
 +
NullParser :: Grammar a b
−
(:|) :: Grammar b -> Grammar b -> Grammar b
 +
Check :: (a -> Bool) -> Grammar a a
−
(:&) :: Grammar b -> Grammar b -> Grammar b
 +
(:|) :: (Grammar a b) -> (Grammar a b) -> Grammar a b
−
Push :: Char -> Grammar a -> Grammar a
 +
Push :: a -> (Grammar a b) -> Grammar a b
−
NullParser :: Grammar b
 +
(:&) :: (Grammar a b) -> (Grammar a c) -> Grammar a (b,c)
  +
FMap :: Grammar a c -> (c -> b) -> Grammar a b
  +
  +
 
infixl 6 :|
  
infixl 6 :|
−
infixl 7 :&
  
   
   
−
parse:: [Char] -> Grammar b -> Grammar b -> Bool
  
−
parse x Ref t = parse x t t
  
−
parse [c] (Tok c') _ = c == c'
  
−
parse [c] (Check y) _ = y c
  
−
parse _ (Tok _) _ = False
  
−
parse _ (Check _) _ = False
  
−
parse x (Fix g) _ = parse x g (Fix g)
  
−
parse x (g :| g') t = parse x g t || parse x g' t --cool little trick!
  
−
parse (x:xs) (g :& g') t = parse xs ((Push x g) :& g') t || (parse [] g t && parse (x:xs) g' t)
  
−
parse x (Push c g) t = parse (c:x) g t
  
−
parse _ NullParser _ = False
  
−
parse [] _ _ = False
  
   
−
parse' x g = parse x g NullParser
 +
tok x = Check (x==)
−
</haskell>
  
   
  +
parse :: [a] -> Grammar a b -> Maybe b
−
and here's a lambda calculus parser written in this embedded language
  
  +
parse [c] (Check y) = if y c then Just c else Nothing
−
<haskell>
  
−
var = Check (\x -> x <= 'z' && x >= 'a')
 +
parse x (g :| g') =
−
app = term :& term
 +
let
  +
r1 = parse x g
−
term = var :| abstraction :| parenedTerm
 
  +
r2 = parse x g'
−
parenedTerm = Tok '(' :& term :& Tok ')'
  
  +
in
−
abstraction = Tok '\\' :& var :& Tok '.' :& term
  
  +
if isJust r1 then r1 else r2
−
top = term :& Tok ';'
  
−
</haskell>
  
   
  +
parse (x:xs) (g :& g') =
−
let's see the results
  
  +
let
−
<haskell>
  
−
print $ parse' "\\x.x;" top
+
r1 = parse xs ((Push x g) :& g')
  +
r2 = parse [] g
−
> True
  
  +
r3 = parse (x:xs) g'
−
</haskell>
  
  +
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) = parse x y >>= f
  +
parse _ _ = Nothing
   
  +
infixl 7 ~&
−
Let's check out a recursive grammar of all strings containing only c's of length at least 1
  
  +
infixl 7 ~&&
  +
infixl 7 ~&&&
  +
infixl 7 ~&&&&
   
  +
(~&) = (:&)
−
<haskell>
  
  +
−
top' = Fix ((Tok 'c' :& Ref) :| Tok 'c')
  
  +
a ~&& b = FMap
−
print $ parse' "cccccc" top'
 
  +
(a :& b)
−
> True
  
  +
(\((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))
 
</haskell>
  
</haskell>
   
  +
and here's a lambda calculus parser
−
Grammar for even parentheses surrounding the letter c
  
   
 
<haskell>
  
<haskell>
  +
−
top' = Fix (Tok '(' :& Ref :& Tok ')' :| Tok 'c')
  
  +
−
print $ parse' "(((c)))" top'
 
  +
data Term = Var Char | App Term Term | Abs Char Term deriving Show
−
> True
  
  +
  +
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
  +
 
</haskell>
  
</haskell>
  +
  +
[[Category:Code]]

Latest revision as of 00:07, 22 February 2010

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) = parse x y >>= f
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
Retrieved from "https://wiki.haskell.org/index.php?title=Embedding_context_free_grammars&oldid=33800"