From 66d316c64dacc4f88d8fd032a98d6bc4750a566f Mon Sep 17 00:00:00 2001
From: Angel Ortega <angel@triptico.com>
Date: Fri, 18 Sep 2009 09:36:42 +0200
Subject: [PATCH] The compiler almost work.

---
 Artemus5.pm | 48 ++++++++++++++++++++++++++++++------------------
 art5        | 20 ++++++++++++++++++++
 2 files changed, 50 insertions(+), 18 deletions(-)

diff --git a/Artemus5.pm b/Artemus5.pm
index af13c48..c2d69ec 100644
--- a/Artemus5.pm
+++ b/Artemus5.pm
@@ -36,13 +36,8 @@ sub compile_c {
 	my $seq		= shift;
 	my @ret		= ();
 
-	# pick opcode first
-	if ($$seq =~ s/^\s*\{?\s*([^\s\{]+)\s*//) {
-		push(@ret, $1);
-	}
-	else {
-		die "Syntax error near $$seq";
-	}
+	# delete leading blanks and a possible brace
+	$$seq =~ s/^\s*\{?\s*//;
 
 	while ($$seq) {
 		if ($$seq =~ s/^"(([^"\\]*(\\.[^"\\]*)*))"\s*//) {
@@ -56,7 +51,7 @@ sub compile_c {
 			$str =~ s/\\"/\"/g;
 			$str =~ s/\\\\/\\/g;
 
-			push(@ret, $str);
+			push(@ret, [ '"', $str ]);
 		}
 		elsif ($$seq =~ s/^'(([^'\\]*(\\.[^'\\]*)*))'\s*//) {
 			# single quoted string
@@ -65,11 +60,11 @@ sub compile_c {
 			$str =~ s/\\'/\'/g;
 			$str =~ s/\\\\/\\/g;
 
-			push(@ret, $str);
+			push(@ret, [ '"', $str ]);
 		}
 		elsif ($$seq =~ s/^(\d+(\.\d+)?)\s*//) {
 			# number
-			push(@ret, $1);
+			push(@ret, [ '"', $1 ]);
 		}
 		elsif ($$seq =~ /^\{\s*/) {
 			# another code sequence
@@ -81,19 +76,34 @@ sub compile_c {
 		}
 		elsif ($$seq =~ s/^%([^\s\{]+)\s*//) {
 			# external hash value
-			push(@ret, [ 'var', $1 ]);
+			push(@ret, [ '%', $1 ]);
 		}
 		elsif ($$seq =~ s/^(\$\d+)\s*//) {
 			# argument
-			push(@ret, $1);
+			push(@ret, [ '$', $1 ]);
 		}
 		elsif ($$seq =~ s/^([^\s\{]+)\s*//) {
 			# code sequence without arguments
+
+			# nothing yet? operator call
+			if (scalar(@ret) == 0) {
+				push(@ret, $1);
+
+				# the rest will be args for this one
+				next;
+			}
+
 			push(@ret, [ $1 ]);
 		}
 		else {
 			die "Syntax error near $$seq";
 		}
+
+		# if arrived here with only one instruction,
+		# we're over
+		if (scalar(@ret) == 1) {
+			return $ret[0];
+		}
 	}
 
 	return [ @ret ];
@@ -125,7 +135,7 @@ sub compile {
 			shift(@stream);
 		}
 		else {
-			push(@ret, $p);
+			push(@ret, [ '"', $p ]);
 		}
 	}
 
@@ -232,7 +242,9 @@ sub init {
 	};
 
 	$self->{op}->{'='} = sub {
-		$self->{op}->{$self->exec($_[0])} = $self->exec($_[1]);
+		$self->{op}->{$self->exec($_[0])} =
+			[ '"', $self->exec($_[1]) ];
+
 		return '';
 	};
 
@@ -270,16 +282,16 @@ sub init {
 		$ret;
 	};
 
-	$self->{op}->{'+'} = sub {
+	$self->{op}->{add} = sub {
 		return ($self->exec($_[0]) || 0) + ($self->exec($_[1]) || 0);
 	};
-	$self->{op}->{'-'} = sub {
+	$self->{op}->{sub} = sub {
 		return ($self->exec($_[0]) || 0) - ($self->exec($_[1]) || 0);
 	};
-	$self->{op}->{'*'} = sub {
+	$self->{op}->{mul} = sub {
 		return ($self->exec($_[0]) || 0) * ($self->exec($_[1]) || 0);
 	};
-	$self->{op}->{'/'} = sub {
+	$self->{op}->{div} = sub {
 		return ($self->exec($_[0]) || 0) / ($self->exec($_[1]) || 1);
 	};
 
diff --git a/art5 b/art5
index 566496b..022cdf8 100644
--- a/art5
+++ b/art5
@@ -50,4 +50,24 @@ my $p = [ '?',
 
 print $a->exec($p), "\n";
 
+use Data::Dumper;
+
+my $c;
+$c = $a->compile("Leading <{%arch}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{? 'Arch: ' %arch}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{mul {add 10 20} 1000}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{? {= 'TEST' 'here'} { TEST }}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{if {eq 1 2} 'Equal' 'Different'}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{if {eq 1 1} 'Equal' 'Different'}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{if {eq 1 2} {'Equal'} {'Different'}}> Trailing");
+print $a->exec($c), "\n";
+$c = $a->compile("Leading <{if {eq 1 1} {'Equal'} {'Different'}}> Trailing");
+print $a->exec($c), "\n";
+
 exit 0;
-- 
2.11.4.GIT