From f169e5648c36fdd4a116ec4ec7ef9fbe3a5984f3 Mon Sep 17 00:00:00 2001
From: hellerve <veit@veitheller.de>
Date: Mon, 28 Oct 2019 14:26:29 +0100
Subject: [PATCH] add support for lifetimes

---
 README.md            | 13 ++++++++-----
 examples/simple.carp | 11 +++++++----
 lens.carp            | 41 ++++++++++++++++++++++++-----------------
 3 files changed, 39 insertions(+), 26 deletions(-)

diff --git a/README.md b/README.md
index 0bf14cb..044b8de 100644
--- a/README.md
+++ b/README.md
@@ -9,16 +9,19 @@ A simple Lens library for Carp.
 ```clojure
 (load "git@github.com: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)))
   )
 )
 ```
diff --git a/examples/simple.carp b/examples/simple.carp
index 09ebaa5..d4dd977 100644
--- a/examples/simple.carp
+++ b/examples/simple.carp
@@ -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)))
   )
 )
diff --git a/lens.carp b/lens.carp
index 1b50e2e..95c0a6d 100644
--- a/lens.carp
+++ b/lens.carp
@@ -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))
@@ -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]