From 72eecdf6e84f4fc555030f43ddaa390a37379990 Mon Sep 17 00:00:00 2001
From: Thomas von Dein <tom@izb.net>
Date: Mon, 13 Apr 2020 20:22:46 +0200
Subject: [PATCH] added perl function support

---
 README.md | 16 ++++++++++++++++
 rpnc      | 54 ++++++++++++++++++++++++++++--------------------------
 2 files changed, 44 insertions(+), 26 deletions(-)

diff --git a/README.md b/README.md
index f825992..920a961 100644
--- a/README.md
+++ b/README.md
@@ -156,10 +156,26 @@ function name:
     470
     220
     res2vcc
+    => 2.79
 
 You  can  also  put  the   function  definition  in  the  config  file
 `~/.rpnc`. Empty lines and lines beginning with `#` will be ignored.
 
+Another way  to define a  function is to  use perl code  directly. The
+perl code must  be a closure string and surrounded  by braces. You can
+access the stack via `@_`.  Here's an example:
+
+    f pr { return "1.0 / (" . join(' + ', map { "1.0 / $_"} @_) . ")" }
+    
+This  function  calculates the  parallel  resistance  of a  number  of
+resistors. It adds up all values from the stack. Usage:
+
+    22
+    47
+    330
+    pr
+    => 41.14
+
 
 ## Using STDIN via a PIPE
 
diff --git a/rpnc b/rpnc
index f25d4f1..9d56645 100755
--- a/rpnc
+++ b/rpnc
@@ -157,12 +157,6 @@ my %func    = (
                  }
                },
 
-               'pr' => sub {
-                 # parallel resistance, maybe add ~/.rpncrc support
-                 # where to add such custom functions...
-                 return "1 / (" . join(' + ', map { "1 / $_"} @_) . ")";
-               },
-
                'm' => sub {
                  # median
                  if (scalar @_ >= 2) {
@@ -571,32 +565,39 @@ sub defun {
 
   $custom{$name} = "@tokens";
 
-  $func{$name} = sub {
-    my $max = scalar @_;
-    my @args = reverse(@_);
+  if ($custom{$name} =~ /^\{.*\}$/) {
+    # perl code
+    $func{$name} = sub { return eval "@tokens" };
+  }
+  else {
+    # rpnc code
+    $func{$name} = sub {
+      my $max = scalar @_;
+      my @args = reverse(@_);
 
-    # replace N1..NN with actual args
-    my @body;
-    foreach my $item (@tokens) {
-      if ($item =~ /^([A-Z])(\d+)$/) {
-        my $letter = $1;
-        my $i = $2;
-        if ($i <= $max) {
-          push @body, $args[$i-1];
+      # replace N1..NN with actual stack items
+      my @body;
+      foreach my $item (@tokens) {
+        if ($item =~ /^([A-Z])(\d+)$/) {
+          my $letter = $1;
+          my $i = $2;
+          if ($i <= $max) {
+            push @body, $args[$i-1];
+          }
+          else {
+            print "undefined variable ${letter}${i}!\n";
+            push @body, 0;
+          }
         }
         else {
-          print "undefined variable ${letter}${i}!\n";
-          push @body, 0;
+          push @body, $item;
         }
       }
-      else {
-        push @body, $item;
-      }
-    }
 
-    # execute @body
-    looptokenize("@body");
-  };
+      # execute @body
+      looptokenize("@body");
+    };
+  }
 
   print "function $name() defined.\n" unless $silent;
 }
@@ -646,5 +647,6 @@ Various Commands:                         Functions:
  h    show history of past operations     fs    show list of defined functions
  q    finish (C-d works as well)          Using register: enter R + index, e.g. R1
  ?    print help                          Constants: PI V2 V3
+
 ~;
 }