Skip to content

Commit

Permalink
add support for lifetimes
Browse files Browse the repository at this point in the history
  • Loading branch information
hellerve committed Oct 28, 2019
1 parent 613334a commit f169e56
Show file tree
Hide file tree
Showing 3 changed files with 39 additions and 26 deletions.
13 changes: 8 additions & 5 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -9,16 +9,19 @@ A simple Lens library for Carp.
```clojure
(load "[email protected]:hellerve/lens.carp@master")

(deftype Address [city String street (Pair String Int)])
(deftype Address [
city String
street (Pair String Int)]
)

(defn main []
(let-do [addr (Lens.for Address street)
stre (Lens.for Pair a)
comp (Lens.compose &addr &stre)
data (Address.init @"Berlin" (Street.init 10 @"Paul-Lincke-Ufer"))]
(println* &(~(Lens.get &comp) &data))
(println* &(~(Lens.set &comp) @&data @"no"))
(println* &(Lens.over &comp @&data &(fn [a] (reverse &a))))
data (Address.init @"Berlin" (Pair.init @"Paul-Lincke-Ufer" 10))]
(IO.println &(str (Lens.get &comp &data)))
(IO.println &(str &(Lens.set &comp &data @"Maybachufer")))
(IO.println &(str &(Lens.update &comp &data &reverse)))
)
)
```
Expand Down
11 changes: 7 additions & 4 deletions examples/simple.carp
Original file line number Diff line number Diff line change
@@ -1,14 +1,17 @@
(load "lens.carp")

(deftype Address [city String street (Pair String Int)])
(deftype Address [
city String
street (Pair String Int)]
)

(defn main []
(let-do [addr (Lens.for Address street)
stre (Lens.for Pair a)
comp (Lens.compose &addr &stre)
data (Address.init @"Berlin" (Pair.init @"Paul-Lincke-Ufer" 10))]
(println* &(~(Lens.get &comp) &data))
(println* &(~(Lens.set &comp) @&data @"no"))
(println* &(Lens.over &comp @&data &(fn [a] (reverse &a))))
(IO.println &(str (Lens.get &comp &data)))
(IO.println &(str &(Lens.set &comp &data @"Maybachufer")))
(IO.println &(str &(Lens.update &comp &data &reverse)))
)
)
41 changes: 24 additions & 17 deletions lens.carp
Original file line number Diff line number Diff line change
@@ -1,35 +1,42 @@
(deftype (Lens a b) [
get (Fn [&a] b)
set (Fn [a b] a)
-get (Fn [&a] &b)
-set (Fn [&a b] a)
])

; should be f a b and work with higher orders, but oh well
(deftype (Prism a b) [
get (Fn [&a] (Maybe b))
get (Fn [&a] (Maybe &b))
set (Fn [a b] a)
])

(defmodule Lens
(defn get [l el]
(~(-get l) el))

(defn set [l el v]
(~(-set l) el v))

(defn compose [ab bc]
(Lens.init
(fn [a] (~(get bc) &(~(get ab) a)))
(fn [a] (get bc (get ab a)))
(fn [a c]
(let [inner (~(set bc) (~(get ab) &a) c)]
(~(set ab) a inner)))))
(let [inner (set bc (get ab a) c)]
(set ab a inner)))))

(defn over [l p f]
(let [transformed (~f (~(get l) &p))]
(~(set l) p transformed)))
(defn update [l p f]
(let [transformed (~f (get l p))]
(set l p transformed)))

(defn to-prism [l]
(Prism.init
(fn [a] (Maybe.Just (~(get l) a)))
@(set l)))
;(defn to-prism [l]
; (Prism.init
; (fn [a] (Maybe.Just (get l a)))
; @(-set l)))

(defndynamic for- [t el]
(list 'Lens.init
(list 'fn ['a] (list 'copy (list (Symbol.prefix t el) 'a)))
(Symbol.prefix t (Symbol.join ['set- el]))))
(Symbol.prefix t el)
(list 'fn ['a 'b]
(list (Symbol.prefix t (Symbol.join ['set- el])) '(copy a) 'b))))

(defmacro for [t el]
(Lens.for- t el))
Expand All @@ -41,12 +48,12 @@
(fn [a]
(match (~(get ab) a)
(Maybe.Nothing) (Maybe.Nothing)
(Maybe.Just b) (~(get bc) &b)))
(Maybe.Just b) (~(get bc) b)))
(fn [a c]
(match (~(get ab) &a)
(Maybe.Nothing) a
(Maybe.Just b)
(let [inner (~(set bc) b c)]
(let [inner (~(set bc) @b c)]
(~(set ab) a inner))))))

(defn over [l p f]
Expand Down

0 comments on commit f169e56

Please sign in to comment.