From 2d668371e27ee9caef00207da8a0c9fa4a1a1bbf Mon Sep 17 00:00:00 2001
From: MadMaurice <madmaurice@zom.bi>
Date: Sun, 4 Apr 2021 22:15:04 +0200
Subject: [PATCH] Rework ctx system

---
 lib/Minilisp.pm | 83 +++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 67 insertions(+), 16 deletions(-)

diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm
index 9644b3a..51c12a2 100644
--- a/lib/Minilisp.pm
+++ b/lib/Minilisp.pm
@@ -93,6 +93,53 @@ sub tokenize {
   return @tokens;
 }
 
+sub ctx_create {
+  my $base = shift || undef;
+  my $vars = shift || {};
+
+  return {
+    base => $base,
+    vars => $vars
+  };
+}
+
+sub ctx_get {
+  my $ctx = shift;
+  my $identifier = shift;
+
+  while (defined $ctx && !exists($ctx->{vars}->{$identifier}))
+    {
+      $ctx = $ctx->{base};
+    }
+
+  die "Variable $identifier does not defined" unless defined $ctx;
+
+  return $ctx->{vars}->{$identifier};
+}
+
+sub ctx_set {
+  my $ctx = shift;
+  my $identifier = shift;
+  my $value = shift;
+
+  $ctx->{vars}->{$identifier} = $value;
+}
+
+sub ctx_assign {
+  my $ctx = shift;
+  my $identifier = shift;
+  my $value = shift;
+
+  while (defined $ctx && !exists($ctx->{vars}->{$identifier}))
+    {
+      $ctx = $ctx->{base};
+    }
+
+  die "Variable $identifier does not defined" unless defined $ctx;
+
+  $ctx->{vars}->{$identifier} = $value;
+}
+
 sub lisp_format {
   my $e = shift;
   if (ref($e) eq "ARRAY")
@@ -330,12 +377,13 @@ my %stdctx = (
 sub parser {
   my @tokens = @_;
   my $expr = parser_prog(\@tokens);
+  my $base_ctx = ctx_create(undef, \%stdctx);
 
   return sub {
-    my $ctx = shift;
-    my $ictx = { %stdctx, %$ctx };
+    my $vars = shift;
+    my $ctx = ctx_create($base_ctx, $vars);
 
-    return $expr->($ictx);
+    return $expr->($ctx);
   }
 }
 
@@ -373,9 +421,7 @@ sub parser_expr {
       return sub {
         my $ctx = shift;
         my $name = $tok->{value};
-        die "Undefined identifier $name" unless
-          exists $ctx->{$name};
-        return $ctx->{$name};
+        return ctx_get($ctx, $name);
       }
     }
   elsif($tok->{type} == KEYWORD)
@@ -460,7 +506,7 @@ sub macro_let {
   my $tok = shift @$ts;
   die "Expected ( after let" unless $tok->{type} == LPAREN;
 
-  my $pctx = {};
+  my $variables = {};
 
   while ($ts->[0]->{type} != RPAREN)
     {
@@ -483,7 +529,7 @@ sub macro_let {
       $tok = shift @$ts;
       die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
 
-      $pctx->{$ident->{value}} = $assignment;
+      $variables->{$ident->{value}} = $assignment;
     }
 
   die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
@@ -493,8 +539,8 @@ sub macro_let {
 
   return sub {
     my $octx = shift;
-    my $ictx = { %$octx };
-    $ictx->{$_} = $pctx->{$_}->($octx) foreach (keys %$pctx);
+    my $ictx = ctx_create($octx);
+    ctx_set($ictx, $_, $variables->{$_}->($octx)) foreach (keys %$variables);
 
     return $inner->($ictx);
   }
@@ -525,12 +571,15 @@ sub macro_lambda {
   return sub {
     my $octx = shift;
     return sub {
-      my $ictx = { %$octx };
+      my $ictx = ctx_create($octx);
       my @pnames = @param_list;
       my @pvals = @_;
-      while ( (my $name = shift @pnames) && (my $val = shift @pvals) )
+
+      while ( @pnames && @pvals )
         {
-          $ictx->{$name} = $val;
+          my $name = shift @pnames;
+          my $val = shift @pvals;
+          ctx_set($ictx, $name, $val);
         }
 
       die "Too many arguments" if scalar(@pvals);
@@ -602,9 +651,11 @@ sub macro_defun {
     my $self = sub {
       return $fn->(@_);
     };
-    $ctx->{$ident->{value}} = $self;
-    $fn = $body->($ctx);
-    $ctx->{$ident->{value}} = $fn;
+    my $ictx = ctx_create($ctx, {
+      '$ident->{value}' => $self,
+    });
+    $fn = $body->($ictx);
+    ctx_set($ctx, $ident->{value}, $fn);
     return $fn;
   }
 }