A-M baby

Task/Function-frequency/0DESCRIPTION

@@ -0,0 +1,6 @@
+Display - for a program or runtime environment (whatever suites the style of your language) - the top ten most frequently occurring functions (or also identifiers or tokens, if preferred).
+
+This is a static analysis: The question is not how often each function is
+actually executed at runtime, but how often it is used by the programmer.
+
+Besides its practical usefulness, the intent of this task is to show how to do self-inspection within the language.

Task/Function-frequency/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Programming environment operations

Task/Function-frequency/ACL2/function-frequency.acl2

@@ -0,0 +1,63 @@
+(in-package "ACL2")
+
+(set-state-ok t)
+
+(defun read-all-objects (limit channel state)
+   (mv-let (eof obj state)
+           (read-object channel state)
+      (if (or eof (zp limit))
+          (mv nil state)
+          (mv-let (so-far state)
+                  (read-all-objects (- limit 1) channel state)
+             (mv (cons obj so-far) state)))))
+
+(defun list-starters (xs)
+   (cond ((endp xs) nil)
+         ((consp (first xs))
+          (append (if (symbolp (first (first xs)))
+                      (list (first (first xs)))
+                      nil)
+                  (list-starters (rest (first xs)))
+                  (list-starters (rest xs))))
+         (t (list-starters (rest xs)))))
+
+(defun invoked-functions (filename state)
+   (mv-let (channel state)
+           (open-input-channel filename :object state)
+      (mv-let (code state)
+              (read-all-objects 1000 channel state)
+         (mv (list-starters code) state))))
+
+(defun increment-for (key alist)
+   (cond ((endp alist) (list (cons key 1)))
+         ((equal key (car (first alist)))
+          (cons (cons key (1+ (cdr (first alist))))
+                (rest alist)))
+         (t (cons (first alist)
+                  (increment-for key (rest alist))))))
+
+(defun symbol-freq-table (symbols)
+   (if (endp symbols)
+       nil
+       (increment-for (first symbols)
+                      (symbol-freq-table (rest symbols)))))
+
+(defun insert-freq-table (pair alist)
+   (cond ((endp alist)
+          (list pair))
+         ((> (cdr pair) (cdr (first alist)))
+          (cons pair alist))
+         (t (cons (first alist)
+                  (insert-freq-table pair (rest alist))))))
+
+(defun isort-freq-table (alist)
+   (if (endp alist)
+       nil
+       (insert-freq-table (first alist)
+                          (isort-freq-table (rest alist)))))
+
+(defun main (state)
+   (mv-let (fns state)
+           (invoked-functions "function-freq.lisp" state)
+      (mv (take 10 (isort-freq-table
+                    (symbol-freq-table fns))) state)))

Task/Function-frequency/BBC-BASIC/function-frequency.bbc

@@ -0,0 +1,47 @@
+      INSTALL @lib$+"SORTLIB"
+      Sort% = FN_sortinit(1,0) : REM Descending
+
+      Valid$ = "0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ_`abcdefghijklmnopqrstuvwxyz"
+      DIM func$(1000), cnt%(1000)
+      nFunc% = 0
+
+      file% = OPENIN("*.bbc")
+      WHILE NOT EOF#file%
+        ll% = BGET#file%
+        no% = BGET#file% + 256*BGET#file%
+        INPUT #file%, l$
+
+        i% = 1
+        REPEAT
+          j% = INSTR(l$, CHR$&A4, i%) : REM Token for 'FN'
+          k% = INSTR(l$, CHR$&F2, i%) : REM Token for 'PROC'
+          IF k% IF j%=0 OR j%>k% THEN
+            i% = k%
+            f$ = "PROC"
+          ELSE
+            i% = j%
+            f$ = "FN"
+          ENDIF
+          IF i% THEN
+            REPEAT
+              i% += 1
+              f$ += MID$(l$, i%, 1)
+            UNTIL INSTR(Valid$, MID$(l$, i%+1, 1)) = 0
+            FOR j% = 0 TO nFunc%-1
+              IF f$ = func$(j%) EXIT FOR
+            NEXT
+            IF j% >= nFunc% nFunc% += 1
+            func$(j%) = f$
+            cnt%(j%) += 1
+          ENDIF
+        UNTIL i%=0
+      ENDWHILE
+      CLOSE #file%
+
+      C% = nFunc%
+      CALL Sort%, cnt%(0), func$(0)
+
+      IF C% > 10 C% = 10
+      FOR i% = 0 TO C%-1
+        PRINT func$(i%) " (" ; cnt%(i%) ")"
+      NEXT

