Data commit

Task/Metaprogramming/00-META.yaml

@@ -0,0 +1,2 @@
+---
+from: http://rosettacode.org/wiki/Metaprogramming

Task/Metaprogramming/00-TASK.txt

@@ -0,0 +1,4 @@
+Name and briefly demonstrate any support your language has for metaprogramming. Your demonstration may take the form of cross-references to other tasks on Rosetta Code. When possible, provide links to relevant documentation. 
+
+For the purposes of this task, "support for metaprogramming" means any way the user can effectively modify the language's syntax that's built into the language (like Lisp macros) or that's conventionally used with the language (like the C preprocessor). Such facilities need not be very powerful: even user-defined infix operators count. On the other hand, in general, neither operator overloading nor <code>eval</code> count. The task author acknowledges that what qualifies as metaprogramming is largely a judgment call.
+

Task/Metaprogramming/ALGOL-68/metaprogramming.alg

@@ -0,0 +1,131 @@
+# This example uses ALGOL 68 user defined operators to add a COBOL-style     #
+# "INSPECT statement" to ALGOL 68                                            #
+#                                                                            #
+# The (partial) syntax of the COBOL INSPECT is:                              #
+#    INSPECT string-variable REPLACING ALL     string BY string              #
+# or INSPECT string-variable REPLACING LEADING string BY string              #
+# or INSPECT string-variable REPLACING FIRST   string BY string              #
+#                                                                            #
+# Because "BY" is a reserved bold word in ALGOL 68, we use "WITH" instead    #
+#                                                                            #
+# We define unary  operators INSPECT, ALL, LEADING and FIRST                 #
+#       and binary operators REPLACING and WITH                              #
+# We choose the priorities of REPLACING and WITH so that parenthesis is not  #
+# needed to ensure the correct interpretation of the "statement"             #
+#                                                                            #
+# We also provide a unary DISPLAY operator for a partial COBOL DISPLAY       #
+# statement                                                                  #
+
+# INSPECTEE is returned by the INSPECT unary operator                        #
+MODE INSPECTEE   = STRUCT( REF STRING item, INT option );
+
+# INSPECTTOREPLACE is returned by the binary REPLACING operator              #
+MODE INSPECTTOREPLACE
+                 = STRUCT( REF STRING item, INT option, STRING to replace );
+# REPLACEMENT is returned by the unary ALL, LEADING and FIRST operators      #
+MODE REPLACEMENT = STRUCT( INT option, STRING replace );
+
+# REPLACING option codes, these are the option values for a REPLACEMENT      #
+INT  replace all     = 1;
+INT  replace leading = 2;
+INT  replace first   = 3;
+
+OP   INSPECT   = ( REF STRING s )INSPECTEE: ( s, 0 );
+OP   ALL       = ( STRING replace )REPLACEMENT: ( replace all,     replace );
+OP   LEADING   = ( STRING replace )REPLACEMENT: ( replace leading, replace );
+OP   FIRST     = ( STRING replace )REPLACEMENT: ( replace first,   replace );
+OP   ALL       = ( CHAR   replace )REPLACEMENT: ( replace all,     replace );
+OP   LEADING   = ( CHAR   replace )REPLACEMENT: ( replace leading, replace );
+OP   FIRST     = ( CHAR   replace )REPLACEMENT: ( replace first,   replace );
+
+OP   REPLACING = ( INSPECTEE inspected, REPLACEMENT replace )INSPECTTOREPLACE:
+                     ( item    OF inspected
+                     , option  OF replace
+                     , replace OF replace
+                     );
+
+OP   WITH      = ( INSPECTTOREPLACE inspected, CHAR   replace with )REF STRING:
+    BEGIN
+        STRING with := replace with;
+        inspected WITH with
+    END; # WITH #
+
+OP   WITH      = ( INSPECTTOREPLACE inspected, STRING replace with )REF STRING:
+    BEGIN
+
+        STRING    to replace  = to replace OF inspected;
+        INT       pos        := 0;
+        STRING    rest       := item OF inspected;
+        STRING    result     := "";
+
+        IF   option OF inspected = replace all
+        THEN
+            # replace all occurances of "to replace" with "replace with"     #
+            WHILE string in string( to replace, pos, rest )
+            DO
+                result +:= rest[ 1 : pos - 1 ] + replace with;
+                rest    := rest[ pos + UPB to replace : ]
+            OD
+
+        ELIF option OF inspected = replace leading
+        THEN
+            # replace leading occurances of "to replace" with "replace with" #
+            WHILE IF string in string( to replace, pos, rest )
+                  THEN
+                      pos = 1
+                  ELSE
+                      FALSE
+                  FI
+            DO
+                result +:= replace with;
+                rest    := rest[ 1 + UPB to replace : ]
+            OD
+
+        ELIF option OF inspected = replace first
+        THEN
+            # replace first occurance of "to replace" with "replace with"    #
+            IF string in string( to replace, pos, rest )
+            THEN
+                result +:= rest[ 1 : pos - 1 ] + replace with;
+                rest    := rest[ pos + UPB to replace : ]
+            FI
+
+        ELSE
+            # unsupported replace option #
+            write( ( newline, "*** unsupported INSPECT REPLACING...", newline ) );
+            stop
+        FI;
+
+        result +:= rest;
+        item OF inspected := result
+    END; # WITH #
+
+OP   DISPLAY = ( STRING s )VOID: write( ( s, newline ) );
+
+
+PRIO REPLACING = 2, WITH = 1;
+
+
+
+
+main: (
+
+    # test the INSPECT and DISPLAY "verbs" #
+
+    STRING  text := "some text";
+    DISPLAY text;
+
+    INSPECT text REPLACING FIRST   "e"    WITH "bbc";
+    DISPLAY text;
+
+    INSPECT text REPLACING ALL     "b"    WITH "X";
+    DISPLAY text;
+
+    INSPECT text REPLACING ALL     "text" WITH "some";
+    DISPLAY text;
+
+    INSPECT text REPLACING LEADING "som"  WITH "k";
+    DISPLAY text
+
+
+)

Task/Metaprogramming/Arturo/metaprogramming-1.arturo

@@ -0,0 +1,9 @@
+sumThemUp: function [x,y][
+    x+y
+]
+
+alias.infix '--> 'sumThemUp
+
+do [
+    print 3 --> 4
+]

Task/Metaprogramming/Arturo/metaprogramming-2.arturo

@@ -0,0 +1,2 @@
+code: "print 123"
+do code

Task/Metaprogramming/Arturo/metaprogramming-3.arturo

@@ -0,0 +1,8 @@
+myvar: "iAmAVariable"
+
+let myvar 2
+
+print myvar         ; print the name of the variable
+
+print var myvar     ; print the value of the variable
+print iAmAVariable ; the same

Task/Metaprogramming/Arturo/metaprogramming-4.arturo

@@ -0,0 +1,9 @@
+block: [print]
+block: block ++ to :integer "34"
+
+print "Here is our code:"
+print as.code block
+
+print ""
+print "And here's its result:"
+do block

Task/Metaprogramming/C/metaprogramming-1.c

@@ -0,0 +1,12 @@
+// http://stackoverflow.com/questions/3385515/static-assert-in-c
+#define STATIC_ASSERT(COND,MSG) typedef char static_assertion_##MSG[(!!(COND))*2-1]
+// token pasting madness:
+#define COMPILE_TIME_ASSERT3(X,L) STATIC_ASSERT(X,static_assertion_at_line_##L)
+#define COMPILE_TIME_ASSERT2(X,L) COMPILE_TIME_ASSERT3(X,L)
+#define COMPILE_TIME_ASSERT(X)    COMPILE_TIME_ASSERT2(X,__LINE__)
+
+COMPILE_TIME_ASSERT(sizeof(long)==8);
+int main()
+{
+    COMPILE_TIME_ASSERT(sizeof(int)==4);
+}

Task/Metaprogramming/C/metaprogramming-2.c

@@ -0,0 +1,9 @@
+//requires C99
+#define ITERATE_LIST(n, list) \
+ for(Node *n = (list)->head; n; n = n->next)
+
+...
+ITERATE_LIST(n, list)
+{
+    printf("node value: %s\n", n->value);
+}

