langs a-z

Task/Metaprogramming/PARI-GP/metaprogramming.pari

@@ -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-6/metaprogramming-1.pl6

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

Task/Metaprogramming/Perl-6/metaprogramming-2.pl6

@@ -0,0 +1,8 @@
+use MONKEY_TYPING; # Needed to do runtime augmentation of a base class.
+
+augment class Any {
+    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/Perl-6/metaprogramming-3.pl6

@@ -0,0 +1,2 @@
+macro addem($a,$b) { "($a + $b)" }
+say addem(3,4);   # 7

Task/Metaprogramming/Perl-6/metaprogramming-4.pl6

@@ -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/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/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/Run-BASIC/metaprogramming.run

@@ -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/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