Task/Function-frequency/C/function-frequency.c

@@ -0,0 +1,251 @@
+#define _POSIX_SOURCE
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+#include <stddef.h>
+#include <sys/mman.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+struct functionInfo {
+    char* name;
+    int timesCalled;
+    char marked;
+};
+void addToList(struct functionInfo** list, struct functionInfo toAdd, \
+               size_t* numElements, size_t* allocatedSize)
+{
+    static const char* keywords[32] = {"auto", "break", "case", "char", "const", \
+                                       "continue", "default", "do", "double", \
+                                       "else", "enum", "extern", "float", "for", \
+                                       "goto", "if", "int", "long", "register", \
+                                       "return", "short", "signed", "sizeof", \
+                                       "static", "struct", "switch", "typedef", \
+                                       "union", "unsigned", "void", "volatile", \
+                                       "while"
+                                      };
+    int i;
+    /* If the "function" being called is actually a keyword, then ignore it */
+    for (i = 0; i < 32; i++) {
+        if (!strcmp(toAdd.name, keywords[i])) {
+            return;
+        }
+    }
+    if (!*list) {
+        *allocatedSize = 10;
+        *list = calloc(*allocatedSize, sizeof(struct functionInfo));
+        if (!*list) {
+            printf("Failed to allocate %lu elements of %lu bytes each.\n", \
+                   *allocatedSize, sizeof(struct functionInfo));
+            abort();
+        }
+        (*list)[0].name = malloc(strlen(toAdd.name)+1);
+        if (!(*list)[0].name) {
+            printf("Failed to allocate %lu bytes.\n", strlen(toAdd.name)+1);
+            abort();
+        }
+        strcpy((*list)[0].name, toAdd.name);
+        (*list)[0].timesCalled = 1;
+        (*list)[0].marked = 0;
+        *numElements = 1;
+    } else {
+        char found = 0;
+        unsigned int i;
+        for (i = 0; i < *numElements; i++) {
+            if (!strcmp((*list)[i].name, toAdd.name)) {
+                found = 1;
+                (*list)[i].timesCalled++;
+                break;
+            }
+        }
+        if (!found) {
+            struct functionInfo* newList = calloc((*allocatedSize)+10, \
+                                                  sizeof(struct functionInfo));
+            if (!newList) {
+                printf("Failed to allocate %lu elements of %lu bytes each.\n", \
+                       (*allocatedSize)+10, sizeof(struct functionInfo));
+                abort();
+            }
+            memcpy(newList, *list, (*allocatedSize)*sizeof(struct functionInfo));
+            free(*list);
+            *allocatedSize += 10;
+            *list = newList;
+            (*list)[*numElements].name = malloc(strlen(toAdd.name)+1);
+            if (!(*list)[*numElements].name) {
+                printf("Failed to allocate %lu bytes.\n", strlen(toAdd.name)+1);
+                abort();
+            }
+            strcpy((*list)[*numElements].name, toAdd.name);
+            (*list)[*numElements].timesCalled = 1;
+            (*list)[*numElements].marked = 0;
+            (*numElements)++;
+        }
+    }
+}
+void printList(struct functionInfo** list, size_t numElements)
+{
+    char maxSet = 0;
+    unsigned int i;
+    size_t maxIndex = 0;
+    for (i = 0; i<10; i++) {
+        maxSet = 0;
+        size_t j;
+        for (j = 0; j<numElements; j++) {
+            if (!maxSet || (*list)[j].timesCalled > (*list)[maxIndex].timesCalled) {
+                if (!(*list)[j].marked) {
+                    maxSet = 1;
+                    maxIndex = j;
+                }
+            }
+        }
+        (*list)[maxIndex].marked = 1;
+        printf("%s() called %d times.\n", (*list)[maxIndex].name, \
+               (*list)[maxIndex].timesCalled);
+    }
+}
+void freeList(struct functionInfo** list, size_t numElements)
+{
+    size_t i;
+    for (i = 0; i<numElements; i++) {
+        free((*list)[i].name);
+    }
+    free(*list);
+}
+char* extractFunctionName(char* readHead)
+{
+    char* identifier = readHead;
+    if (isalpha(*identifier) || *identifier == '_') {
+        while (isalnum(*identifier) || *identifier == '_') {
+            identifier++;
+        }
+    }
+    /* Search forward for spaces and then an open parenthesis
+     * but do not include this in the function name.
+     */
+    char* toParen = identifier;
+    if (toParen == readHead) return NULL;
+    while (isspace(*toParen)) {
+        toParen++;
+    }
+    if (*toParen != '(') return NULL;
+    /* Copy the found function name to the output string */
+    ptrdiff_t size = (ptrdiff_t)((ptrdiff_t)identifier) \
+                     - ((ptrdiff_t)readHead)+1;
+    char* const name = malloc(size);
+    if (!name) {
+        printf("Failed to allocate %lu bytes.\n", size);
+        abort();
+    }
+    name[size-1] = '\0';
+    memcpy(name, readHead, size-1);
+    /* Function names can't be blank */
+    if (strcmp(name, "")) {
+        return name;
+    }
+    free(name);
+    return NULL;
+}
+int main(int argc, char** argv)
+{
+    int i;
+    for (i = 1; i<argc; i++) {
+        errno = 0;
+        FILE* file = fopen(argv[i], "r");
+        if (errno || !file) {
+            printf("fopen() failed with error code \"%s\"\n", \
+                   strerror(errno));
+            abort();
+        }
+        char comment = 0;
+#define DOUBLEQUOTE 1
+#define SINGLEQUOTE 2
+        int string = 0;
+        struct functionInfo* functions = NULL;
+        struct functionInfo toAdd;
+        size_t numElements = 0;
+        size_t allocatedSize = 0;
+        struct stat metaData;
+        errno = 0;
+        if (fstat(fileno(file), &metaData) < 0) {
+            printf("fstat() returned error \"%s\"\n", strerror(errno));
+            abort();
+        }
+        char* mmappedSource = (char*)mmap(NULL, metaData.st_size, PROT_READ, \
+                                          MAP_PRIVATE, fileno(file), 0);
+        if (errno) {
+            printf("mmap() failed with error \"%s\"\n", strerror(errno));
+            abort();
+        }
+        if (!mmappedSource) {
+            printf("mmap() returned NULL.\n");
+            abort();
+        }
+        char* readHead = mmappedSource;
+        while (readHead < mmappedSource + metaData.st_size) {
+            while (*readHead) {
+                /* Ignore comments inside strings */
+                if (!string) {
+                    if (*readHead == '/' && !strncmp(readHead, "/*", 2)) {
+                        comment = 1;
+                    }
+                    if (*readHead == '*' && !strncmp(readHead, "*/", 2)) {
+                        comment = 0;
+                    }
+                }
+                /* Ignore strings inside comments */
+                if (!comment) {
+                    if (*readHead == '"') {
+                        if (!string) {
+                            string = DOUBLEQUOTE;
+                        } else if (string == DOUBLEQUOTE) {
+                            /* Only toggle string mode if the quote character
+                             * is not escaped
+                             */
+                            if (strncmp((readHead-1), "\\\"", 2)) {
+                                string = 0;
+                            }
+                        }
+                    }
+                    if (*readHead == '\'') {
+                        if (!string) {
+                            string = SINGLEQUOTE;
+                        } else if (string == SINGLEQUOTE) {
+                            if (strncmp((readHead-1), "\\\'", 2)) {
+                                string = 0;
+                            }
+                        }
+                    }
+                }
+                /* Look for identifiers outside of any comment or string */
+                if (!comment && !string) {
+                    char* name = extractFunctionName(readHead);
+                    /* Don't read part of an identifier on the next iteration */
+                    if (name) {
+                        toAdd.name = name;
+                        addToList(&functions, toAdd, &numElements, &allocatedSize);
+                        readHead += strlen(name);
+                    }
+                    free(name);
+                }
+                readHead++;
+            }
+        }
+        errno = 0;
+        munmap(mmappedSource, metaData.st_size);
+        if (errno) {
+            printf("munmap() returned error \"%s\"\n", strerror(errno));
+            abort();
+        }
+        errno = 0;
+        fclose(file);
+        if (errno) {
+            printf("fclose() returned error \"%s\"\n", strerror(errno));
+            abort();
+        }
+        printList(&functions, numElements);
+        freeList(&functions, numElements);
+    }
+    return 0;
+}