Task/Metaprogramming/C/metaprogramming-3.c

@@ -0,0 +1,3 @@
+#define my_min(x, y) ((x) < (y) ? (x) : (y))
+...
+printf("%f %d %ll\n", my_min(0.0f, 1.0f), my_min(1,2), my_min(1ll, 2ll));

Task/Metaprogramming/C/metaprogramming-4.c

@@ -0,0 +1,45 @@
+#define  Str_init(_V_)       char * _V_=NULL;
+
+#define  Free_secure(_X_)    if(_X_) { free(_X_); _X_=NULL; }
+
+#define  Let(_X_,_Y_)       \
+    do{\
+       if(_X_) free(_X_);\
+       int len = strlen(_Y_);\
+       _X_ = (char*)calloc( len + 1, 1);\
+       if(_X_) { memcpy(_X_, _Y_, len); }\
+       else { perror("\033[38;5;196mLet: No hay memoria para <"#_X_">(CALLOC)\n\033[0m"); }\
+    }while(0);
+
+/* inicia el trabajo con el stack */
+#define  Stack       if( (PILA_GADGET = 1) )
+
+/* finaliza el trabajo con el stack. La pila debe quedar en "0" */
+#define  Stack_off   \
+      PILA_GADGET = 0; \
+      if(CONTADOR_PILA>=0){ Msg_red("Proceso termina con stack ocupado: borro sobrante\n");\
+      CONTADOR_PILA=-1; }
+
+/*
+   STORE almacena el valor en la variable indicada, obtenido desde el
+   stack. */
+#define Store(_X_,_Y_)   \
+ do{\
+   _Y_;\
+   if(PILA_GADGET){\
+       if( CONTADOR_PILA>=0 ){\
+           Let(_X_, pila_de_trabajo[CONTADOR_PILA]);CONTADOR_PILA--;\
+       }\
+   }else{ Msg_amber("Store: No hay datos en la pila");}\
+ }while(0);
+...
+#define Main  \
+        int main(int argc, char* argv[]){\
+            __TOKEN__=NULL;\
+            Init_token();\
+            Init_stack;
+
+/* SALIDA NORMAL */
+#define End              End_token(); \
+                         Free_stack_str;\
+                         return(0); }

Task/Metaprogramming/C/metaprogramming-5.c

@@ -0,0 +1,21 @@
+#include <gadget/gadget.h>
+LIB_GADGET_START
+
+Main
+   String w, v="María tenía un corderito";
+
+   Stack{
+       Store( v, Substr(v, Str_at("tenía",v),Str_len( Upper(v) )) );
+       Store( v, Trim(Left( Upper(v), Str_at("CORDERITO",Upper(v))-1)));
+   }Stack_off;
+
+   Print "msg stack : [%s]\n\n", v;
+
+   Let( v, "María tenía un corderito");
+
+  /* Str_len() sirve sin stack, pero en este caso es mejor usar strlen() de C. */
+   w = Substr(v, Str_at("tenía",v),Str_len(v));
+   Print "msg normal: %s\n", w;
+
+   Free secure w,v;
+End

Task/Metaprogramming/C/metaprogramming-6.c

@@ -0,0 +1,3 @@
+#define Throw(_X_)       if( !Is_ok ) { goto _X_; }
+#define Exception(_H_)   _H_: if( !Is_ok++ )
+#define Assert(_X_,_Y_)  if( !(_X_) ) { Is_ok=0; goto _Y_; }

Task/Metaprogramming/C/metaprogramming-7.c

@@ -0,0 +1,19 @@
+#include <gadget/gadget.h>
+LIB_GADGET_START
+
+Main
+      int retVal=0;
+      Assert( Arg_count == 2, fail_input );
+      Get_arg_str( filename, 0 );
+      Get_arg_float( number, 1 );
+
+      Print "First argument (filename) = %s\n", filename;
+      Print "Second argument (a number) = %f\n", number;
+
+      Free secure filename;
+
+   Exception( fail_input ){
+      Msg_yellow("Use:\n  ./prog <number>\n");
+      retVal=1;
+   }
+Return( retVal );

Task/Metaprogramming/C/metaprogramming-8.c

@@ -0,0 +1,35 @@
+/* declara un array vacío */
+#define New_mt_array(_X_)  \
+    MT_CELL *_X_ = NULL;\
+    Define_New_Array(_X_)\
+    _X_##_data.type = MULTI_TYPE;
+....
+/* acceso a celdas string */
+#define sCell(_X_,...) CONCAT2(Cell_mtstr, COUNT_ARGUMENTS(__VA_ARGS__))(_X_, ##__VA_ARGS__)
+
+#define Cell_mtstr1(_X_,ARG1)              (_X_[ ARG1 ].value)
+#define Cell_mtstr2(_X_,ARG1,ARG2)         (_X_[ ( ARG1 ) * ( _X_##_data.cols ) + ( ARG2 ) ].value)
+#define Cell_mtstr3(_X_,ARG1,ARG2,ARG3)    (_X_[ ( ( ARG1 ) * ( _X_##_data.cols ) + ( ARG2 ) ) + \
+                                           ( ARG3 ) * ( _X_##_data.cols * _X_##_data.rows ) ].value)
+...
+/* acceso a celdas long */
+#define lCell(_X_,...) CONCAT2(Cell_mtlng, COUNT_ARGUMENTS(__VA_ARGS__))(_X_, ##__VA_ARGS__)
+
+#define Cell_mtlng1(_X_,ARG1)              *((long *)(_X_[ ARG1 ].value))
+#define Cell_mtlng2(_X_,ARG1,ARG2)         *((long *)(_X_[ ( ARG1 ) * ( _X_##_data.cols ) + ( ARG2 ) ].value))
+#define Cell_mtlng3(_X_,ARG1,ARG2,ARG3)    *((long *)(_X_[ ( ( ARG1 ) * ( _X_##_data.cols ) + ( ARG2 ) ) + \
+                                           ( ARG3 ) * ( _X_##_data.cols * _X_##_data.rows ) ].value))
+
+...
+/* RANGOS para acceso iterado */
+#define Range_for(_X_, ...)  CONCAT2(Range_for, COUNT_ARGUMENTS(__VA_ARGS__))(_X_, ##__VA_ARGS__)
+
+/* para un array 1D */
+#define Range_for3(_X_,A1,A2,A3)  \
+        _X_##_data.rowi=A1;_X_##_data.rowinc=A2;_X_##_data.rowe=A3;
+
+/* para un array 2D */
+#define Range_for6(_X_,A1,A2,A3,B1,B2,B3) \
+        _X_##_data.rowi=A1;_X_##_data.rowinc=A2;_X_##_data.rowe=A3; \
+        _X_##_data.coli=B1;_X_##_data.colinc=B2;_X_##_data.cole=B3;
+....

Task/Metaprogramming/C/metaprogramming-9.c

@@ -0,0 +1,68 @@
+#include <gadget/gadget.h>
+
+LIB_GADGET_START
+
+void Muestra_archivo_original();
+
+Main
+   Assert (Exist_file("load_matrix.txt"), file_not_found);
+
+   /* recupero informacion del archivo para su apertura segura */
+   F_STAT dataFile = Stat_file("load_matrix.txt");
+   Assert (dataFile.is_matrix, file_not_matrixable)  // tiene forma de matriz???
+
+   New multitype test;
+
+   /* The data range to be read is established.
+      It is possible to read only part of the file using these ranges. */
+   Range for test [0:1:dataFile.total_lines-1, 0:1:dataFile.max_tokens_per_line-1];
+
+   /* cargamos el array detectando números enteros como long */
+   test = Load_matrix_mt( pSDS(test), "load_matrix.txt", dataFile, DET_LONG);
+
+   /* modifica algunas cosas del archivo */
+   Let( $s-test[0,1], "Columna 1");
+   $l-test[2,1] = 1000;
+   $l-test[2,2] = 2000;
+
+   /* inserto filas */
+   /* preparo la fila a insertar */
+   New multitype nueva_fila;
+   sAppend_mt(nueva_fila,"fila 3.1");  /* sAppend_mt() and Append_mt() are macros */
+   Append_mt(nueva_fila,float,0.0);
+   Append_mt(nueva_fila,int,0);
+   Append_mt(nueva_fila,double,0.0);
+   Append_mt(nueva_fila,long, 0L);
+
+   /* insertamos la misma fila en el array, 3 veces */
+   test = Insert_row_mt(pSDS(test),pSDS(nueva_fila), 4);
+   test = Insert_row_mt(pSDS(test),pSDS(nueva_fila), 4);
+   test = Insert_row_mt(pSDS(test),pSDS(nueva_fila), 4);
+   Free multitype nueva_fila;
+
+   Print "\nGuardando archivo en \"save_matrix.txt\"...\n";
+   DEC_PREC = 20; /* establece precision decimal */
+
+   All range for test;
+   Save_matrix_mt(SDS(test), "save_matrix.txt" );
+
+   Free multitype test;
+
+   Print "\nArchivo original:\n";
+   Muestra_archivo_original();
+
+   Exception( file_not_found ){
+      Msg_red("File not found\n");
+   }
+   Exception( file_not_matrixable ){
+      Msg_red("File is not matrixable\n");
+   }
+
+End
+
+void Muestra_archivo_original(){
+    String csys;
+    csys = `cat load_matrix.txt`;
+    Print "\n%s\n", csys;
+    Free secure csys;
+}

Task/Metaprogramming/Common-Lisp/metaprogramming-1.lisp

@@ -0,0 +1,10 @@
+(loop for count from 1
+      for x in '(1 2 3 4 5)
+      summing x into sum
+      summing (* x x) into sum-of-squares
+      finally
+        (return
+          (let* ((mean (/ sum count))
+                 (spl-var (- (* count sum-of-squares) (* sum sum)))
+                 (spl-dev (sqrt (/ spl-var (1- count)))))
+            (values mean spl-var spl-dev))))

Task/Metaprogramming/Common-Lisp/metaprogramming-2.lisp

@@ -0,0 +1,35 @@
+[5]>
+  (macroexpand'
+     (loop for count from 1
+           for x in '(1 2 3 4 5)
+           summing x into sum
+           summing (* x x) into sum-of-squares
+           finally
+             (return
+               (let* ((mean (/ sum count))
+                      (spl-var (- (* count sum-of-squares) (* sum sum)))
+                      (spl-dev (sqrt (/ spl-var (1- count)))))
+                 (values mean spl-var spl-dev)))))
+(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
+ (BLOCK NIL
+  (LET ((COUNT 1))
+   (LET ((#:LIST-3047 '(1 2 3 4 5)))
+    (PROGN
+     (LET ((X NIL))
+      (LET ((SUM-OF-SQUARES 0) (SUM 0))
+       (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
+        (TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:LIST-3047) (LOOP-FINISH))
+         (SETQ X (CAR #:LIST-3047))
+         (PROGN (SETQ SUM (+ SUM X))
+          (SETQ SUM-OF-SQUARES (+ SUM-OF-SQUARES (* X X))))
+         (PSETQ COUNT (+ COUNT 1)) (PSETQ #:LIST-3047 (CDR #:LIST-3047))
+         (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
+         (MACROLET
+          ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
+          (PROGN
+           (RETURN
+            (LET*
+             ((MEAN (/ SUM COUNT))
+              (SPL-VAR (- (* COUNT SUM-OF-SQUARES) (* SUM SUM)))
+              (SPL-DEV (SQRT (/ SPL-VAR (1- COUNT)))))
+             (VALUES MEAN SPL-VAR SPL-DEV)))))))))))))) ; T

Task/Metaprogramming/Common-Lisp/metaprogramming-3.lisp

@@ -0,0 +1,29 @@
+(system::expand-form
+    '(loop for count from 1
+           for x in '(1 2 3 4 5)
+           summing x into sum
+           summing (* x x) into sum-of-squares
+           finally
+             (return
+               (let* ((mean (/ sum count))
+                      (spl-var (- (* count sum-of-squares) (* sum sum)))
+                      (spl-dev (sqrt (/ spl-var (1- count)))))
+                 (values mean spl-var spl-dev))))))
+(BLOCK NIL
+ (LET ((COUNT 1))
+  (LET ((#:LIST-3230 '(1 2 3 4 5)))
+   (LET ((X NIL))
+    (LET ((SUM-OF-SQUARES 0) (SUM 0))
+     (TAGBODY SYSTEM::BEGIN-LOOP
+      (WHEN (ENDP #:LIST-3230) (GO SYSTEM::END-LOOP))
+      (SETQ X (CAR #:LIST-3230))
+      (PROGN (SETQ SUM (+ SUM X))
+       (SETQ SUM-OF-SQUARES (+ SUM-OF-SQUARES (* X X))))
+      (PSETQ COUNT (+ COUNT 1)) (PSETQ #:LIST-3230 (CDR #:LIST-3230))
+      (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
+      (RETURN-FROM NIL
+       (LET*
+        ((MEAN (/ SUM COUNT))
+         (SPL-VAR (- (* COUNT SUM-OF-SQUARES) (* SUM SUM)))
+         (SPL-DEV (SQRT (/ SPL-VAR (1- COUNT)))))
+        (VALUES MEAN SPL-VAR SPL-DEV)))))))))

Task/Metaprogramming/Common-Lisp/metaprogramming-4.lisp

@@ -0,0 +1,8 @@
+;; The -> notation is not part of Lisp, it is used in examples indicate the output of a form.
+;;
+;;
+(comprehend 'list-monad (cons x y) (x '(1 2 3)) (y '(A B C)))
+
+     -> ((1 . A) (1 . B) (1 . C)
+         (2 . A) (2 . B) (2 . C)
+         (3 . A) (3 . B) (3 . C))

Task/Metaprogramming/Common-Lisp/metaprogramming-5.lisp

@@ -0,0 +1,2 @@
+(identity-comp (list x y z) (x 1) (y (* 3 x)) (z (+ x y)))
+->  (1 3 4)

Task/Metaprogramming/Common-Lisp/metaprogramming-6.lisp

@@ -0,0 +1,99 @@
+(defgeneric monadic-map (monad-class function))
+
+(defgeneric monadic-join (monad-class container-of-containers &rest additional))
+
+(defgeneric monadic-instance (monad-class-name))
+
+(defmacro comprehend (monad-instance expr &rest clauses)
+  (let ((monad-var (gensym "CLASS-")))
+    (cond
+      ((null clauses) `(multiple-value-call #'monadic-unit
+                         ,monad-instance ,expr))
+      ((rest clauses) `(let ((,monad-var ,monad-instance))
+                         (multiple-value-call #'monadic-join ,monad-var
+                           (comprehend ,monad-var
+                             (comprehend ,monad-var ,expr ,@(rest clauses))
+                             ,(first clauses)))))
+      (t (destructuring-bind (var &rest container-exprs) (first clauses)
+           (cond
+             ((and var (symbolp var))
+              `(funcall (monadic-map ,monad-instance (lambda (,var) ,expr))
+                        ,(first container-exprs)))
+             ((and (consp var) (every #'symbolp var))
+              `(multiple-value-call (monadic-map ,monad-instance
+                                                 (lambda (,@var) ,expr))
+                                     ,@container-exprs))
+             (t (error "COMPREHEND: bad variable specification: ~s" vars))))))))
+
+(defmacro define-monad (class-name
+                        &key comprehension
+                             (monad-param (gensym "MONAD-"))
+                             bases slots initargs
+                              ((:map ((map-param)
+                                      &body map-body)))
+                              ((:join ((join-param
+                                        &optional
+                                          (j-rest-kw '&rest)
+                                          (j-rest (gensym "JOIN-REST-")))
+                                        &body join-body)))
+                              ((:unit ((unit-param
+                                        &optional
+                                          (u-rest-kw '&rest)
+                                          (u-rest (gensym "UNIT-REST-")))
+                                       &body unit-body))))
+  `(progn
+     (defclass ,class-name ,bases ,slots)
+     (defmethod monadic-instance ((monad (eql ',class-name)))
+       (load-time-value (make-instance ',class-name ,@initargs)))
+     (defmethod monadic-map ((,monad-param ,class-name) ,map-param)
+       (declare (ignorable ,monad-param))
+       ,@map-body)
+     (defmethod monadic-join ((,monad-param ,class-name)
+                              ,join-param &rest ,j-rest)
+       (declare (ignorable ,monad-param ,j-rest))
+       ,@join-body)
+     (defmethod monadic-unit ((,monad-param ,class-name)
+                              ,unit-param &rest ,u-rest)
+       (declare (ignorable ,monad-param ,u-rest))
+       ,@unit-body)
+     ,@(if comprehension
+         `((defmacro ,comprehension (expr &rest clauses)
+             `(comprehend (monadic-instance ',',class-name)
+                          ,expr  ,@clauses))))))
+
+(defmethod monadic-map ((monad symbol) function)
+  (monadic-map (monadic-instance monad) function))
+
+(defmethod monadic-join ((monad symbol) container-of-containers &rest rest)
+  (apply #'monadic-join (monadic-instance monad) container-of-containers rest))
+
+(defmethod monadic-unit ((monad symbol) element &rest rest)
+  (apply #'monadic-unit (monadic-instance monad) element rest))
+
+(define-monad list-monad
+  :comprehension list-comp
+  :map ((function) (lambda (container) (mapcar function container)))
+  :join ((list-of-lists) (reduce #'append list-of-lists))
+  :unit ((element) (list element)))
+
+(define-monad identity-monad
+  :comprehension identity-comp
+  :map ((f) f)
+  :join ((x &rest rest) (apply #'values x rest))
+  :unit ((x &rest rest) (apply #'values x rest)))
+
+(define-monad state-xform-monad
+  :comprehension state-xform-comp
+  :map ((f)
+          (lambda (xformer)
+            (lambda (s)
+               (identity-comp (values (funcall f x) new-state)
+                              ((x new-state) (funcall xformer s))))))
+  :join ((nested-xformer)
+           (lambda (s)
+             (identity-comp (values x new-state)
+                            ((embedded-xformer intermediate-state)
+                             (funcall nested-xformer s))
+                            ((x new-state)
+                             (funcall embedded-xformer intermediate-state)))))
+  :unit ((x) (lambda (s) (values x s))))

Task/Metaprogramming/D/metaprogramming.d

@@ -0,0 +1,10 @@
+enum GenStruct(string name, string fieldName) =
+    "struct " ~ name ~ "{ int " ~ fieldName ~ "; }";
+
+// Equivalent to:  struct Foo { int bar; }
+mixin(GenStruct!("Foo", "bar"));
+
+void main() {
+    Foo f;
+    f.bar = 10;
+}

Task/Metaprogramming/Forth/metaprogramming-1.fth

@@ -0,0 +1,35 @@
+\ BRANCH and LOOP COMPILERS
+
+\ branch offset computation operators
+: AHEAD    ( -- addr)  HERE   0 , ;
+: BACK     ( addr -- ) HERE   - , ;
+: RESOLVE  ( addr -- ) HERE OVER - SWAP ! ;
+
+\ LEAVE stack is called L0. It is initialized by QUIT.
+: >L        ( x -- ) ( L: -- x )  2 LP +!  LP @ ! ;
+: L>        ( -- x )  ( L: x -- ) LP @ @   -2 LP +! ;
+
+\ finite loop compilers
+: DO        ( -- ) POSTPONE <DO>     HERE 0 >L   3 ;  IMMEDIATE
+: ?DO       ( -- ) POSTPONE <?DO>    HERE 0 >L   3 ;  IMMEDIATE
+: LEAVE     ( -- ) ( L: -- addr )
+            POSTPONE UNLOOP   POSTPONE BRANCH AHEAD >L ; IMMEDIATE
+
+: RAKE      ( -- ) ( L: 0 a1 a2 .. aN -- )
+            BEGIN  L> ?DUP WHILE  RESOLVE  REPEAT ;   IMMEDIATE
+
+: LOOP      ( -- )  3 ?PAIRS POSTPONE <LOOP>  BACK  RAKE ; IMMEDIATE
+: +LOOP     ( -- )  3 ?PAIRS POSTPONE <+LOOP> BACK  RAKE ; IMMEDIATE
+
+\ conditional branches
+: IF          ( ? -- ) POSTPONE ?BRANCH AHEAD 2 ;        IMMEDIATE
+: THEN        ( -- )  ?COMP  2 ?PAIRS RESOLVE ;          IMMEDIATE
+: ELSE        ( -- )  2 ?PAIRS  POSTPONE BRANCH AHEAD SWAP 2
+                      POSTPONE THEN 2 ;                  IMMEDIATE
+
+\ infinite loop compilers
+: BEGIN       ( -- addr n) ?COMP HERE  1  ;              IMMEDIATE
+: AGAIN       ( -- )   1 ?PAIRS POSTPONE BRANCH BACK   ;  IMMEDIATE
+: UNTIL       ( ? -- ) 1 ?PAIRS POSTPONE ?BRANCH BACK  ;  IMMEDIATE
+: WHILE       ( ? -- ) POSTPONE IF  2+  ;                IMMEDIATE
+: REPEAT      ( -- )   2>R POSTPONE AGAIN  2R> 2- POSTPONE THEN ; IMMEDIATE

Task/Metaprogramming/Forth/metaprogramming-2.fth

@@ -0,0 +1,10 @@
+ : CHARSET    [CHAR] ~  [CHAR] ! DO  I EMIT LOOP ;
+
+: >DIGIT ( n -- c) DUP 9 > IF  7 +  THEN [CHAR] 0 + ;
+
+: -TRAILING  ( adr len -- adr len')  \ remove trailing blanks (spaces)
+             BEGIN
+                2DUP + 1- C@ BL =    \ test if last char = blank
+             WHILE
+                1-                   \ dec. length
+             REPEAT ;

Task/Metaprogramming/FreeBASIC/metaprogramming.basic

@@ -0,0 +1,16 @@
+' FB 1.05.0 Win64
+
+#Macro ForAll(C, S)
+For _i as integer = 0 To Len(s)
+#Define C (Chr(s[_i]))
+#EndMacro
+
+#Define In ,
+
+Dim s As String = "Rosetta"
+ForAll(c in s)
+  Print c; " ";
+Next
+
+Print
+Sleep

Task/Metaprogramming/Go/metaprogramming.go

@@ -0,0 +1,24 @@
+package main
+
+import "fmt"
+
+type person struct{
+    name string
+    age int
+}
+
+func copy(p person) person {
+    return person{p.name, p.age}
+}
+
+func main() {
+    p := person{"Dave", 40}
+    fmt.Println(p)
+    q := copy(p)
+    fmt.Println(q)
+    /*
+    is := []int{1, 2, 3}
+    it := make([]int, 3)
+    copy(it, is)
+    */
+}

Task/Metaprogramming/Julia/metaprogramming.julia

@@ -0,0 +1,37 @@
+macro dowhile(condition, block)
+    quote
+        while true
+            $(esc(block))
+            if !$(esc(condition))
+                break
+            end
+        end
+    end
+end
+
+macro dountil(condition, block)
+    quote
+        while true
+            $(esc(block))
+            if $(esc(condition))
+                break
+            end
+        end
+    end
+end
+
+using Primes
+
+arr = [7, 31]
+
+@dowhile (!isprime(arr[1]) && !isprime(arr[2])) begin
+    println(arr)
+    arr .+= 1
+end
+println("Done.")
+
+@dountil (isprime(arr[1]) || isprime(arr[2])) begin
+    println(arr)
+    arr .+= 1
+end
+println("Done.")

Task/Metaprogramming/Kotlin/metaprogramming.kotlin

@@ -0,0 +1,8 @@
+// version 1.0.6
+
+infix fun Double.pwr(exp: Double) = Math.pow(this, exp)
+
+fun main(args: Array<String>) {
+   val d = 2.0 pwr 8.0
+   println(d)
+}

Task/Metaprogramming/Lingo/metaprogramming.lingo

@@ -0,0 +1,3 @@
+r = RETURN
+str = "on halt"&r&"--do nothing"&r&"end"
+new(#script).scripttext = str

Task/Metaprogramming/Lua/metaprogramming.lua

@@ -0,0 +1,4 @@
+class "foo" : inherits "bar"
+{
+
+}

Task/Metaprogramming/M2000-Interpreter/metaprogramming.m2000

@@ -0,0 +1,14 @@
+Module Meta {
+      FunName$="Alfa"
+      Code1$=FunName$+"=lambda (X)->{"
+      Code2$={
+            =x**2
+      }
+      Code3$="}"
+
+      Inline code1$+code2$+code3$
+
+      Print Function(FunName$, 4)=16
+
+}
+Meta

Task/Metaprogramming/Mathematica/metaprogramming.math

@@ -0,0 +1,2 @@
+CircleTimes[x_, y_] := Mod[x, 10] Mod[y, 10]
+14\[CircleTimes]13

Task/Metaprogramming/Nim/metaprogramming-1.nim

@@ -0,0 +1,11 @@
+proc `^`*[T: SomeInteger](base, exp: T): T =
+  var (base, exp) = (base, exp)
+  result = 1
+
+  while exp != 0:
+    if (exp and 1) != 0:
+      result *= base
+    exp = exp shr 1
+    base *= base
+
+echo 2 ^ 10 # 1024

Task/Metaprogramming/Nim/metaprogramming-2.nim

@@ -0,0 +1,6 @@
+when defined windows:
+  echo "Call some Windows specific functions here"
+elif defined linux:
+  echo "Call some Linux specific functions here"
+else:
+  echo "Code for the other platforms"

Task/Metaprogramming/Nim/metaprogramming-3.nim

@@ -0,0 +1,2 @@
+static:
+  echo "Hello Compile time world: ", 2 ^ 10

Task/Metaprogramming/Nim/metaprogramming-4.nim

@@ -0,0 +1 @@
+const x = 2 ^ 10

Task/Metaprogramming/Nim/metaprogramming-5.nim

@@ -0,0 +1,14 @@
+import os
+
+const debug = false
+
+proc expensive: string =
+  sleep(milsecs = 100)
+  result = "That was difficult"
+
+proc log(msg: string) =
+  if debug:
+    echo msg
+
+for i in 1..10:
+  log expensive()

Task/Metaprogramming/Nim/metaprogramming-6.nim

@@ -0,0 +1,6 @@
+template log(msg: string) =
+  if debug:
+    echo msg
+
+for i in 1..10:
+  log expensive()

Task/Metaprogramming/Nim/metaprogramming-7.nim

@@ -0,0 +1,7 @@
+template times(x, y: untyped): untyped =
+  for i in 1..x:
+    y
+
+10.times: # or times 10:  or times(10):
+  echo "hi"
+  echo "bye"

Task/Metaprogramming/Nim/metaprogramming-8.nim

@@ -0,0 +1,15 @@
+template optLog1{a and a}(a): auto = a
+template optLog2{a and (b or (not b))}(a,b): auto = a
+template optLog3{a and not a}(a: int): auto = 0
+
+var
+  x = 12
+  s = x and x
+  # Hint: optLog1(x) --> ’x’ [Pattern]
+
+  r = (x and x) and ((s or s) or (not (s or s)))
+  # Hint: optLog2(x and x, s or s) --> ’x and x’ [Pattern]
+  # Hint: optLog1(x) --> ’x’ [Pattern]
+
+  q = (s and not x) and not (s and not x)
+  # Hint: optLog3(s and not x) --> ’0’ [Pattern]

Task/Metaprogramming/Nim/metaprogramming-9.nim

@@ -0,0 +1,13 @@
+import macros
+
+dumpTree:
+  if x:
+    if y:
+      p0
+    else:
+      p1
+  else:
+    if y:
+      p2
+    else:
+      p3

Task/Metaprogramming/Ol/metaprogramming-1.ol

@@ -0,0 +1,12 @@
+(define-syntax define
+   (syntax-rules (lambda) ;λ
+      ((define ((name . args) . more) . body)
+         (define (name . args) (lambda more . body)))
+      ((define (name . args) . body)
+         (setq name (letq (name) ((lambda args . body)) name)))
+      ((define name (lambda (var ...) . body))
+         (setq name (letq (name) ((lambda (var ...) . body)) name)))
+      ((define name val)
+         (setq name val))
+      ((define name a b . c)
+         (define name (begin a b . c)))))

Task/Metaprogramming/Ol/metaprogramming-2.ol

@@ -0,0 +1,3 @@
+(define (sum a b) (+ a b))
+; instead of
+(setq sum (lambda (a b) (+ a b)))

Task/Metaprogramming/OxygenBasic/metaprogramming.basic

@@ -0,0 +1,34 @@
+'EQUATES
+
+% half 0.5
+$ title "My Metaprogram"
+
+'CONDITIONAL BLOCKS
+
+ #ifdef ...
+   ...
+ #elseif ...
+   ...
+ #else
+   ...
+ #endif
+
+'MACROS
+
+'msdos-like
+def sum
+  %1 + %2
+end def
+
+'C-like
+#define sum(a,b) a + b
+
+'native
+macro sum(a,b)
+  a + b
+end macro
+
+'native macro functions
+macro sum int(r,a,b)
+  r = a + b
+end macro

Task/Metaprogramming/PARI-GP/metaprogramming.parigp

@@ -0,0 +1,14 @@
+long
+smin0ss(long a, long b)
+{
+  long c = a < b ? a : b;
+  return c > 0 ? c : 0;
+}
+
+
+GEN
+gmin0(GEN a, GEN b)
+{
+  GEN c = gcmp(a, b) < 1 ? a : b; /* copy pointer */
+  return signe(c) > 0 ? gcopy(c) : gen_0;
+}

Task/Metaprogramming/Perl/metaprogramming-1.pl

@@ -0,0 +1,5 @@
+package UnicodeEllipsis;
+
+use Filter::Simple;
+
+FILTER_ONLY code => sub { s/…/../g };

Task/Metaprogramming/Perl/metaprogramming-2.pl

@@ -0,0 +1,3 @@
+use UnicodeEllipsis;
+
+print join(' … ', 1 … 5), "\n";

Task/Metaprogramming/Phix/metaprogramming.phix

@@ -0,0 +1,7 @@
+object x
+#isginfo{x,0b0101,5,7,integer,3}
+--    {var,type,min,max,etype,len}
+    -- (0b0101 is dword sequence|integer)
+    x = {1,2,3} -- sequence of integer, length 3
+    x = 5       -- integer 5 (becomes min)
+    x = 7       -- integer 7 (becomes max)

Task/Metaprogramming/PostScript/metaprogramming-1.ps

@@ -0,0 +1,11 @@
+/ift {
+4 dict begin
+    [/.if /.then] let*
+    count array astore /.stack exch def
+    /_restore {clear .stack aload pop}.
+    .stack aload pop .if {
+       _restore .then
+    } {
+       _restore
+    } ifelse
+end}.

Task/Metaprogramming/PostScript/metaprogramming-2.ps

@@ -0,0 +1,2 @@
+>| 2 {1 gt} {=} ift
+2

Task/Metaprogramming/PostScript/metaprogramming-3.ps

@@ -0,0 +1,2 @@
+>| 2 dup 1 gt {=} ift
+2

Task/Metaprogramming/PostScript/metaprogramming-4.ps

@@ -0,0 +1 @@
+/let* {reverse {exch def} forall}.

Task/Metaprogramming/Prolog/metaprogramming-1.pro

@@ -0,0 +1,3 @@
+:- initialization(main).
+main :- clause(less_than(1,2),B),writeln(B).
+less_than(A,B) :- A<B.

Task/Metaprogramming/Prolog/metaprogramming-2.pro

@@ -0,0 +1,3 @@
+assertz((mother(Child, Mother) :-
+                parent(Child, Mother),
+                female(Mother))).

Task/Metaprogramming/Python/metaprogramming-1.py

@@ -0,0 +1,9 @@
+from macropy.core.macros import *
+from macropy.core.quotes import macros, q, ast, u
+
+macros = Macros()
+
+@macros.expr
+def expand(tree, **kw):
+    addition = 10
+    return q[lambda x: x * ast[tree] + u[addition]]

Task/Metaprogramming/Python/metaprogramming-2.py

@@ -0,0 +1,2 @@
+func = expand[1 + 2]
+print func(5)

Task/Metaprogramming/Quackery/metaprogramming.quackery

@@ -0,0 +1,36 @@
+( +---------------------------------------------------+ )
+( | add inline comments ";" to Quackery with "builds" | )
+( +---------------------------------------------------+ )
+
+[ dup $ "" = not while
+  behead carriage =
+  until ]            builds ;             ( [ $ --> [ $ )
+
+
+; +---------------------------------------------------+
+; |  add switch to Quackery with ]else[ ]'[ & ]done[  |
+; +---------------------------------------------------+
+
+[ stack ]                is switch.arg    (     --> s   )
+protect switch.arg
+
+[ switch.arg put ]       is switch        (   x -->     )
+
+[ switch.arg release ]   is otherwise
+
+[ switch.arg share
+  != iff ]else[ done
+  otherwise
+  ]'[ do ]done[ ]        is case          (   x -->     )
+
+
+[ switch
+  1       case [ say "The number 1."     cr ]
+  $ "two" case [ say 'The string "two".' cr ]
+     otherwise [ say "Something else."   cr ] ] is test
+                                          (   x -->     )
+
+
+' tally test     ; output should be: Something else.
+$ "two" test     ; output should be: The string "two".
+      1 test     ; output should be: The number 1.

Task/Metaprogramming/R/metaprogramming.r

@@ -0,0 +1,2 @@
+'%C%' <- function(n, k) choose(n, k)
+5 %C% 2 #Outputs 10.

Task/Metaprogramming/REXX/metaprogramming.rexx

@@ -0,0 +1,53 @@
+/*┌───────────────────────────────────────────────────────────────────┐
+  │ The REXX language doesn't allow for the changing or overriding of │
+  │ syntax per se,  but any of the built-in-functions (BIFs) can be   │
+  │ overridden by just specifying your own.                           │
+  │                                                                   │
+  │ To use the REXX's version of a built-in-function, you simply just │
+  │ enclose the BIF in quotation marks (and uppercase the name).      │
+  │                                                                   │
+  │ The intent is two-fold:  the REXX language doesn't have any       │
+  │ reserved words,  nor reserved  BIFs  (Built-In-Functions).        │
+  │                                                                   │
+  │ So, if you don't know that  VERIFY  is a BIF,  you can just code  │
+  │ a subroutine (or function)  with that name (or any name), and not │
+  │ worry about your subroutine being pre-empted.                     │
+  │                                                                   │
+  │ Second:  if you're not satisfied how a BIF works, you can code    │
+  │ your own.   This also allows you to front-end a BIF for debugging │
+  │ or modifying the BIF's behavior.                                  │
+  └───────────────────────────────────────────────────────────────────┘ */
+yyy='123456789abcdefghi'
+
+rrr =  substr(yyy,5)                   /*returns  efghi                 */
+mmm = 'SUBSTR'(yyy,5)                  /*returns  56789abcdefgji        */
+sss = "SUBSTR"(yyy,5)                  /* (same as above)               */
+exit                                   /*stick a fork in it, we're done.*/
+
+/*──────────────────────────────────SUBSTR subroutine───────────────────*/
+substr: return right(arg(1),arg(2))
+
+/*┌───────────────────────────────────────────────────────────────────┐
+  │ Also, some REXX interpreters treat whitespace(s) as blanks   when │
+  │ performing comparisons.    Some of the whitespace characters are: │
+  │                                                                   │
+  │           NL  (newLine)                                           │
+  │           FF  (formFeed)                                          │
+  │           VT  (vertical tab)                                      │
+  │           HT  (horizontal tab or TAB)                             │
+  │           LF  (lineFeed)                                          │
+  │           CR  (carriage return)                                   │
+  │           EOF (end-of-file)                                       │
+  │         and/or others.                                            │
+  │                                                                   │
+  │ Note that some of the above are ASCII or EBCDIC specific.         │
+  │                                                                   │
+  │ Some REXX interpreters use the   OPTIONS   statement to force     │
+  │ REXX to only treat blanks as spaces.                              │
+  │                                                                   │
+  │ (Both the  verb  and  option  may be in lower/upper/mixed case.)  │
+  │                                                                   │
+  │ REXX interpreters which don't recognize any  option  won't treat  │
+  │ the (below) statement as an error.                                │
+  └───────────────────────────────────────────────────────────────────┘ */
+options  strict_white_space_comparisons   /*can be in lower/upper/mixed.*/

Task/Metaprogramming/Racket/metaprogramming-1.rkt

@@ -0,0 +1,10 @@
+#lang racket
+
+(define-syntax-rule (list-when test body)
+  (if test
+      body
+      '()))
+
+(let ([not-a-string 42])
+  (list-when (string? not-a-string)
+    (string->list not-a-string)))

Task/Metaprogramming/Racket/metaprogramming-2.rkt

@@ -0,0 +1,8 @@
+(require (for-syntax syntax/parse))
+
+(define-syntax list-when
+  (syntax-parser
+    [(_ test:expr body:expr)
+     #'(if test
+           body
+           null)]))

Task/Metaprogramming/Raku/metaprogramming-1.raku

@@ -0,0 +1,2 @@
+sub postfix:<!> { [*] 1..$^n }
+say 5!;  # prints 120

Task/Metaprogramming/Raku/metaprogramming-2.raku

@@ -0,0 +1,8 @@
+use MONKEY-TYPING; # Needed to do runtime augmentation of a base class.
+
+augment class List {
+    method nsort { self.list.sort: {$^a.lc.subst(/(\d+)/, -> $/ {0 ~ $0.chars.chr ~ $0 }, :g) ~ "\x0" ~ $^a} }
+};
+
+say ~<a201st a32nd a3rd a144th a17th a2 a95>.nsort;
+say ~<a201st a32nd a3rd a144th a17th a2 a95>.sort;

Task/Metaprogramming/Raku/metaprogramming-3.raku

@@ -0,0 +1,2 @@
+say "Foo = $foo\n";  # normal double quotes
+say Q:qq 【Foo = $foo\n】; # a more explicit derivation, new quotes

Task/Metaprogramming/Rascal/metaprogramming-1.rascal

@@ -0,0 +1,14 @@
+extend ViewParseTree;
+
+layout Whitespace = [\ \t\n]*;
+syntax A = "a";
+syntax B = "b";
+start syntax C = "c" | A C B;
+
+layout Whitespace = [\ \t\n]*;
+lexical Integer = [0-9]+;
+start syntax E1 = Integer
+               | E "*" E
+	       > E "+" E
+	       | "(" E ")"
+               ;

Task/Metaprogramming/Rascal/metaprogramming-2.rascal

@@ -0,0 +1,9 @@
+map[str, int] operatorUsage(PROGRAM P) {
+    m = ();
+    visit(P){
+    	case add(_,_): m["add"] ? 0 += 1;
+    	case sub(_,_): m["sub"] ? 0 += 1;
+    	case conc(_,_): m["conc"] ? 0 += 1;
+    }
+    return m;
+}

Task/Metaprogramming/Rascal/metaprogramming-3.rascal

@@ -0,0 +1,28 @@
+public data TYPE =
+	  natural() | string();
+	
+public alias PicoId = str;
+	
+public data PROGRAM =
+  program(list[DECL] decls, list[STATEMENT] stats);
+
+public data DECL =
+  decl(PicoId name, TYPE tp);
+
+public data EXP =
+      id(PicoId name)
+    | natCon(int iVal)
+    | strCon(str sVal)
+    | add(EXP left, EXP right)
+    | sub(EXP left, EXP right)
+    | conc(EXP left, EXP right)
+    ;
+
+public data STATEMENT =
+  asgStat(PicoId name, EXP exp)
+| ifElseStat(EXP exp, list[STATEMENT] thenpart, list[STATEMENT] elsepart)
+| ifThenStat(EXP exp, list[STATEMENT] thenpart)
+| whileStat(EXP exp, list[STATEMENT] body)
+| doUntilStat(EXP exp, list[STATEMENT] body)
+| unlessStat(EXP exp, list[STATEMENT] body)
+;

Task/Metaprogramming/Rascal/metaprogramming-4.rascal

@@ -0,0 +1,56 @@
+module lang::pico::Syntax
+
+import Prelude;
+
+lexical Id  = [a-z][a-z0-9]* !>> [a-z0-9];
+lexical Natural = [0-9]+ ;
+lexical String = "\"" ![\"]*  "\"";
+
+layout Layout = WhitespaceAndComment* !>> [\ \t\n\r%];
+
+lexical WhitespaceAndComment
+   = [\ \t\n\r]
+   | @category="Comment" "%" ![%]+ "%"
+   | @category="Comment" "%%" ![\n]* $
+   ;
+
+start syntax Program
+   = program: "begin" Declarations decls {Statement  ";"}* body "end" ;
+
+syntax Declarations
+   = "declare" {Declaration ","}* decls ";" ;
+
+syntax Declaration = decl: Id id ":" Type tp;
+
+syntax Type
+   = natural:"natural"
+   | string :"string"
+   ;
+
+syntax Statement
+   = asgStat: Id var ":="  Expression val
+   | ifElseStat: "if" Expression cond "then" {Statement ";"}*  thenPart "else" {Statement ";"}* elsePart "fi"
+   | ifThenStat: "if" Expression cond "then" {Statement ";"}*  thenPart "fi"
+   | whileStat: "while" Expression cond "do" {Statement ";"}* body "od"
+   | doUntilStat: "do" {Statement ";"}* body "until" Expression cond "od"
+   | unlessStat: Statement "unless" Expression cond
+  ;
+
+syntax Expression
+   = id: Id name
+   | strCon: String string
+   | natCon: Natural natcon
+   | bracket "(" Expression e ")"
+   > left conc: Expression lhs "||" Expression rhs
+   > left ( add: Expression lhs "+" Expression rhs
+          | sub: Expression lhs "-" Expression rhs
+          )
+  ;
+
+public start[Program] program(str s) {
+  return parse(#start[Program], s);
+}
+
+public start[Program] program(str s, loc l) {
+  return parse(#start[Program], s, l);
+}

Task/Metaprogramming/Ring/metaprogramming-1.ring

@@ -0,0 +1,5 @@
+o1 = new point { x=10 y=20 z=30 }
+addmethod(o1,"print", func { see x + nl + y + nl + z + nl } )
+o1.print()
+Class point
+        x y z

Task/Metaprogramming/Ring/metaprogramming-2.ring

@@ -0,0 +1,44 @@
+New App
+{
+        I want window
+        The window title = "hello world"
+}
+
+Class App
+
+        func geti
+                if nIwantwindow = 0
+                        nIwantwindow++
+                ok
+
+        func getwant
+                if nIwantwindow = 1
+                        nIwantwindow++
+                ok
+
+        func getwindow
+                if nIwantwindow = 2
+                        nIwantwindow= 0
+                        see "Instruction : I want window" + nl
+                ok
+                if nWindowTitle = 0
+                        nWindowTitle++
+                ok
+
+        func settitle cValue
+                if nWindowTitle = 1
+                        nWindowTitle=0
+                        see "Instruction : Window Title = " + cValue + nl
+                ok
+
+        private
+
+                # Attributes for the instruction I want window
+                        i want window
+                        nIwantwindow = 0
+                # Attributes for the instruction Window title
+                # Here we don't define the window attribute again
+                        title
+                        nWindowTitle = 0
+                # Keywords to ignore, just give them any value
+                        the=0

Task/Metaprogramming/Ruby/metaprogramming.rb

@@ -0,0 +1,12 @@
+class IDVictim
+
+  # Create elements of this man, woman, or child's identification.
+  attr_accessor :name, :birthday, :gender, :hometown
+
+  # Allows you to put in a space for anything which is not covered by the
+  # preexisting elements.
+  def self.new_element(element)
+    attr_accessor element
+  end
+
+end

Task/Metaprogramming/Run-BASIC/metaprogramming.basic

@@ -0,0 +1,32 @@
+' ---------------------------------------------------
+' create a file to be run
+' RB can run the entire program
+'  or execute a function withing the RUNNED program
+' ---------------------------------------------------
+open "runned.bas" for output as #f                      ' open runned.bas as output
+
+print #f, "text$ = ""I'm rinning the complete program.  ' print this program to the output
+Or you can run a function.
+The program or function within the RUNNED program
+can execute all Run BASIC commands."""
+
+print #f, "
+x = displayText(text$)"
+
+print #f, "                                            ' besides RUNNING the entireprogram
+Function displayText(text$)                            ' we will execute this function only
+print text$                                            '
+end function"
+
+' ----------------------------------------
+' Execute the entire RUNNED program
+' ----------------------------------------
+RUN "runned.bas",#handle          ' setup run command to execute runned.bas and give it a handle
+render #handle                    ' render the handle will execute the program
+
+' ----------------------------------------
+' Execute a function in the RUNNED program
+' ----------------------------------------
+RUN "runned.bas",#handle          ' setup run command to execute runned.bas and give it a handle
+#handle displayText("Welcome!")   ' only execute the function withing the runned program
+render #handle                    ' render the handle will execute the program

Task/Metaprogramming/Rust/metaprogramming.rust

@@ -0,0 +1,58 @@
+// dry.rs
+use std::ops::{Add, Mul, Sub};
+
+macro_rules! assert_equal_len {
+    // The `tt` (token tree) designator is used for
+    // operators and tokens.
+    ($a:ident, $b: ident, $func:ident, $op:tt) => (
+        assert!($a.len() == $b.len(),
+                "{:?}: dimension mismatch: {:?} {:?} {:?}",
+                stringify!($func),
+                ($a.len(),),
+                stringify!($op),
+                ($b.len(),));
+    )
+}
+
+macro_rules! op {
+    ($func:ident, $bound:ident, $op:tt, $method:ident) => (
+        fn $func<T: $bound<T, Output=T> + Copy>(xs: &mut Vec<T>, ys: &Vec<T>) {
+            assert_equal_len!(xs, ys, $func, $op);
+
+            for (x, y) in xs.iter_mut().zip(ys.iter()) {
+                *x = $bound::$method(*x, *y);
+                // *x = x.$method(*y);
+            }
+        }
+    )
+}
+
+// Implement `add_assign`, `mul_assign`, and `sub_assign` functions.
+op!(add_assign, Add, +=, add);
+op!(mul_assign, Mul, *=, mul);
+op!(sub_assign, Sub, -=, sub);
+
+mod test {
+    use std::iter;
+    macro_rules! test {
+        ($func: ident, $x:expr, $y:expr, $z:expr) => {
+            #[test]
+            fn $func() {
+                for size in 0usize..10 {
+                    let mut x: Vec<_> = iter::repeat($x).take(size).collect();
+                    let y: Vec<_> = iter::repeat($y).take(size).collect();
+                    let z: Vec<_> = iter::repeat($z).take(size).collect();
+
+                    super::$func(&mut x, &y);
+
+                    assert_eq!(x, z);
+                }
+            }
+        }
+    }
+
+    // Test `add_assign`, `mul_assign` and `sub_assign`
+    test!(add_assign, 1u32, 2u32, 3u32);
+    test!(mul_assign, 2u32, 3u32, 6u32);
+    test!(sub_assign, 3u32, 2u32, 1u32);
+}

Task/Metaprogramming/SNOBOL4/metaprogramming-1.sno

@@ -0,0 +1,2 @@
+        OPSYN('SAME','IDENT')
+        OPSYN('$','*',1)

Task/Metaprogramming/SNOBOL4/metaprogramming-2.sno

@@ -0,0 +1 @@
+        OPSYN('F','*',1)

Task/Metaprogramming/SNOBOL4/metaprogramming-3.sno

@@ -0,0 +1,9 @@
+        &ANCHOR = 0 ; &TRIM = 1
+        WORD = BREAK(' .,') . W SPAN(' .,')
+        STRING1 = INPUT                       :F(ERROR)
+        STRING2 = INPUT                       :F(ERROR)
+LOOP    STRING1 WORD =                        :F(OUTPUT)
+        STRING2 ' ' W ANY(' .,')              :F(LOOP)
+        LIST = LIST W ', '                    :(LOOP)
+OUTPUT  OUTPUT = LIST
+END

Task/Metaprogramming/SNOBOL4/metaprogramming-4.sno

@@ -0,0 +1,10 @@
+        &ANCHOR = 0 ; &TRIM = 1
+        WORD = BREAK(' .,') . W SPAN(' .,')
+        FINDW = ' ' *W ANY(' .,')
+        STRING1 = INPUT                       :F(ERROR)
+        STRING2 = INPUT                       :F(ERROR)
+LOOP    STRING1 WORD =                        :F(OUTPUT)
+        STRING2 FINDW                         :F(LOOP)
+        LIST = LIST W ', '                    :(LOOP)
+OUTPUT  OUTPUT = LIST
+END

Task/Metaprogramming/SNOBOL4/metaprogramming-5.sno

@@ -0,0 +1,8 @@
+* This example provides a bizarrely-expensive addition operation.
+* It assumes the existence of an expensive procedure—say a database
+* lookup—to extract the value to be added.  This version uses the
+* typical initialize-on-definition approach to implementation.
+         DEFINE('XADD(X)','XADD')
+         ADDVALUE = CALL_SOME_EXPENSIVE_OPERATION()        :(XADD.END)
+XADD     XADD = X + ADDVALUE                               :(RETURN)
+XADD.END

Task/Metaprogramming/SNOBOL4/metaprogramming-6.sno

@@ -0,0 +1,5 @@
+          DEFINE('XADD(X)','XADD.INIT')                    :(XADD.END)
+XADD.INIT ADDVALUE = CALL_SOME_EXPENSIVE_OPERATION()
+          DEFINE('XADD(X)','XADD')
+XADD      XADD = X + ADDVALUE                              :(RETURN)
+XADD.END

Task/Metaprogramming/Scala/metaprogramming.scala

@@ -0,0 +1,11 @@
+import scala.language.experimental.macros
+import scala.reflect.macros.Context
+
+object Macros {
+  def impl(c: Context) = {
+    import c.universe._
+    c.Expr[Unit](q"""println("Hello World")""")
+  }
+
+  def hello: Unit = macro impl
+}

Task/Metaprogramming/Shen/metaprogramming-1.shen

@@ -0,0 +1,8 @@
+(define make-list
+  [A|D] -> [cons (make-list A) (make-list D)]
+  X -> X)
+
+(defmacro info-macro
+  [info Exp] -> [output "~A: ~A~%" (make-list Exp) Exp])
+
+(info (* 5 6)) \\ outputs [* 5 6]: 30

Task/Metaprogramming/Shen/metaprogramming-2.shen

@@ -0,0 +1,7 @@
+(0-) (defmacro +-macro
+       [A + B] -> [+ A B])
+macro
++-macro
+
+(1-) (1 + (* 2 3))
+7

Task/Metaprogramming/Shen/metaprogramming-3.shen

@@ -0,0 +1,14 @@
+(2-) (tc +)
+true
+
+(3+) (+ 1 2 3)
+6 : number
+
+(4+) +
++ : (number --> (number --> number))
+
+(5-) (tc -)
+false
+
+(6-) (macroexpand [+ 1 2 3])
+[+ 1 [+ 2 3]]

Task/Metaprogramming/Sidef/metaprogramming-1.sidef

@@ -0,0 +1,7 @@
+class Number {
+    method ⊕(arg) {
+        self + arg
+    }
+}
+
+say (21 ⊕ 42)

Task/Metaprogramming/Sidef/metaprogramming-2.sidef

@@ -0,0 +1,20 @@
+var colors = Hash(
+               'black'   => "000",
+               'red'     => "f00",
+               'green'   => "0f0",
+               'yellow'  => "ff0",
+               'blue'    => "00f",
+               'magenta' => "f0f",
+               'cyan'    => "0ff",
+               'white'   => "fff",
+             )
+
+for color,code in colors {
+    String.def_method("in_#{color}", func (self) {
+        '<span style="color: #' + code + '">' + self + '</span>'
+    })
+}
+
+say "blue".in_blue
+say "red".in_red
+say "white".in_white

Task/Metaprogramming/Smalltalk/metaprogramming.st

@@ -0,0 +1,3 @@
+apiSyslog:priority format:format message:message
+    <cdecl: int 'syslog' (int char* char*) >
+    ^ self primitiveFailed.

Task/Metaprogramming/Standard-ML/metaprogramming-1.ml

@@ -0,0 +1,2 @@
+fun to (a, b) = List.tabulate (b-a,fn i => a+i ) ;
+infix 5 to ;

Task/Metaprogramming/Standard-ML/metaprogramming-2.ml

@@ -0,0 +1,2 @@
+- 2 to 9 ;
+val it = [2,3,4,5,6,7,8] : int list

Task/Metaprogramming/TXR/metaprogramming.txr

@@ -0,0 +1,26 @@
+(defmacro whil ((condition : result) . body)
+  (let ((cblk (gensym "cnt-blk-"))
+        (bblk (gensym "brk-blk-")))
+    ^(macrolet ((break (value) ^(return-from ,',bblk ,value)))
+       (symacrolet ((break (return-from ,bblk))
+                    (continue (return-from ,cblk)))
+         (block ,bblk
+           (for () (,condition ,result) ()
+             (block ,cblk ,*body)))))))
+
+(let ((i 0))
+  (whil ((< i 100))
+    (if (< (inc i) 20)
+      continue)
+    (if (> i 30)
+      break)
+    (prinl i)))
+
+(prinl
+  (sys:expand
+    '(whil ((< i 100))
+       (if (< (inc i) 20)
+         continue)
+       (if (> i 30)
+         break)
+       (prinl i))))

Task/Metaprogramming/Tcl/metaprogramming-1.tcl

@@ -0,0 +1,14 @@
+proc loopVar {var from lower to upper script} {
+    if {$from ne "from" || $to ne "to"} {error "syntax error"}
+    upvar 1 $var v
+    if {$lower <= $upper} {
+        for {set v $lower} {$v <= $upper} {incr v} {
+            uplevel 1 $script
+        }
+    } else {
+        # $upper and $lower really the other way round here
+        for {set v $lower} {$v >= $upper} {incr v -1} {
+            uplevel 1 $script
+        }
+    }
+}

Task/Metaprogramming/Tcl/metaprogramming-2.tcl

@@ -0,0 +1,6 @@
+loopVar x from 1 to 4 {
+    loopVar y from $x to 6 {
+        puts "pair is ($x,$y)"
+        if {$y >= 4} break
+    }
+}

Task/Metaprogramming/Tcl/metaprogramming-3.tcl

@@ -0,0 +1 @@
+set set set

Task/Metaprogramming/Wren/metaprogramming.wren

@@ -0,0 +1,13 @@
+import "meta" for Meta
+
+var genericClass = Fn.new { |cname, fname|
+    var s1 = "class %(cname) {\n"
+    var s2 = "construct new(%(fname)){\n_%(fname) = %(fname)\n}\n"
+    var s3 = "%(fname) { _%(fname) }\n"
+    var s4 = "}\nreturn %(cname)\n"
+    return Meta.compile(s1 + s2 + s3 + s4).call() // returns the Class object
+}
+
+var CFoo = genericClass.call("Foo", "bar")
+var foo = CFoo.new(10)
+System.print([foo.bar, foo.type])

Task/Metaprogramming/Z80-Assembly/metaprogramming-1.z80

@@ -0,0 +1,7 @@
+macro xchg,regpair1,regpair2
+;swaps the contents of two registers.
+push regpair1
+push regpair2
+pop regpair1
+pop regpair2
+endm

Task/Metaprogramming/Z80-Assembly/metaprogramming-2.z80

@@ -0,0 +1 @@
+xchg bc,de ;exchanges BC with DE

Task/Metaprogramming/Zkl/metaprogramming-1.zkl

@@ -0,0 +1,3 @@
+#define name [0|1]
+#if [0|1|name]
+#else, #endif

Task/Metaprogramming/Zkl/metaprogramming-2.zkl

@@ -0,0 +1,3 @@
+//Full zkl functionality but limited access to the parse stream; only #defines
+#ifdef name
+#fcn name {code}

Task/Metaprogramming/Zkl/metaprogramming-3.zkl

@@ -0,0 +1,3 @@
+// Shove text into the parse stream
+#text name text
+#tokenize name, #tokenize f, #tokenize f(a)

Task/Metaprogramming/Zkl/metaprogramming-4.zkl

@@ -0,0 +1,3 @@
+#<<<#
+text, any text, inside #<<<# pairs is ignored
+#<<<#