PL/scheme, Procedural Language Handler

• You must use argument aliases while defining a procedure. Because given arguments will be defined with the same name as their aliases in the Scheme code.

CREATE FUNCTION scm_pow(u int, v int)
RETURNS int AS '
(let loop ((v v))
  (if (< v 1) 1
      (* u (loop (- v 1)))))
' LANGUAGE plscheme;

test=# SELECT * FROM scm_pow(2, 5);
 scm_pow 
---------
      32

CREATE FUNCTION scm_backtrace_test(id int, name text)
RETURNS text AS '
(let* ((a (lambda (u v)
            (format "ID: ~s, User Name: ~s" u v)))
       (b (a id name)))
  b)
' LANGUAGE plscheme;

test=# SELECT * FROM scm_backtrace_test(13, 'Volkan');
ERROR:  Uncaugth exception thrown from PL/scheme procedure.
DETAIL:  Guile error output:
Backtrace:
In current input:
   2: 0* (let* ((a (lambda # #)) (b (a id name))) b)
   4: 1* [# 13 "Volkan"]
   3: 2  [simple-format "ID: ~s, User Name: ~s" ...

<unnamed port>:3:13: While evaluating arguments to
simple-format in expression (format "ID: ~s, User Name: ~s" u ...):
<unnamed port>:3:13: Unbound variable: u

CREATE OR REPLACE FUNCTION scm_backtrace_test
(id int, name text) RETURNS text AS '
(let* ((a (lambda (u v)
            (format #f "ID: ~s, User Name: ~s" u v)))
       (b (a id name)))
  b)
' LANGUAGE plscheme;

test=# SELECT * FROM scm_backtrace_test(13, 'Volkan');
     scm_backtrace_test      
-----------------------------
 ID: 13, User Name: "Volkan"
(1 row)

• Record type arguments will get ported as associate lists into the Scheme code. (Nested record types similarly will get ported as nested associative lists.)
• It's only possible to return a record type via INOUT/OUT argument modes.
• While returning a record type, you must return an associative list with the same attributes specified with INOUT/OUT arguments in the procedure decleration.
• Attributes' order in the associative list while returning a record type is not necessary. It'll be put in the right order by PL/scheme.
• It's possible to return nested record types via nesting associative lists one inside another.

CREATE DOMAIN mydom AS int CHECK (VALUE > 5);

CREATE FUNCTION row_with_dom(IN rec record,
                             OUT first int,
                             OUT second mydom)
AS $$
(let ((first (cdar rec))
      (second (cdadr rec)))
  (list (cons "first" first)
        (cons "second" second)))
$$ LANGUAGE plscheme;

test=# CREATE TABLE row_test (u int, v int);
CREATE TABLE
test=# INSERT INTO row_test (u, v) VALUES (1, 2);
INSERT 0 1
test=# INSERT INTO row_test (u, v) VALUES (3, 4);
INSERT 0 1

--
-- Let's violate our domain rule tied to "OUT second mydom".
--
test=# SELECT row_with_dom(row_test) FROM row_test;
ERROR:  value for domain mydom violates check
constraint "mydom_check"

--
-- Trying again with some valid values.
--
test=# UPDATE row_test SET u = (u * 10), v = (v * 20);
UPDATE 2
test=# SELECT row_with_dom(row_test) FROM row_test;
 row_with_dom
--------------
 (40,10)
 (80,30)
(2 rows)

CREATE OR REPLACE FUNCTION nested_rec(INOUT rec record,
                                      OUT len int)
AS $$
(let ((f1 (assoc-ref rec "f1"))
      (f2 (assoc-ref rec "f2")))
  (list
    (cons "rec"
      (list
        (cons "f1" f1)
        (cons "f2" f2)
        (cons "f1,f2"
          (list
            (cons "f1-f2" (- f1 f2))
            (cons "f1*f2" (* f1 f2))))))
  (cons "len" (length rec))))
$$ LANGUAGE plscheme;

--
-- You wanted to see some nested records, right?
--
test=# SELECT * FROM nested_rec(ROW(1, 2));
      rec       | len
----------------+-----
 (1,2,"(-1,2)") |   2
(1 row)

• spi-execute (Function)
• spi-prepare (Function)
• spi-execute-prepared (Function)

CREATE OR REPLACE FUNCTION spi_execute_test()
RETURNS text AS $$
(let* ((ret (spi-execute
              (string-append "UPDATE t "
                             "  SET v = (v / 10) "
                             "  WHERE u % 2 = 0 "
                             "  RETURNING u, v")))
       (status (assoc-ref ret "status"))
       (tuples (assoc-ref ret "returned-tuples")))
  
  (letrec
    ((hash (lambda (lst val)
             ; Produce a signature by summing each
             ; tuple's u*v value.
             (if (null? lst) val
                 ; Tuples are made of vectors. We'll
                 ; just simply reach elements of the
                 ; current tuple through vector
                 ; accessor functions.
                 (hash
                   (cdr lst)
                   (+ val
                     (* (vector-ref (car lst) 0)
                        (vector-ref (car lst) 1))))))))

    (simple-format #f
      "Returned query status:\n~s\nSignature: ~s"
      status (hash tuples 0))))
$$ LANGUAGE plscheme;

test=# BEGIN;
BEGIN

--
-- Sandbox table.
--
test=# CREATE TEMP TABLE t (u, v) AS
test-#   SELECT S.i, (S.i * 10)
test-#     FROM generate_series(1, 5) AS S (i);
SELECT

--
-- Now calling our test function.
--
test=# SELECT spi_execute_test();
                       spi_test                        
-------------------------------------------------------
 Returned query status:
 #<uninterned-symbol spi-ok-update-returning b5e9a620>
 Signature: 20
(1 row)

test=# ROLLBACK;
ROLLBACK

CREATE OR REPLACE FUNCTION spi_prepare_test()
RETURNS text AS $$
(let* ((plan (spi-prepare "SELECT $1, $2"
                          (vector "text" "int4")))
       (ret  (spi-execute-prepared
               plan (vector "example text" "41"))))
  
  (simple-format #f
    (string-append "Returned query status:\n~s\n"
                   "Returned tuples:\n~s")
    (assoc-ref ret "status")
    (assoc-ref ret "returned-tuples")))
$$ LANGUAGE plscheme;

test=# SELECT spi_prepare_test();
              spi_prepare_test
---------------------------------------------
 Returned query status:
 #<uninterned-symbol spi-ok-select b5e44f90>
 Returned tuples:
 (#("example text" 41))
(1 row)

• tg-relid (Integer)
• tg-name (String)
• tg-relname (String)
• tg-tablename (String)
• tg-tableschema (String)
• tg-when (Symbol) [Possible values: tg-before, tg-after]
• tg-event (Symbol) [Possible values: tg-on-insert, tg-on-delete, tg-on-update]
• tg-for (Symbol) [Possible values: tg-for-row, tg-for-stmt]
• tg-tuple-new (Associative List)
• tg-tuple-old (Associative List)

CREATE OR REPLACE FUNCTION valid_uv()
RETURNS trigger AS $$
(let ((u (assoc-ref tg-tuple-new "u"))
      (v (assoc-ref tg-tuple-new "v")))
  (cond
    ((or (> u 100) (< u 0))
      ; Skip INSERT/UPDATE command
      '())
    
    ((= v 0)
      ; Return (u, random(0, 100))
      (list (cons "u" u)
            (cons "v" (random 100))))

    ; Return original NEW tuple.
    (else tg-tuple-new)))
$$ LANGUAGE plscheme;

test=# CREATE TABLE t (u int, v int);
CREATE

test=# CREATE TRIGGER t_valid_uv_trig
test-#   BEFORE INSERT OR UPDATE ON t
test-#   FOR EACH ROW EXECUTE PROCEDURE valid_uv();
CREATE TRIGGER

-- Try to insert an invalid record.
test=# INSERT INTO t VALUES (101, 101);
INSERT 0 0

-- Insert a tuple whose v = 0, that will fire trigger
-- to generate a random number for the v field.
test=# INSERT INTO t VALUES (80, 0) RETURNING (u, v);
   row
---------
 (80,61)
(1 row)

-- Insert a valid record.
test=# INSERT INTO t VALUES (99, 101);
INSERT 0 1

• You can catch any exception that will be raised in an SPI function invocation. (For a list of possible exception symbols, see SQL Error Codes page of the PostgreSQL documentation.)

CREATE OR REPLACE FUNCTION catch_test() RETURNS text AS $$
; Define will be executed query.
(define query
  (lambda ()
    (symbol->string
      (assoc-ref
        (spi-execute "INSERT INTO foo VALUES (1);")
        "status"))))

; Define exception handler
(define handler
  (lambda (key args)
    (string-append "Exception: " (symbol->string key) "\n"
                   "Message: " args)))

(catch 'undefined-table query handler)
$$ LANGUAGE plscheme;

test=# SELECT catch_test();
               catch_test
----------------------------------------
 Exception: undefined-table
 Message: relation "foo" does not exist
(1 row)

• report (Function)

CREATE FUNCTION report_exception() RETURNS boolean AS '
(begin
  (report exception-level "Except me.")
  #t)
' LANGUAGE plscheme;

CREATE FUNCTION report_notice() RETURNS boolean AS '
(begin
  (report notice-level "Notice me.")
  #t)
' LANGUAGE plscheme;

test=# SELECT report_exception();
ERROR:  Except me.

test=# SELECT report_notice();
NOTICE:  Notice me.
 report_notice
---------------
 t
(1 row)

• You can implement your own SRFs in PL/scheme just as in any other PL with one exception: You must specify at least one INOUT/OUT argument in a SRF. (This information will be used for checking returned tuples' attribute integrity.)

CREATE OR REPLACE FUNCTION setof_example_1(OUT foo int)
RETURNS SETOF int AS $$
(list
  '(("foo" . 13))
  '(("foo" . 14)))
$$ LANGUAGE plscheme;

test=# SELECT * FROM setof_example_1();
 foo
-----
  13
  14
(2 rows)

CREATE OR REPLACE FUNCTION setof_example_2(OUT foo int,
                                           OUT bar int)
RETURNS SETOF record AS $$
(list
  '(("foo" . 1) ("bar" . 2))
  '(("foo" . 3) ("bar" . 4)))
$$ LANGUAGE plscheme;

test=# SELECT * FROM setof_example_2();
 foo | bar
-----+-----
   1 |   2
   3 |   4
(2 rows)

• Despite PL/scheme executes every procedure in its own environment, it exposes pl-shared variable accessible within procedures for the lifetime of the current session. Therefore, it's possible to use pl-shared to share data between procedures within the same session.

CREATE FUNCTION set_var(num int) RETURNS int AS '
(let ((oldnum pl-shared))
  (set! pl-shared num)
  oldnum)
' LANGUAGE plscheme;

CREATE FUNCTION get_var()
RETURNS int AS 'pl-shared'
LANGUAGE plscheme;

test=# SELECT set_var(13);
 set_var
---------
      17
(1 row)

test=# SELECT get_var();
 get_var
---------
      13
(1 row)

• All builtin and custom types defined within the PostgreSQL are transferred to Scheme side as plain string outputs via types' typoutput functions.
• Scheme-to-SQL/SQL-to-Scheme data conversions are maintained by data exposition/imposition functions defined in dataconv.scm. You can easily add support for a specific type by placing suitable conversion routines into pl-data-imposers/pl-data-imposers list(s).

--
-- Now I'll try to demonstrate an example for registering
-- `point' SQL data type into data conversion routines.
--

--
-- Modify dataconv.scm as described below:
--
(define pl-data-imposers
  (list
    ;
    ; Point
    ;
    (list
      '("point")
      (lambda (value)
        (let ((token (string-tokenize
                       value char-set:digit)))
          (cons (string->number (car token))
                (string->number (cadr token))))))
  ...))
...
(define pl-data-exposers
  (list
    ;
    ; Point
    ;
    (list
      (lambda (obj)
        (and (pair? obj)
             (number? (car obj))
             (number? (cdr obj))))
      (lambda (obj)
        (string-append
          (number->string (car obj)) ","
          (number->string (cdr obj))))
      (lambda (obj) "point"))
  ...))

--
-- Here goes a procedure with argument of type point.
--
CREATE OR REPLACE FUNCTION y_symmetry(p point)
RETURNS point AS '
; Calculate symmetric of the point through y-axis.
(cons (* (car p) -1)
      (cdr p))
' LANGUAGE plscheme IMMUTABLE;

--
-- Dance like the wind bo!
--
test=# SELECT y_symmetry('123,456'::point);
 y_symmetry 
------------
 (-123,456)
(1 row)

• SQL 1D array data type will get imposed as vector, and vice-versa, vectors will get exposed as their SQL array data type representations.
• Because of conversion routines aren't aware of the size of the array's dimensions, if imposition/exposition of the array fails, procedure execution will fail. Therefore, PL/scheme only allows 1D arrays at the moment. (But this limitation can be removed by modifying conversion routines.)

--
-- Multiple every array item with 2.
--
CREATE OR REPLACE FUNCTION arr_test_1(u int[])
RETURNS int[] AS $$
(list->vector
  (map
    (lambda (n) (* 2 n))
    (vector->list u)))
$$ LANGUAGE plscheme;

test=# SELECT arr_test_1(ARRAY[1,2,3]);
 arr_test_1 
------------
 {2,4,6}
(1 row)

--
-- Return an array with a NULL item.
--
CREATE OR REPLACE FUNCTION arr_test_2()
RETURNS int[] AS $$
(vector 1 2 '() 3)
$$ LANGUAGE plscheme;

test=# SELECT arr_test_2();
  arr_test_2
--------------
 {1,2,NULL,3}
(1 row)

CREATE OR REPLACE FUNCTION arr_test_3(u int[])
RETURNS text AS $$
(object->string u)
$$ LANGUAGE plscheme;

--
-- Pass an array with some NULL values.
--
test=# SELECT arr_test_3(ARRAY[1,2,NULL,3]);
 arr_test_3
-------------
 #(1 2 () 3)
(1 row)

• init.scm file under plscheme[u].module_dir directory will get evaluted just before every procedure execution within the same module interface as the procedure. You can easily customize this file by your needs to effect every procedure that will get evaluted automatically.