
I've just written my first real piece of type system hacking in Haskell. I think it turned out okay, but if any of you more experienced folk have suggestions, I'd appreciate them. Code follows. More explanation is at http://cdsmith.wordpress.com/2007/07/19/parsing-cfgs-and-type-hacking/ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} data Var a = Var String data RHS a b = RHS a b (&) = RHS -- a convenient operator infixr 5 & {- (Action a b c) means the following: A production with a right hand side of type: a may be associated with a semantic rule of type: b to produce a rule with semantic result type: c -} class Action a b c | a b -> c, a c -> b instance Action (Var x) (x -> y) y instance Action Char y y instance Action () y y instance (Action a b c) => Action (RHS (Var x) a) (x -> b) c instance (Action a b c) => Action (RHS Char a) b c {- The RuleSet monad is used to define rules of a grammar in a convenient 'do' notation. -} data Rule = forall a b c. (Action a b c) => Rule (Var c, a, b) data RuleSet x = RuleSet ([Rule], x) instance Monad RuleSet where a >>= k = let RuleSet (r1, v1) = a RuleSet (r2, v2) = k v1 in RuleSet (r1 ++ r2, v2) return x = RuleSet ([], x) (==>) :: (Action a b c) => Var c -> a -> b -> RuleSet () (==>) lhs rhs sem = RuleSet ([Rule (lhs, rhs, sem)], ()) infixr 4 ==> {- Grammar. A grammar is a set of rules together with a start symbol. -} data Grammar a = Grammar (Var a) [Rule] grammar s (RuleSet (rs, x)) = Grammar s rs {- Sample grammar. The parentheses in the let bindings are required: they force the rules to be monomorphic, which is needed for type checking to work properly. -} g = let ( expr ) = Var "expression" ( term ) = Var "term" ( termmore ) = Var "term operator" ( fact ) = Var "factor" ( factmore ) = Var "factor operator" ( digit ) = Var "digit" ( digits ) = Var "digits" in grammar expr $ do expr ==> term & termmore $ \x y -> y x termmore ==> () $ \x -> x termmore ==> '+' & term & termmore $ \x y z -> y (x + z) termmore ==> '-' & term & termmore $ \x y z -> y (x - z) term ==> fact & factmore $ \x y -> y x factmore ==> () $ \x -> x factmore ==> '*' & fact & factmore $ \x y z -> y (x * z) factmore ==> '/' & fact & factmore $ \x y z -> y (x / z) fact ==> '(' & expr & ')' $ \x -> x fact ==> digit & digits $ \x y -> y x digits ==> () $ \x -> x digits ==> digit & digits $ \x y z -> y (10*x + z) digit ==> '0' $ 0 digit ==> '1' $ 1 digit ==> '2' $ 2 digit ==> '3' $ 3 digit ==> '4' $ 4 digit ==> '5' $ 5 digit ==> '6' $ 6 digit ==> '7' $ 7 digit ==> '8' $ 8 digit ==> '9' $ 9 Thanks, -- Chris Smith
participants (1)
-
Chris Smith