gistfile1.hs

instance CoreTransform Expr C.Expr where
  toCore (Int x) = return $ C.Int x
  toCore (Double x) = return $ C.Double x
  toCore (Str x) = return $ C.Str x
  toCore (Bool x) = return $ C.Bool x
  toCore (Group x) = liftM C.Group (toCore x)
  toCore (UnOp UniMinus e) = liftM C.UniMinus (toCore e)
  toCore (UnOp Not e) = liftM C.Not (toCore e)
  toCore (Op Minus e1 e2) = liftM2 C.Minus (toCore e1) (toCore e2)
  toCore (Op Plus e1 e2) = liftM2 C.Plus (toCore e1) (toCore e2)
  toCore (Op Mul e1 e2) = liftM2 C.Mul (toCore e1) (toCore e2)
  toCore (Op Div e1 e2) = liftM2 C.Div (toCore e1) (toCore e2)
  toCore (Op Neq e1 e2) = liftM2 C.Neq (toCore e1) (toCore e2)
  ...

gistfile2.ml

let morph_array_decl klass = function
  | `ArrayDecl (name, typ, dims, e) ->
      let dims = List.map (morph_expr klass) dims 
      and e = morph_expr klass e 
      and typ = conv_type typ in
        (* declare array *)
        add_field klass (make_field name (`TyArray (typ, dims)) None);
        (* allocate and initialize it on first bar *)
        append klass "OnFirstBar" (init_array name typ dims e)

gistfile3.hs

data SyntaxError = 
    SyntaxError TokenPos String
    deriving (Data, Typeable, Eq, Show)

instance Error SyntaxError

data TokenPos 
    = Pos { startLine :: Int
          , startCol :: Int
          , endLine :: Int
          , endCol :: Int
          }
    deriving (Eq, Show, Data, Typeable)

data Expr
    = Int Integer
    | Double Double
    | Str String
    | Bool Bool
    ...
    | TokenPos Expr [TokenPos]
    deriving (Show, Eq, Data, Typeable)

gistfile4.hs

import Data.Generics
import Morpher.Easy.AST

strip :: (Data a) => a -> a
strip = everywhere (mkT f)
    where f (TokenPos a _) = a
          f x = x

gistfile5.hs

import qualified Text.ParserCombinators.Parsec.Pos as P

-- Token location

instance Data P.SourcePos where 
    gfoldl r k x = k x 
    gunfold = error "gunfold:SourcePos:Not implemented"
    toConstr = error "toConstr:SourcePos:Not implemented"
    dataTypeOf = error "dataTypeOf:SourcePos:Not implemented"

typename_SourcePos = mkTyCon "SourcePos"

instance Typeable P.SourcePos
    where typeOf _ = mkTyConApp typename_SourcePos ([])

data Pos 
    = Pos P.SourcePos P.SourcePos

gistfile6.hs

import qualified Text.ParserCombinators.Parsec as P
import Morpher.Easy.AST

instance Data P.ParseError where 
    gfoldl r k x = k x 
    gunfold = error "gunfold:ParseError:Not implemented"
    toConstr = error "toConstr:ParseError:Not implemented"
    dataTypeOf = error "dataTypeOf:ParseError:Not implemented"

typename_ParseError = mkTyCon "ParseError"

instance Typeable P.ParseError
    where typeOf _ = mkTyConApp typename_ParseError ([])

instance Eq P.ParseError where
    _ == _ = False

gistfile7.ml

open Easy_ast

class map = Camlp4Filters.GenerateMap.generated;;

let strip_token_loc = object 
  inherit map as super
  method expr e =
    match super#expr e with
      | `TokenPos (a, _) -> a
      | e                -> e
end

(* statement is the top of the AST *)

let strip_stmt x = strip_token_loc#statement x;;

module Camlp4Trash = struct
  INCLUDE "easy_ast.ml";;
end;;

gistfile8.ml

# type x = [`X of int];;
type x = [ `X of int ]

# type y = [`Y of string ];;
type y = [ `Y of string ]

# type z = [x|y];;
type z = [ `X of int | `Y of string ]

# `X 10;;
- : [> `X of int ] = `X 10

# (`X 10 :> z);;
- : z = `X 10