Task/Function-frequency/Forth/function-frequency.fth

@@ -0,0 +1,159 @@
+' noop is bootmessage
+
+\ --- LIST OF CONSTANTS
+\ WORD#		maximum word size
+\ RING#		size of `Rings' element
+\ DEFS		definitions
+\ KEYS
+\
+\ --- LIST OF VARIABLES
+\ cmpl?		is compiling?
+\ cword		current compiled word
+
+    wordlist constant DEFS
+    wordlist constant KEYS
+
+\ --- Compiling
+50 constant WORD#
+: >>fPAD	( ca u -- ; u < 51 )
+	PAD 80 blank s" create " PAD swap MOVE
+	s"  1 , DOES> 1 swap +! ;" PAD 57 + swap MOVE
+	WORD# min PAD 7 + swap MOVE ;
+
+: funcmpl	( ca u -- )
+	>>fPAD current @ DEFS current !
+	PAD 80 evaluate current ! ;
+
+: >>kPAD	( ca u -- ; )
+	PAD 80 blank s" : " PAD swap MOVE
+	s"  parse-name funcmpl ;" PAD 59 + swap MOVE
+	WORD# min PAD 2 + swap MOVE ;
+
+: keycmpl	( ca u -- )
+	 >>kPAD current @ KEYS current !
+	PAD 80 evaluate current ! ;
+
+\ --- Interpreter
+: intp	BEGIN parse-name dup
+	WHILE	( ca u )
+		2dup KEYS search-wordlist
+		IF   execute 2drop
+		ELSE DEFS search-wordlist IF execute THEN
+		THEN
+	REPEAT 2drop ;
+
+: run 	BEGIN refill WHILE intp REPEAT ;
+
+\ --- Lists&Rings
+warnings OFF
+: LIST	( node -- )	]] BEGIN @ dup WHILE >R [[ ; immediate
+warnings ON
+: LOOP-LIST	( -- )	]] R> REPEAT drop [[ ; immediate
+
+: empty-ring?	( node -- f )	dup @ = ;
+: RING	( node -- )	]] dup BEGIN @ 2dup <> WHILE 2>R [[ ; immediate
+: LOOP-RING	( -- )	]] 2R> REPEAT 2drop [[ ; immediate
+
+: new-node	( -- node )
+	here dup , ;
+: do-link		( node new-node  -- ; do link after current node )
+	over @ over ! swap ! ;
+
+\ --- Sorting..
+: nt>freq	( nt -- n ;frequency of uses )
+	name>int >BODY @ ;
+
+: @maxfreq	( wid -- n ;maximum frequency )
+	0 swap cell+
+	LIST	( max )
+		I nt>freq 2dup <
+		IF nip ELSE drop THEN
+	LOOP-LIST ;
+
+    2 cells constant RING#
+: rings-vec	( u -- a size ; create vector of rings )
+	here over 1+ 0
+	DO new-node drop 0 , LOOP
+	swap RING# * ;
+
+: populate-by 	( a wid -- )
+	cell+
+	LIST
+		dup  I nt>freq RING# *   +	\ root-node
+		new-node I ,			\ new-node
+		do-link
+	LOOP-LIST drop ;
+
+\ --- Display TOP
+: node>nt	cell+ @ ;
+
+: .ring		( root-node -- )
+	0 swap
+	RING
+		dup 0= IF I node>nt nt>freq . THEN
+		space I node>nt name>string type
+		1+
+	LOOP-RING drop cr ;
+
+: .top	( a size n -- )
+	-rot BOUNDS swap
+	?DO	( n )
+		I empty-ring?	0= IF 1- I .ring THEN
+		dup 		0= IF drop UNLOOP EXIT THEN
+	[ RING# negate ] LITERAL +LOOP drop ;
+
+: args>top#	( -- n )
+	1 arg 2dup 0 0 d<>
+	IF	>float
+		IF 	f>d d>s dup 0= IF drop 4 THEN
+		ELSE 	4 THEN
+	ELSE	2drop 4 THEN ;
+
+
+\ --- KEYS behaviour
+    variable  cmpl?	cmpl? OFF
+    2variable cword
+here WORD# allot 0 cword 2!
+
+current @ KEYS current !
+: create
+	cmpl? @
+	IF   cword 2@   keycmpl
+	ELSE parse-name funcmpl THEN ;
+
+: constant
+	cmpl? @
+	IF   cword 2@   keycmpl
+	ELSE parse-name funcmpl THEN ;
+
+: variable	parse-name funcmpl ;
+: value		parse-name funcmpl ;
+: defer		parse-name funcmpl ;
+
+: (	BEGIN >in @ [char] ) parse nip >in @ rot - =
+	WHILE refill 0= IF exit THEN REPEAT ;
+: \	10 parse 2drop ;
+: \G	10 parse 2drop ;
+: S"	[char] " parse 2drop ;
+: ."	[char] " parse 2drop ;
+
+: [']
+	parse-name DEFS search-wordlist IF execute THEN ;
+: postpone
+	parse-name DEFS search-wordlist IF execute THEN ;
+
+: ; 	cmpl? OFF ;
+: :	warnings OFF
+	parse-name
+	cword 2@ drop WORD# rot  umin dup >R MOVE
+	cword 2@ drop R> cword 2!
+	cword 2@ cmpl? @
+	IF	keycmpl		\ `:' inside def. = a defining word
+	ELSE	funcmpl	THEN
+	cmpl? ON
+	warnings ON
+;
+current !
+
+\ Run, ruuun!
+stdin ' run execute-parsing-file  DEFS @maxfreq rings-vec  over DEFS populate-by  args>top# .top bye

Task/Function-frequency/Go/function-frequency.go

@@ -0,0 +1,60 @@
+package main
+
+import (
+    "fmt"
+    "go/ast"
+    "go/parser"
+    "go/token"
+    "io/ioutil"
+    "os"
+    "sort"
+)
+
+func main() {
+    if len(os.Args) != 2 {
+        fmt.Println("usage ff <go source filename>")
+        return
+    }
+    src, err := ioutil.ReadFile(os.Args[1])
+    if err != nil {
+        fmt.Println(err)
+        return
+    }
+    fs := token.NewFileSet()
+    a, err := parser.ParseFile(fs, os.Args[1], src, 0)
+    if err != nil {
+        fmt.Println(err)
+        return
+    }
+    f := fs.File(a.Pos())
+    m := make(map[string]int)
+    ast.Inspect(a, func(n ast.Node) bool {
+        if ce, ok := n.(*ast.CallExpr); ok {
+            start := f.Offset(ce.Pos())
+            end := f.Offset(ce.Lparen)
+            m[string(src[start:end])]++
+        }
+        return true
+    })
+    cs := make(calls, 0, len(m))
+    for k, v := range m {
+        cs = append(cs, &call{k, v})
+    }
+    sort.Sort(cs)
+    for i, c := range cs {
+        fmt.Printf("%-20s %4d\n", c.expr, c.count)
+        if i == 9 {
+            break
+        }
+    }
+}
+
+type call struct {
+    expr  string
+    count int
+}
+type calls []*call
+
+func (c calls) Len() int           { return len(c) }
+func (c calls) Swap(i, j int)      { c[i], c[j] = c[j], c[i] }
+func (c calls) Less(i, j int) bool { return c[i].count > c[j].count }

Task/Function-frequency/J/function-frequency.j

@@ -0,0 +1,29 @@
+   PRIMITIVES=: ;:'!   !.  !:  "   ".  ":  #   #.  #:  $   $.  $:  %   %.  %:  &   &.  &.: &:  *   *.  *:  +   +.  +:  ,   ,.  ,:  -   -.  -:  .   ..  .:  /   /.  /:  0:  1:  2:  3:  4:  5:  6:  7:  8:  9:  :   :.  ::  ;   ;.  ;:  <   <.  <:  =   =.  =:  >   >.  >:  ?   ?. ...'
+
+   Filter=: (#~`)(`:6)
+
+   NB. monad top10 .  y is a character vector of much j source code
+   top10=: 10 {. \:~@:((#;{.)/.~@:(e.&PRIMITIVES Filter@:;:))
+
+   top10 JSOURCE NB. JSOURCE are the j Zeckendorf verbs.
+┌─┬──┐
+│6│=.│
+├─┼──┤
+│5│=:│
+├─┼──┤
+│4│@:│
+├─┼──┤
+│3│~ │
+├─┼──┤
+│3│: │
+├─┼──┤
+│3│+ │
+├─┼──┤
+│3│$ │
+├─┼──┤
+│2│|.│
+├─┼──┤
+│2│i.│
+├─┼──┤
+│2│/ │
+└─┴──┘

Task/Function-frequency/Mathematica/function-frequency.mathematica

@@ -0,0 +1 @@
+programCount[fn_] :=  Reverse[If[Length[#] > 10, Take[#, -10], #] &[SortBy[Tally[Cases[DownValues[fn], s_Symbol, \[Infinity], Heads -> True]], Last]]]

Task/Function-frequency/PicoLisp/function-frequency.l

@@ -0,0 +1,9 @@
+(let Freq NIL
+   (for "L" (filter pair (extract getd (all)))
+      (for "F"
+         (filter atom
+            (fish '((X) (or (circ? X) (getd X)))
+               "L" ) )
+         (accu 'Freq "F" 1) ) )
+   (for X (head 10 (flip (by cdr sort Freq)))
+      (tab (-7 4) (car X) (cdr X)) ) )

Task/Function-frequency/Python/function-frequency.py

@@ -0,0 +1,23 @@
+import ast
+
+class CallCountingVisitor(ast.NodeVisitor):
+
+    def __init__(self):
+        self.calls = {}
+
+    def visit_Call(self, node):
+        if isinstance(node.func, ast.Name):
+            fun_name = node.func.id
+            call_count = self.calls.get(fun_name, 0)
+            self.calls[fun_name] = call_count + 1
+        self.generic_visit(node)
+
+filename = input('Enter a filename to parse: ')
+with open(filename, encoding='utf-8') as f:
+    contents = f.read()
+root = ast.parse(contents, filename=filename) #NOTE: this will throw a SyntaxError if the file isn't valid Python code
+visitor = CallCountingVisitor()
+visitor.visit(root)
+top10 = sorted(visitor.calls.items(), key=lambda x: x[1], reverse=True)[:10]
+for name, count in top10:
+    print(name,'called',count,'times')

Task/Function-frequency/REXX/function-frequency.rexx

@@ -0,0 +1,48 @@
+/*REXX pgm counts frequency of various subroutine/function invocations. */
+?.=0                                   /*initialize all funky counters. */
+             do j=1 to 10
+             factorial   =      !(j)
+             factorial_R =     !r(j)
+             fibonacci   =    fib(j)
+             fibonacci_R =   fibR(j)
+             hofstadterQ =  hofsQ(j)
+             width       = length(j) + length(length(j**j))
+             end   /*j*/
+
+say  'number of invocations for ! (factorial) = '     ?.!
+say  'number of invocations for !   recursive = '     ?.!r
+say  'number of invocations for Fibonacci     = '     ?.fib
+say  'number of invocations for Fib recursive = '     ?.fibR
+say  'number of invocations for Hofstadter Q  = '     ?.hofsQ
+say  'number of invocations for LENGTH        = '     ?.length
+exit                                   /*stick a fork in it, we're done.*/
+
+/*─────────────────────────────────────! (factorial) subroutine─────────*/
+!: procedure expose ?.;   ?.!=?.!+1;  parse arg x;  !=1
+                    do j=2  to x;     !=!*j;     end;             return !
+
+/*─────────────────────────────────────!r (factorial) subroutine────────*/
+!r: procedure expose ?.;  ?.!r=?.!r+1;  parse arg x;  if x<2 then return 1
+    return x * !R(x-1)
+
+/*──────────────────────────────────FIB subroutine (non─recursive)──────*/
+fib: procedure expose ?.; ?.fib=?.fib+1;  parse arg n; na=abs(n); a=0; b=1
+     if na<2  then  return na          /*test for couple special cases. */
+             do j=2  to na;   s=a+b;   a=b;   b=s;   end
+     if n>0 | na//2==1  then return  s /*if positive or odd negative... */
+                        else return -s /*return a negative Fib number.  */
+
+/*──────────────────────────────────FIBR subroutine (recursive)─────────*/
+fibR: procedure expose ?.; ?.fibR=?.fibr+1; parse arg n; na=abs(n); s=1
+      if na<2  then  return  na        /*handle a couple special cases. */
+      if n <0  then  if n//2==0  then s=-1
+      return (fibR(na-1)+fibR(na-2))*s
+
+/*──────────────────────────────────HOFSQ subroutine (recursive)────────*/
+hofsQ:  procedure expose ?.;  ?.hofsq=?.hofsq+1;   parse arg n
+        if n<2  then return 1
+        return  hofsQ(n - hofsQ(n - 1)) + hofsQ(n - hofsQ(n - 2))
+
+/*──────────────────────────────────LENGTH subroutine───────────────────*/
+length: procedure expose ?.;   ?.length=?.length+1
+        return 'LENGTH'(arg(1))

Task/Function-frequency/Tcl/function-frequency.tcl

@@ -0,0 +1,28 @@
+package require Tcl 8.6
+
+proc examine {filename} {
+    global cmds
+    set RE "(?:^|\[\[\{\])\[\\w:.\]+"
+    set f [open $filename]
+    while {[gets $f line] >= 0} {
+	set line [string trim $line]
+	if {$line eq "" || [string match "#*" $line]} {
+	    continue
+	}
+	foreach cmd [regexp -all -inline $RE $line] {
+	    incr cmds([string trim $cmd "\{\["])
+	}
+    }
+    close $f
+}
+
+# Parse each file on the command line
+foreach filename $argv {
+    examine $filename
+}
+# Get the command list in order of frequency
+set cmdinfo [lsort -stride 2 -index 1 -integer -decreasing [array get cmds]]
+# Print the top 10 (two list items per entry, so 0-19, not 0-9)
+foreach {cmd count} [lrange $cmdinfo 0 19] {
+    puts [format "%-20s%d" $cmd $count]
+}