Stefan pushed to branch master at Stefan / Typer
Commits: f5cb3ff0 by Stefan Monnier at 2017-02-24T00:37:39-05:00 * btl/quote.typer: Simplify/rework
- - - - -
2 changed files:
- btl/quote.typer - opam
Changes:
===================================== btl/quote.typer ===================================== --- a/btl/quote.typer +++ b/btl/quote.typer @@ -1,49 +1,29 @@ % -% f = (qquote (uquote x) * x) (node _*_ [(node_ unquote "x") "x"]) +% f = (quote (uquote x) * x) (node _*_ [(node_ unquote "x") "x"]) % % f = node_ "*" cons (x, cons (symbol_ "x") nil)) % % % => x
-get-head : List Sexp -> Sexp; -get-head x = case x - | cons hd _ => hd - | nil => symbol_ "error"; - -symbol = lambda (y : String) -> (symbol_ y); -string = lambda (y : String) -> (string_ y); -integer = lambda (y : Int) -> (integer_ y); -float = lambda (y : Float) -> (float_ y); -block = lambda (y : List Sexp) -> (block_ y); - -quote' : List Sexp -> List Sexp; - -has-uquote : List Sexp -> Sexp; -has-uquote = lambda y -> - let expr = case y - | cons hd tl => hd - | nil => symbol_ "uquote expects one argument" in - expr; - -% traverse nodes -node : Sexp -> List Sexp -> Sexp; -node = lambda (op : Sexp) -> - lambda (y : List Sexp) -> - case (sexp_eq op (symbol_ "uquote")) - | true => has-uquote y - | false => node_ op (quote' y); - -% tree traversal -quote' = lambda (x : List Sexp) -> - case x - | cons hd tl => ( - let nhd = sexp_dispatch_ (a := Sexp) hd node symbol string integer float block in - let ntl = quote' tl in - cons nhd ntl) - - | nil => nil; +%% FIXME: Should be List.map. +List_map : (a : Type) ≡> (b : Type) ≡> (a -> b) -> List a -> List b; +List_map = lambda a b ≡> lambda f xs -> case xs + | nil => nil + | cons x xs => cons (f x) (List_map f xs); + +%% FIXME: Should be List.head. +List_head : (a : Type) ≡> a -> List a -> a; +List_head = lambda a ≡> lambda x xs -> case xs + | cons x _ => x + | nil => x; + +quote1 : Sexp -> Sexp; +quote1 x = let k = lambda (a : Type) ≡> lambda (_ : a) -> x; + node op y = case (sexp_eq op (symbol_ "uquote")) + | true => List_head (symbol_ "<error>") y + | false => node_ (quote1 op) (List_map quote1 y) + in sexp_dispatch_ x node k k k k k;
% quote definition -qq = lambda (x : List Sexp) -> get-head (quote' x); -quote = Macro_ qq; +quote = Macro_ (lambda x -> quote1 (List_head (symbol_ "<error>") x));
===================================== opam ===================================== --- a/opam +++ b/opam @@ -1 +1,15 @@ -opam-version: "1.2" name: "typer" version: "0.0.0" maintainer: "Stefan Monnier monnier@iro.umontreal.ca" authors: "Stefan Monnier monnier@iro.umontreal.ca, Pierre Delaunay pierre.delaunay@hec.ca" homepage: "https://gitlab.com/monnier/typer" build: [ [make] ] build-test: [make "tests"] install: [make "install"] remove: ["ocamlfind" "remove" "typer"] depends: [ "ocamlfind" {build} ] \ No newline at end of file +opam-version: "1.2" +name: "typer" +version: "0.0.0" +maintainer: "Stefan Monnier monnier@iro.umontreal.ca" +authors: "Stefan Monnier monnier@iro.umontreal.ca, Pierre Delaunay pierre.delaunay@hec.ca" +homepage: "https://gitlab.com/monnier/typer" +build: [ + [make] +] +build-test: [make "tests"] +install: [make "install"] +remove: ["ocamlfind" "remove" "typer"] +depends: [ + "ocamlfind" {build} +]
View it on GitLab: https://gitlab.com/monnier/typer/commit/f5cb3ff0ce40d3dfe8f8f6d5996b753f82a2...