From 03dfa8f1880ed1663a51beb84bd190d5c6250f62 Mon Sep 17 00:00:00 2001
From: MadMaurice <madmaurice@zom.bi>
Date: Mon, 5 Apr 2021 00:26:23 +0200
Subject: [PATCH] Implement let*

---
 lib/Minilisp.pm | 91 ++++++++++++++++++++++++++-----------------------
 t/let.t         | 14 ++++++++
 2 files changed, 63 insertions(+), 42 deletions(-)

diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm
index 3e5f9ce..a20f5b9 100644
--- a/lib/Minilisp.pm
+++ b/lib/Minilisp.pm
@@ -512,51 +512,58 @@ sub parser_call {
   };
 }
 
-sub macro_let {
-  my $ts = shift;
-
-  my $tok = shift @$ts;
-  die "Expected ( after let" unless $tok->{type} == LPAREN;
-
-  my $variables = {};
-
-  while ($ts->[0]->{type} != RPAREN)
-    {
-      $tok = shift @$ts;
-      die "Expected pair in parameter list in let" unless $tok->{type} == LPAREN;
-
-      my $ident = parser_identifier($ts);
-
-      my $assignment;
-      if ($ts->[0]->{type} == RPAREN)
-        {
-          $assignment = sub { return undef };
-        }
-      else
-        {
-          $assignment = parser_expr($ts)
-        }
-
-      $tok = shift @$ts;
-      die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
-
-      $variables->{$ident} = $assignment;
-    }
-
-  die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
-  shift @$ts;
-
-  my $inner = macro_progn($ts);
-
+sub gen_macro_let {
+  my $incremental = shift;
   return sub {
-    my $octx = shift;
-    my $ictx = ctx_create($octx);
-    ctx_set($ictx, $_, $variables->{$_}->($octx)) foreach (keys %$variables);
+    my $ts = shift;
 
-    return $inner->($ictx);
-  }
+    my $tok = shift @$ts;
+    die "Expected ( after let" unless $tok->{type} == LPAREN;
+
+    my @assignments;
+
+    while ($ts->[0]->{type} != RPAREN)
+      {
+        $tok = shift @$ts;
+        die "Expected pair in parameter list in let" unless $tok->{type} == LPAREN;
+
+        my $ident = parser_identifier($ts);
+
+        my $expr;
+        if ($ts->[0]->{type} == RPAREN)
+          {
+            $expr = sub { return undef };
+          }
+        else
+          {
+            $expr = parser_expr($ts)
+          }
+
+        $tok = shift @$ts;
+        die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
+
+        push @assignments, {
+          ident => $ident,
+          expr => $expr
+        };
+      }
+
+    die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
+    shift @$ts;
+
+    my $inner = macro_progn($ts);
+
+    return sub {
+      my $octx = shift;
+      my $ictx = ctx_create($octx);
+      ctx_set($ictx, $_->{ident}, $_->{expr}->($incremental ? $ictx : $octx)) foreach (@assignments);
+
+      return $inner->($ictx);
+    };
+  };
 }
-$macros{let} = \&macro_let;
+$macros{let} = gen_macro_let(0);
+$macros{'let*'} = gen_macro_let(1);
 
 sub macro_lambda {
   my $ts = shift;
diff --git a/t/let.t b/t/let.t
index df2d2be..72bafec 100644
--- a/t/let.t
+++ b/t/let.t
@@ -2,3 +2,17 @@
   (expect "a is 5" (= a 5))
   (expect "b is 6" (= b 6))
   )
+
+(let ((a 'top))
+  (let ((a 'shadow)
+        (b a))
+    (comment b)
+    (expect "let - non incremental context"
+            (equal b 'top))))
+
+(let ((a 'top))
+  (let* ((a 'shadow)
+         (b a))
+    (comment b)
+    (expect "let* - Incremental context"
+            (equal b 'shadow))))