Lambda calculus quotations

From Gallium

Jump to: navigation, search
 $ cat lambda_quot_o.ml
 (* Please keep me in sync with the CVS: camlp4/examples/lambda_quot_o.ml *)
 open Camlp4.PreCast;;
 module CamlSyntax = Camlp4OCamlParser.Make(Camlp4OCamlRevisedParser.Make(Syntax));;
 
 let expr_of_string = CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi;;
 
 module LambdaGram = MakeGram(Lexer);;
 
 let term = LambdaGram.Entry.mk "term";;
 let term_eoi = LambdaGram.Entry.mk "lambda term quotation";;
 
 Camlp4_config.antiquotations := true;;
 
 EXTEND LambdaGram
   GLOBAL: term term_eoi;
   term:
     [ "top"
       [ "fun"; v = var; "->"; t = term -> <:expr< `Lam($v$, $t$) >> ]
     | "app"
       [ t1 = SELF; t2 = SELF           -> <:expr< `App($t1$, $t2$) >> ]
     | "simple"
       [ `ANTIQUOT((""|"term"), a)      -> expr_of_string _loc a
       | v = var                        -> <:expr< `Var($v$) >>
       | "("; t = term; ")"             -> t ]
     ];
   var:
     [[ v = LIDENT               -> <:expr< $str:v$ >>
      | `ANTIQUOT((""|"var"), a) -> expr_of_string _loc a
     ]];
   term_eoi:
     [[ t = term; `EOI -> t ]];
 END;;
 
 let expand_lambda_quot_expr loc _loc_name_opt quotation_contents =
   LambdaGram.parse_string term_eoi loc quotation_contents;;
 
 Syntax.Quotation.add "lam" Syntax.Quotation.DynAst.expr_tag expand_lambda_quot_expr;;
 
 Syntax.Quotation.default := "lam";;
 $ cat lambda_test.ml
 let id = << fun x -> x >>
 
 (* Imported and traduced from CCT *)
 let zero = << fun s -> fun z -> z >>
 let succ = << fun n -> fun s -> fun z -> s n >>
 let one = << $succ$ $zero$ >>
 let iota = << fun x -> z >>
 let rho = << fun m -> fun r -> (s m (m r iota r)) >>
 let rec_nat =
   << fun n -> fun s -> fun z -> n $rho$ $iota$ $rho$ >>
 let plus = << fun n -> fun m -> $rec_nat$ n (fun n -> fun p -> $succ$ p) m >>
 let times = << fun n -> fun m -> $rec_nat$ n (fun n -> fun p -> $plus$ m p) $zero$ >>
 let fact = << fun n -> $rec_nat$ n (fun n -> fun p -> $times$ ($succ$ n) p) $one$ >>
 $ ocamlc -c -I +camlp4 -I +camlp4/Camlp4Parsers -pp camlp4of -o lambda_quot_o.cmo lambda_quot_o.ml
 $ camlp4of ./lambda_quot_o.cmo lambda_test.ml
 let id = `Lam ("x", `Var "x")
 (* Imported and traduced from CCT *)
 let zero = `Lam ("s", `Lam ("z", `Var "z"))
 let succ = `Lam ("n", `Lam ("s", `Lam ("z", `App (`Var "s", `Var "n"))))
 let one = `App (succ, zero)
 let iota = `Lam ("x", `Var "z")
 let rho =
   `Lam ("m",
     `Lam ("r",
       `App (`App (`Var "s", `Var "m"),
         `App (`App (`App (`Var "m", `Var "r"), `Var "iota"), `Var "r"))))
 let rec_nat =
   `Lam ("n",
     `Lam ("s", `Lam ("z", `App (`App (`App (`Var "n", rho), iota), rho))))
 let plus =
   `Lam ("n",
     `Lam ("m",
       `App
         (`App (`App (rec_nat, `Var "n"),
            `Lam ("n", `Lam ("p", `App (succ, `Var "p")))),
         `Var "m")))
 let times =
   `Lam ("n",
     `Lam ("m",
       `App
         (`App (`App (rec_nat, `Var "n"),
            `Lam ("n", `Lam ("p", `App (`App (plus, `Var "m"), `Var "p")))),
         zero)))
 let fact =
   `Lam ("n",
     `App
       (`App (`App (rec_nat, `Var "n"),
          `Lam ("n",
            `Lam ("p", `App (`App (times, `App (succ, `Var "n")), `Var "p")))),
       one))
Personal tools
Espace privé