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; } }