From: Matt S Trout <mst@shadowcat.co.uk>
Date: Thu, 14 Jan 2016 20:59:16 +0000 (+0000)
Subject: beginnings of a shell prototype
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=88eac4d2919ecd4b67a9d7a84d9a813c69d0ccbb;p=scpubgit%2FDX.git

beginnings of a shell prototype
---

diff --git a/bin/protoshell b/bin/protoshell
new file mode 100644
index 0000000..af58203
--- /dev/null
+++ b/bin/protoshell
@@ -0,0 +1,32 @@
+use strictures 2;
+use Module::Runtime qw(use_module);
+use DX::Utils qw(dict deparse);
+use Devel::Dwarn;
+BEGIN { *u = \&use_module }
+
+my $scope = u('DX::Scope')->new(
+  predicates => {
+    map +(
+      $_ => u('DX::Predicate::'.join('', map ucfirst, split '_', $_))->new
+    ), qw(eq member_at is_dict)
+  },
+  globals => dict(),
+  locals => [],
+);
+
+my $exp = u('DX::Expander')->new;
+
+my $tcl = u('Tcl')->new;
+
+foreach my $pred (keys %{$scope->predicates}) {
+  $tcl->CreateCommand($pred => sub {
+    my (undef, undef, undef, @args) = @_;
+    Dwarn [ $pred, $exp->expand_args(@args) ];
+  });
+}
+
+my $rl = u('Caroline')->new;
+
+while (my $line = $rl->readline('$ ')) {
+  $tcl->Eval($line);
+}
diff --git a/lib/DX/Expander.pm b/lib/DX/Expander.pm
new file mode 100644
index 0000000..cd63313
--- /dev/null
+++ b/lib/DX/Expander.pm
@@ -0,0 +1,71 @@
+package DX::Expander;
+
+use DX::Utils qw(:all);
+use DX::Value::True;
+use DX::Value::False;
+use Tcl;
+use DX::Class;
+
+has tcl => (
+  is => 'lazy', builder => sub { Tcl->new },
+  handles => { _split_list => 'SplitList' },
+);
+
+sub expand_args {
+  my ($self, @args) = @_;
+  map { $self->expand_one($_) } @args;
+}
+
+sub expand_proposition {
+  my ($self, $prop) = @_;
+  my ($name, @args) = $self->_split_list($prop);
+  proposition($name, $self->expand_args(@args));
+}
+
+my @exp_t = map { [ qr/\A(\s*)${\$_->[1]}\s*\Z/, 'expand_'.$_->[0] ] } (
+  [ number => qr/([\d.]+)/ ],
+  [ string => qr/'(.*)'/s ],
+  [ bool => qr/(true|false)/ ],
+  [ symbol => qr/([a-zA-Z_][a-zA-Z0-9_]*)/ ],
+  [ dict => qr/{(.*)}/s ],
+  [ array => qr/\[(.*)\]/s ],
+);
+
+sub expand_one {
+  my ($self, $exp) = @_;
+  foreach my $try (@exp_t) {
+    my ($re, $meth) = @$try;
+    $exp =~ $re and return $self->$meth($2, $1);
+  }
+  die 'Uhhhh ... '.$exp;
+}
+
+sub expand_number { number($_[1]) }
+
+sub expand_string {
+  my ($self, $exp, $ws) = @_;
+  return string($exp) unless $ws =~ s/.*\n//s;
+  my $wstrip = length($ws)+1;
+  $exp =~ s/^ {1,$wstrip}//mg;
+  return string($exp);
+}
+
+sub expand_symbol { $_[1] }
+
+sub expand_dict {
+  my ($self, $val) = @_;
+  my @pairs = $self->_split_list($val);
+  die "Uneven dict" if @pairs % 2;
+  dict(map {
+    $pairs[2*$_] => $self->expand_one($pairs[(2*$_)+1])
+  } 0..int($#pairs/2))
+}
+
+sub expand_array { die;
+}
+
+sub expand_bool {
+  ('DX::Value::'.ucfirst($_[1]))->new
+}
+
+1;