Data commit

Task/Function-frequency/00-META.yaml

@@ -0,0 +1,3 @@
+---
+from: http://rosettacode.org/wiki/Function_frequency
+note: Programming environment operations

Task/Function-frequency/00-TASK.txt

@@ -0,0 +1,7 @@
+Display - for a program or runtime environment (whatever suits 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/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/AWK/function-frequency.awk

@@ -0,0 +1,160 @@
+# syntax: GAWK -f FUNCTION_FREQUENCY.AWK filename(s).AWK
+#
+# sorting:
+#   PROCINFO["sorted_in"] is used by GAWK
+#   SORTTYPE is used by Thompson Automation's TAWK
+#
+BEGIN {
+# create array of keywords to be ignored by lexer
+    asplit("BEGIN:END:atan2:break:close:continue:cos:delete:" \
+           "do:else:exit:exp:for:getline:gsub:if:in:index:int:"  \
+           "length:log:match:next:print:printf:rand:return:sin:" \
+           "split:sprintf:sqrt:srand:strftime:sub:substr:system:tolower:toupper:while",
+           keywords,":")
+# build the symbol-state table
+    split("00:00:00:00:00:00:00:00:00:00:" \
+          "20:10:10:12:12:11:07:00:00:00:" \
+          "08:08:08:08:08:33:08:00:00:00:" \
+          "08:44:08:36:08:08:08:00:00:00:" \
+          "08:44:45:42:42:41:08",machine,":")
+# parse the input
+    state = 1
+    for (;;) {
+      symb = lex() # get next symbol
+      nextstate = substr(machine[state symb],1,1)
+      act = substr(machine[state symb],2,1)
+      # perform required action
+      if (act == "0") { # do nothing
+      }
+      else if (act == "1") { # found a function call
+        if (!(inarray(tok,names))) {
+          names[++nnames] = tok
+        }
+        ++xnames[tok]
+      }
+      else if (act == "2") { # found a variable or array
+        if (tok in Local) {
+          tok = tok "(" funcname ")"
+          if (!(inarray(tok,names))) {
+            names[++nnames] = tok
+          }
+          ++xnames[tok]
+        }
+        else {
+          tok = tok "()"
+          if (!(inarray(tok,names))) {
+            names[++nnames] = tok
+          }
+          ++xnames[tok]
+        }
+      }
+      else if (act == "3") { # found a function definition
+        funcname = tok
+      }
+      else if (act == "4") { # found a left brace
+        braces++
+      }
+      else if (act == "5") { # found a right brace
+        braces--
+        if (braces == 0) {
+          delete Local
+          funcname = ""
+          nextstate = 1
+        }
+      }
+      else if (act == "6") { # found a local variable declaration
+        Local[tok] = 1
+      }
+      else if (act == "7") { # found end of file
+        break
+      }
+      else if (act == "8") { # found an error
+        printf("error: FILENAME=%s, FNR=%d\n",FILENAME,FNR)
+        exit(1)
+      }
+      state = nextstate # finished with current token
+    }
+# format function names
+    for (i=1; i<=nnames; i++) {
+      if (index(names[i],"(") == 0) {
+        tmp_arr[xnames[names[i]]][names[i]] = ""
+      }
+    }
+# print function names
+    PROCINFO["sorted_in"] = "@ind_num_desc" ; SORTTYPE = 9
+    for (i in tmp_arr) {
+      PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1
+      for (j in tmp_arr[i]) {
+        if (++shown <= 10) {
+          printf("%d %s\n",i,j)
+        }
+      }
+    }
+    exit(0)
+}
+function asplit(str,arr,fs,  i,n,temp_asplit) {
+    n = split(str,temp_asplit,fs)
+    for (i=1; i<=n; i++) {
+      arr[temp_asplit[i]]++
+    }
+}
+function inarray(val,arr,  j) {
+    for (j in arr) {
+      if (arr[j] == val) {
+        return(j)
+      }
+    }
+    return("")
+}
+function lex() {
+    for (;;) {
+      if (tok == "(eof)") {
+        return(7)
+      }
+      while (length(line) == 0) {
+        if (getline line == 0) {
+          tok = "(eof)"
+          return(7)
+        }
+      }
+      sub(/^[ \t]+/,"",line)           # remove white space,
+      sub(/^"([^"]|\\")*"/,"",line)    # quoted strings,
+      sub(/^\/([^\/]|\\\/)+\//,"",line) # regular expressions,
+      sub(/^#.*/,"",line)              # and comments
+      if (line ~ /^function /) {
+        tok = "function"
+        line = substr(line,10)
+        return(1)
+      }
+      else if (line ~ /^{/) {
+        tok = "{"
+        line = substr(line,2)
+        return(2)
+      }
+      else if (line ~ /^}/) {
+        tok = "}"
+        line = substr(line,2)
+        return(3)
+      }
+      else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*\[/)) {
+        tok = substr(line,1,RLENGTH-1)
+        line = substr(line,RLENGTH+1)
+        return(5)
+      }
+      else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*\(/)) {
+        tok = substr(line,1,RLENGTH-1)
+        line = substr(line,RLENGTH+1)
+        if (!(tok in keywords)) { return(6) }
+      }
+      else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*/)) {
+        tok = substr(line,1,RLENGTH)
+        line = substr(line,RLENGTH+1)
+        if (!(tok in keywords)) { return(4) }
+      }
+      else {
+        match(line,/^[^A-Za-z_{}]/)
+        tok = substr(line,1,RLENGTH)
+        line = substr(line,RLENGTH+1)
+      }
+    }
+}

Task/Function-frequency/Arturo/function-frequency.arturo

@@ -0,0 +1,28 @@
+source: to :block read arg\0
+frequencies: #[]
+
+inspectBlock: function [blk][
+    loop blk 'item [
+        case []
+            when? [word? item][
+                sItem: to :string item
+                if set? sItem ->
+                    if function? var sItem [
+                        if? key? frequencies sItem ->
+                            set frequencies sItem (get frequencies sItem)+1
+                        else ->
+                            set frequencies sItem 1
+                    ]
+            ]
+
+            when? [or? block? item
+                       inline? item] ->
+                inspectBlock item
+
+            else []
+    ]
+]
+
+inspectBlock source
+
+inspect frequencies

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

@@ -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/Common-Lisp/function-frequency.lisp

@@ -0,0 +1,34 @@
+(defun mapc-tree (fn tree)
+  "Apply FN to all elements in TREE."
+  (cond ((consp tree)
+         (mapc-tree fn (car tree))
+         (mapc-tree fn (cdr tree)))
+        (t (funcall fn tree))))
+
+(defun count-source (source)
+  "Load and count all function-bound symbols in a SOURCE file."
+  (load source)
+  (with-open-file (s source)
+    (let ((table (make-hash-table)))
+      (loop for data = (read s nil nil)
+         while data
+         do (mapc-tree
+             (lambda (x)
+               (when (and (symbolp x) (fboundp x))
+                 (incf (gethash x table 0))))
+             data))
+      table)))
+
+(defun hash-to-alist (table)
+  "Convert a hashtable to an alist."
+  (let ((alist))
+    (maphash (lambda (k v) (push (cons k v) alist)) table)
+    alist))
+
+(defun take (n list)
+  "Take at most N elements from LIST."
+  (loop repeat n for x in list collect x))
+
+(defun top-10 (table)
+  "Get the top 10 from the source counts TABLE."
+  (take 10 (sort (hash-to-alist table) '> :key 'cdr)))

Task/Function-frequency/Erlang/function-frequency.erl

@@ -0,0 +1,31 @@
+-module( function_frequency ).
+
+-export( [erlang_source/1, task/0] ).
+
+erlang_source( File ) ->
+    {ok, IO} = file:open( File, [read] ),
+    Forms = parse_all( IO, io:parse_erl_form(IO, ''), [] ),
+    Functions = lists:flatten( [erl_syntax_lib:fold(fun accumulate_functions/2, [], X) || X <- Forms] ),
+    dict:to_list( lists:foldl(fun count/2, dict:new(), Functions) ).
+
+task() ->
+    Function_frequencies = erlang_source( "function_frequency.erl" ),
+    {Top_tens, _Rest} = lists:split( 10, lists:reverse(lists:keysort(2, Function_frequencies)) ),
+    [io:fwrite("Function ~p called ~p times.~n", [X, Y]) || {X, Y} <- Top_tens].
+
+
+
+accumulate_functions( Tree, Acc ) -> accumulate_functions( erlang:element(1, Tree), Tree, Acc ).
+
+accumulate_functions( call, Tree, Acc ) -> [accumulate_functions_name(Tree) | Acc];
+accumulate_functions( _Other, _Tree, Acc ) -> Acc.
+
+accumulate_functions_name( Tree ) -> accumulate_functions_name_scoop( erlang:element(3, Tree) ).
+
+accumulate_functions_name_scoop( {atom, _Line, Name} ) -> Name;
+accumulate_functions_name_scoop( {remote, _Line, {atom, _Line, Module}, {atom, _Line, Name}} ) -> {Module, Name}.
+
+count( Key, Dict ) -> dict:update_counter( Key, 1, Dict ).
+
+parse_all( _IO, {eof, _End}, Acc ) -> Acc;
+parse_all( IO, {ok, Tokens, Location}, Acc ) -> parse_all( IO, io:parse_erl_form(IO, '', Location), [Tokens | Acc] ).

Task/Function-frequency/Factor/function-frequency.factor

@@ -0,0 +1,7 @@
+USING: accessors kernel math.statistics prettyprint sequences
+sequences.deep source-files vocabs words ;
+
+"resource:core/sequences/sequences.factor" "sequences"
+[ path>source-file top-level-form>> ]
+[ vocab-words [ def>> ] [ ] map-as ] bi* compose [ word? ]
+deep-filter sorted-histogram <reversed> 7 head .

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/Haskell/function-frequency.hs

@@ -0,0 +1,20 @@
+import Language.Haskell.Parser (parseModule)
+import Data.List.Split (splitOn)
+import Data.List (nub, sortOn, elemIndices)
+
+findApps src = freq $ concat [apps, comps]
+  where
+    ast = show $ parseModule src
+    apps = extract <$> splitApp ast
+    comps = extract <$> concat (splitComp <$> splitInfix ast)
+    splitApp = tail . splitOn "(HsApp (HsVar (UnQual (HsIdent \""
+    splitInfix = tail . splitOn "(HsInfixApp (HsVar (UnQual (HsIdent \""
+    splitComp = take 1 . splitOn "(HsQVarOp (UnQual (HsSymbol \""
+    extract = takeWhile (/= '\"')
+    freq lst = [ (count x lst, x) | x <- nub lst ]
+    count x = length . elemIndices x
+
+main = do
+  src <- readFile "CountFunctions.hs"
+  let res = sortOn (negate . fst) $ findApps src
+  mapM_ (\(n, f) -> putStrLn $ show n ++ "\t" ++ f) res

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

@@ -0,0 +1,35 @@
+   IGNORE=: ;:'y(0)1',CR
+
+   Filter=: (#~`)(`:6)
+
+   NB. extract tokens from a large body newline terminated of text
+   roughparse=: ;@(<@;: ::(''"_);._2)
+
+   NB. count frequencies and get the top x
+   top=: top=: {. \:~@:((#;{.)/.~)
+
+   NB. read all installed script (.ijs) files and concatenate them
+   JSOURCE=: ;fread each 1&e.@('.ijs'&E.)@>Filter {."1 dirtree jpath '~install'
+
+   10 top (roughparse JSOURCE)-.IGNORE
+┌─────┬──┐
+│49591│, │
+├─────┼──┤
+│40473│=:│
+├─────┼──┤
+│35593│; │
+├─────┼──┤
+│34096│=.│
+├─────┼──┤
+│24757│+ │
+├─────┼──┤
+│18726│" │
+├─────┼──┤
+│18564│< │
+├─────┼──┤
+│18446│/ │
+├─────┼──┤
+│16984│> │
+├─────┼──┤
+│14655│@ │
+└─────┴──┘

Task/Function-frequency/Julia/function-frequency.julia

@@ -0,0 +1,33 @@
+using Printf, DataStructures
+
+function funcfreqs(expr::Expr)
+    cnt = counter(Symbol)
+    expr.head == :call &&
+        push!(cnt, expr.args[1])
+    for e in expr.args
+        e isa Expr && merge!(cnt, funcfreqs(e))
+    end
+    return cnt
+end
+
+function parseall(str::AbstractString)
+    exs = Any[]
+    pos = start(str)
+    while !done(str, pos)
+        ex, pos = parse(str, pos) # returns next starting point as well as expr
+        ex.head == :toplevel ? append!(exs, ex.args) : push!(exs, ex)
+    end
+    if isempty(exs)
+        throw(ParseError("end of input"))
+    elseif length(exs) == 1
+        return exs[1]
+    else
+        return Expr(:block, exs...)
+    end
+end
+
+freqs = readstring("src/Function_frequency.jl") |> parseall |> funcfreqs
+
+for (v, f) in freqs
+    @printf("%10s → %i\n", v, f)
+end

Task/Function-frequency/LiveCode/function-frequency-1.livecode

@@ -0,0 +1,29 @@
+function handlerNames pScript
+    put pScript into pScriptCopy
+    filter pScript with regex pattern "^(on|function).*"
+    -- add in the built-in commands & functions
+    put the commandNames & the functionnames into cmdfunc
+    repeat for each line builtin in cmdfunc
+        put 0 into handlers[builtin]
+    end repeat
+
+    -- add user defined handlers, remove this section of you do not want your own functions included
+    repeat with x = 1 to the number of lines of pScript
+        put word 2 of line x of pScript into handlername
+        put 0 into handlers[handlername]
+    end repeat
+
+    -- count handlers used
+    repeat with x = 1 to the number of lines of pScriptCopy
+        repeat for each key k in handlers
+            if k is among the tokens of line x of pScriptCopy then
+                add 1 to handlers[k]
+            end if
+        end repeat
+    end repeat
+
+    combine handlers using cr and space
+    sort lines of handlers descending by word 2 of each
+    put line 1 to 10 of handlers into handlers
+    return handlers
+end handlerNames

Task/Function-frequency/LiveCode/function-frequency-2.livecode

@@ -0,0 +1 @@
+put handlerNames(the script of this stack & cr & the script of this card & cr & the script of me)

Task/Function-frequency/LiveCode/function-frequency-3.livecode

@@ -0,0 +1,10 @@
+if 8
+put 8
+return 8
+function 7
+factorialacc 4  -- user def function for other rosetta task
+factorialr 3  -- user def function for other rosetta task
+handlerNames 3
+factorial 2  -- user def function for other rosetta task
+factorialit 2  -- user def function for other rosetta task
+mouseUp 2

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

@@ -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/Nim/function-frequency.nim

@@ -0,0 +1,46 @@
+# naive function calling counter
+# TODO consider a more sophisticated condition on counting function callings
+# without parenthesis which are common in nim lang. Be aware that the AST of
+# object accessor and procedure calling without parenthesis are same.
+
+import macros, tables, strformat, os
+proc visitCall(node: NimNode, table: CountTableRef) =
+  if node.kind == nnkCall:
+    if node[0].kind == nnkDotExpr:
+      table.inc($node[0][1])
+      visitCall(node[0][0], table)
+    else:
+      if node[0].kind == nnkBracketExpr:
+        if node[0][0].kind == nnkDotExpr:
+          table.inc($node[0][0][1])
+          visitCall(node[0][0][0], table)
+          return
+        else:
+          table.inc($node[0][0])
+          if len(node[0]) > 1:
+            for child in node[0][1..^1]:
+              visitCall(child, table)
+      elif node[0].kind == nnkPar:
+        visitCall(node[0], table)
+      else:
+        table.inc($node[0])
+      if len(node) > 1:
+        for child in node[1..^1]:
+          visitCall(child, table)
+  else:
+    for child in node.children():
+      visitCall(child, table)
+
+static:
+  const code = staticRead(expandTilde(&"~/.choosenim/toolchains/nim-{NimVersion}/lib/system.nim"))
+  var
+    ast = parseStmt(code)
+    callCounts = newCountTable[string]()
+  ast.visitCall(callCounts)
+  sort(callCounts)
+  var total = 10
+  for ident, times in callCounts.pairs():
+    echo(&"{ident} called {times} times")
+    total-=1
+    if total == 0:
+      break

Task/Function-frequency/Perl/function-frequency.pl

@@ -0,0 +1,16 @@
+use PPI::Tokenizer;
+my $Tokenizer = PPI::Tokenizer->new( '/path/to/your/script.pl' );
+my %counts;
+while (my $token = $Tokenizer->get_token) {
+    # We consider all Perl identifiers. The following regex is close enough.
+    if ($token =~ /\A[\$\@\%*[:alpha:]]/) {
+        $counts{$token}++;
+    }
+}
+my @desc_by_occurrence =
+    sort {$counts{$b} <=> $counts{$a} || $a cmp $b}
+         keys(%counts);
+my @top_ten_by_occurrence = @desc_by_occurrence[0 .. 9];
+foreach my $token (@top_ten_by_occurrence) {
+    print $counts{$token}, "\t", $token, "\n";
+}

Task/Function-frequency/Phix/function-frequency-1.phix

@@ -0,0 +1,4 @@
+(notonline)-->
+     <span style="color: #008080;">else</span> <span style="color: #000080;font-style:italic;">-- rType=FUNC|TYPE</span>
+         <span style="color: #000000;">log_function_call</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rtnNo</span><span style="color: #0000FF;">)</span>
+<!--

Task/Function-frequency/Phix/function-frequency-2.phix

@@ -0,0 +1,32 @@
+(notonline)-->
+ <span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- file i/o, etc...</span>
+ <span style="color: #008080;">constant</span> <span style="color: #000000;">func_log</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict</span><span style="color: #0000FF;">(),</span>
+          <span style="color: #000000;">func_freq</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new_dict</span><span style="color: #0000FF;">()</span>
+
+ <span style="color: #008080;">global</span> <span style="color: #008080;">procedure</span> <span style="color: #000000;">log_function_call</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">rtnNo</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">integer</span> <span style="color: #000000;">node</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">getd_index</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rtnNo</span><span style="color: #0000FF;">,</span><span style="color: #000000;">func_log</span><span style="color: #0000FF;">)</span>
+     <span style="color: #7060A8;">setd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rtnNo</span><span style="color: #0000FF;">,</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">?</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">getd_by_index</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">,</span><span style="color: #000000;">func_log</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span><span style="color: #000000;">func_log</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
+
+ <span style="color: #008080;">include</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">.</span><span style="color: #000000;">exw</span>   <span style="color: #000080;font-style:italic;">-- the phix compiler, full source
+
+ -- invert the dictionary, then print top ten</span>
+
+ <span style="color: #004080;">integer</span> <span style="color: #000000;">count</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
+ <span style="color: #008080;">function</span> <span style="color: #000000;">visitor</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">key</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">user_data</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">if</span> <span style="color: #000000;">user_data</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- invert</span>
+         <span style="color: #7060A8;">setd</span><span style="color: #0000FF;">({</span><span style="color: #000000;">data</span><span style="color: #0000FF;">,</span><span style="color: #000000;">key</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">func_freq</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">else</span>
+         <span style="color: #000000;">key</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">symtab</span><span style="color: #0000FF;">[</span><span style="color: #000000;">key</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]][</span><span style="color: #000000;">S_Name</span><span style="color: #0000FF;">]</span>
+         <span style="color: #0000FF;">?</span><span style="color: #000000;">key</span>
+         <span style="color: #000000;">count</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
+         <span style="color: #008080;">if</span> <span style="color: #000000;">count</span><span style="color: #0000FF;">></span><span style="color: #000000;">10</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- cease traversal</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #000000;">rebuild_callback</span><span style="color: #0000FF;">()</span> <span style="color: #000080;font-style:italic;">-- (convert ternary tree indexes to readable names)</span>
+
+ <span style="color: #7060A8;">traverse_dict</span><span style="color: #0000FF;">(</span><span style="color: #000000;">visitor</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">func_log</span><span style="color: #0000FF;">)</span>             <span style="color: #000080;font-style:italic;">-- invert</span>
+ <span style="color: #7060A8;">traverse_dict</span><span style="color: #0000FF;">(</span><span style="color: #000000;">visitor</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">func_freq</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rev</span><span style="color: #0000FF;">:=</span><span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>  <span style="color: #000080;font-style:italic;">-- top 10</span>
+<!--

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-1.rexx

@@ -0,0 +1,34 @@
+fid='pgm.rex'
+cnt.=0
+funl=''
+Do While lines(fid)>0
+  l=linein(fid)
+  Do Until p=0
+    p=pos('(',l)
+    If p>0 Then Do
+      do i=p-1 To 1 By -1 While is_tc(substr(l,i,1))
+        End
+      fn=substr(l,i+1,p-i-1)
+      If fn<>'' Then
+        Call store fn
+      l=substr(l,p+1)
+      End
+    End
+  End
+Do While funl<>''
+  Parse Var funl fn funl
+  Say right(cnt.fn,3) fn
+  End
+Exit
+x=a(3)+bbbbb(5,c(555))
+special=date('S') 'DATE'() "date"()
+is_tc:
+abc='abcdefghijklmnopqrstuvwxyz'
+Return pos(arg(1),abc||translate(abc)'1234567890_''"')>0
+
+store:
+Parse Arg fun
+cnt.fun=cnt.fun+1
+If cnt.fun=1 Then
+  funl=funl fun
+Return

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

@@ -0,0 +1,510 @@
+/* REXX ****************************************** Version 11.12.2015 **
+* Rexx Tokenizer to find function invocations
+*-----------------------------------------------------------------------
+* Tokenization remembers the following for each token
+* t.i       text of token
+* t.i.0t    type of token: Cx/V/K/N/O/S/L
+*             comment/variable/keyword/constant/operator/string/label
+* t.i.0il   line of token in the input
+* t.i.0ic   col of token in the input
+* t.i.0prev index of token starting previous instruction
+* t.i.0ol   line of token in the output
+* t.i.0oc   col of token in the output
+*---------------------------------------------------------------------*/
+  Call time 'R'
+  Parse Upper Arg fid '(' options
+  If fid='?' Then Do
+    Say 'Tokenike a REXX proram and list the function invocations found'
+    Say '  which are of the form symbol(... or ''string''(...'
+    Say '  (the left parenthesis must immediately follow the symbol'
+    Say '  or literal string.)'
+    Say 'Syntax:'
+    Say '  TKZ pgm < ( <Debug> <Tokens> >'
+    Exit
+    End
+  g.=0
+  Call init                         /* Initialize constants etc.      */
+  g.0cont='01'x
+  g.0breakc='02'x
+  cnt.=0
+  Call readin                       /* Read input file into l.*       */
+  Call tokenize                     /* Tokenize the input             */
+  tk=''
+  Call process_tokens
+  g.0fun_list=wordsort(g.0fun_list)
+  Do While g.0fun_list>''
+    Parse Var g.0fun_list fun g.0fun_list
+    Say right(cnt.fun,3) fun
+    End
+  Say time('E') 'seconds elapsed for' t.0 'tokens in' g.0lines 'lines.'
+  Exit
+
+init:
+/***********************************************************************
+* Initialize constants etc.
+***********************************************************************/
+  g.=''
+  g.0debug=0                        /* set debug off by default       */
+
+  fid=strip(fid)
+  If fid='' Then                    /* no file specified              */
+    Exit exit(12 'no input file specified')
+  Parse Var fid fn '.'
+
+  os=options                        /* options specified on command   */
+  g.0debug=0                        /* turn off debug output          */
+  g.0tokens=0                       /* No token file                  */
+  Do While os<>''                   /* process them individually      */
+    Parse Upper Var os o os         /* pick one                       */
+    Select
+      When abbrev('DEBUG',o,1) Then /* Debug specified                */
+        g.0debug=1                  /* turn on debug output           */
+      When abbrev('TOKENS',o,1) Then /* Write a file with tokens      */
+        g.0tokens=1
+      Otherwise                     /* anything else                  */
+        Say 'Unknown option:' o     /* tell the user and ignore it    */
+      End
+    End
+
+  If g.0debug Then Do
+    g.0dbg=fn'.dbg'; '@erase' g.0dbg
+    End
+  If g.0tokens Then Do
+    g.0tkf=fn'.tok'; '@erase' g.0tkf
+    End
+
+/***********************************************************************
+* Language specifics
+***********************************************************************/
+  g.0special='+-*/%''";:<>^\=|,()& '/* special characters             */
+                                        /* chars that may start a var */
+  g.0a='abcdefghijklmnopqrstuvwxyz'||,
+       'ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$!?_'
+  g.0n='1234567890'                 /* numeric characters             */
+  g.0vc=g.0a||g.0n||'.'             /* var-character                  */
+                                    /* multi-character operators      */
+  g.0opx='&& ** // << <<= <= <> == >< >= >> >>=',
+         '^< ^<< ^= ^== ^> ^>> \< \<< \= \== \> \>> ||'
+
+  t.=''                             /* token list                     */
+  Return
+
+readin:
+/***********************************************************************
+* Read the file to be formatted
+***********************************************************************/
+  lc=''
+  i=0
+  g.0lines=0
+  Do While lines(fid)<>0
+    li=linein(fid)
+    g.0lines=g.0lines+1
+    If i>0 Then
+      lc=strip(l.i,'T')
+    If right(lc,1)=',' Then Do
+      l.i=left(lc,length(lc)-1) li
+      End
+    Else Do
+      i=i+1
+      l.i=li
+      End
+    End
+  l.0=i
+  Call lineout fid
+  t=l.0+1
+  l.t=g.0eof                        /* add a stopper at program end   */
+  l.0=t                             /* adjust number of lines         */
+  g.0il=t                           /* remember end of program        */
+  Return
+
+tokenize:
+/***********************************************************************
+* First perform tokenization
+* Input:  l.*  Program text
+* Output: t.*  Token list
+*         t.0t.i token type CA CB CC C comment begin/middle/end
+*                           S          string
+*                           O          operator (special character)
+*                           V          variable symbol
+*                           N          constant
+*                           X          end of text
+* Note: special characters are treated as separate tokens
+***********************************************************************/
+  li=0                              /* line index                     */
+  ti=0                              /* token index                    */
+  Do While li<l.0                   /* as long as there is more input */
+    li=li+1                         /* index of next line             */
+    l=l.li                          /* next line to be processed      */
+    g.0newline=1
+    g.0cc=0                         /* current column                 */
+    Call dsp l.li                   /* debug output                   */
+    If l='' Then                    /* empty line                     */
+      Call addtoken '/*--*/','C'    /* preserve with special token    */
+    Do While l<>''                  /* work through the line          */
+      nbc=verify(l,' ')             /* first non-blank column         */
+      g.0cc=g.0cc+nbc               /* advance to this                */
+      If g.0newline='' Then Do
+        If t.ti.0ic='' Then
+          t.ti.0ic=0
+        If g.0cc=t.ti.0ic+length(t.ti) Then Do
+          tj=ti+1
+          t.tj.0ad=1
+          End
+        End
+      l=substr(l,nbc)               /* and continue with rest of line */
+      Parse Var l c +1 l 1 c2 +2    /* get character(s)               */
+      g.0tb=g.0cc                   /* remember where token starts    */
+      Select                        /* take a decision                */
+        When c2='/*' Then           /* comment starts here            */
+          Call comment              /* process comment                */
+        When pos(c,'''"')>0 Then    /* literal string starts here     */
+          Call string c             /* process literal string         */
+        Otherwise                   /* neither comment nor literal    */
+          Call token                /* get other token                */
+        End                         /* cmt, string, or token done     */
+      End                           /* end of loop over line          */
+    End                             /* end of loop over program       */
+  t.0=ti                            /* store number of tokens         */
+  Call dsp ti 'tokens' l.0 'lines'
+  Return
+comment:
+/***********************************************************************
+* Parse a comment
+* Nested comments are supported
+***********************************************************************/
+  cbeg=t.ti.0il
+  l=substr(l,2)                     /* continue after slash-asterisk  */
+  g.0cc=g.0cc+1                     /* update current char position   */
+  t='/*'                            /* token so far                   */
+  incmt=1                           /* indicate "within a comment"    */
+  Do Until incmt=0                  /* loop until done                */
+    bc=pos('/*',l)                  /* next begin comment, if any     */
+    ec=pos('*/',l)                  /* next end   comment, if any     */
+    Select                          /* decide                         */
+      When bc>0 &,                  /* begin-comment found            */
+           (ec=0 | bc<ec) Then Do   /* and no end-comment or later    */
+        t=t||left(l,bc+1)           /* add this all to token          */
+        incmt=incmt+1               /* increment comment nest-depth   */
+        l=substr(l,bc+2)            /* continue after slash-asterisk  */
+        g.0cc=g.0cc+bc+1            /* update current char position   */
+        End
+      When ec>0 Then Do             /* end-comment found              */
+        t=t||left(l,ec+1)           /* add all to token               */
+        incmt=incmt-1               /* decrement nesting              */
+        l=substr(l,ec+2)            /* continue after asterisk-slash  */
+        g.0cc=g.0cc+ec+1            /* update current char position   */
+        End
+      Otherwise Do                  /* no further comment bracket     */
+        Call addtoken t||l,ct()     /* rest of line to token          */
+        li=li+1                     /* proceed to next line           */
+        l=l.li                      /* contents of next line          */
+        g.0newline=1
+        If l=g.0eof Then Do
+          Say 'Comment started in line' cbeg 'is not closed before EOF'
+          Exit err(58)
+          End
+        g.0cc=0                     /* current char (none)            */
+        g.0tb=1                     /* token (comment) starts here    */
+        End
+      End
+    End
+  Call addtoken t,ct()             /* last (or only) comment token    */
+  If pos('*debug*',t)>0 Then g.0debug=1
+  Return
+
+ct:
+/***********************************************************************
+* Comment type
+***********************************************************************/
+  If incmt>0 Then Do                /* within a comment               */
+    If t.ti.0t='CA' |,              /* prev. token was start or cont  */
+       t.ti.0t='CB' Then Return 'CB'  /* this is continuation         */
+                    Else Return 'CA'  /* this is start                */
+    End
+  Else Do                           /* comment is over                */
+    If t.ti.0t='CA' |,              /* prev. token was start or cont  */
+       t.ti.0t='CB' Then Return 'CC'  /* this is final part           */
+                    Else Return 'C'   /* this is just a comment       */
+    End
+string:
+/***********************************************************************
+* Parse a string
+* take care of '111'B and '123'X
+***********************************************************************/
+  Parse Arg delim                  /* string delimiter found          */
+  t=delim                          /* star building the token         */
+  instr=1                          /* note we are within a string     */
+  g.0ss=li
+  Do Until instr=0                 /* continue until it is over       */
+    se=pos(delim,l)                /* ending delimiter                */
+    If se>0 Then Do                /* found                           */
+      If substr(l,se+1,1)=delim Then Do /* but it is doubled          */
+        t=t||left(l,se+1)          /* so add all so far to token      */
+        l=substr(l,se+2)           /* and take rest of line           */
+        g.0cc=g.0cc+se+1           /* and set current character pos   */
+        End
+      Else Do                      /* not another one                 */
+        instr=0                    /* string is done                  */
+        t=t||left(l,se)            /* add the string data to token    */
+        l=substr(l,se+1)           /* take the rest of the line       */
+        g.0cc=g.0cc+se             /* and set current character pos   */
+        If pos(translate(left(l,1)),'BX')>0 Then
+          If pos(substr(l,2,1),g.0vc)=0 Then Do
+            t=t||left(l,1)         /* add the char to the token       */
+            l=substr(l,2)          /* take the rest of the line       */
+            g.0cc=g.0cc+1          /* and set current character pos   */
+            End
+        End
+      End
+    Else Do                        /* not found                       */
+      Call addtoken t||l,'S'       /* store the token                 */
+      g.0lasttoken=''              /* reset this switch               */
+      li=li+1                      /* go on to the next line          */
+      If li>l.0 Then               /* there is no next line           */
+        Exit err(60,'string starting in line' g.0ss,
+                                      'does not end before end of file')
+      Else
+        Say 'string starting at line' g.0ss 'extended over line boundary'
+      l=l.li                       /* take contents of the next line  */
+      g.0cc=1                      /* current char position           */
+      g.0tb=1                      /* ??                              */
+      End
+    End
+  Call addtoken t,'S'              /* store the token                 */
+  Return
+token:
+/***********************************************************************
+* Parse a token
+***********************************************************************/
+  IF c=g.0comma & l='' Then Do
+    t=g.0cont
+    type='O'                        /* O (for operator - not quite...)*/
+    End
+  Else Do
+    If pos(c,g.0special)>0 Then Do  /* a special character            */
+      t=c                           /* take it as is                  */
+      type='O'                      /* O (for operator - not quite...)*/
+      End
+    Else Do                         /* some other character           */
+      nsp=verify(l,g.0special,'M')  /* find delimiting character      */
+      If nsp>0 Then Do              /* some character found           */
+        t=c||left(l,nsp-1)          /* take all up to this character  */
+        l=substr(l,nsp)             /* and continue from there        */
+        End
+      Else Do                       /* none found                     */
+        t=c||l                      /* add rest of line to token      */
+        l=''                        /* and all is used up             */
+        End
+      g.0cc=g.0cc+length(t)-1       /* adjust current char position   */
+      If pos(right(t,1),'eE')>0 &,  /* consider nxxxE+nn case         */
+         pos(left(l,1),'+-')>0 Then Do
+        If pos(left(t,1),'.1234567890')>0 Then /* start . or digit    */
+          If pos(substr(l,2,1),'1234567890')>0 Then Do /* dig after+- */
+            nsp=verify(substr(l,2),g.0special,'M')+1 /* find end      */
+            If nsp>1 Then           /* delimiting character found     */
+              exp=substr(l,2,nsp-2)   /* exponent (if numeric)        */
+            Else
+              exp=substr(l,2)
+          If verify(exp,'0123456789')=0 Then Do
+            t=t||left(l,1)||exp
+            l=substr(l,length(exp)+2)
+            g.0cc=g.0cc+length(exp)+2
+            End
+          End
+        End
+      Select
+        When isvar(t) Then          /* token qualifies as variable    */
+          type='V'
+        When isconst(t) Then        /* token is a constant symbol     */
+          type='N'
+        When t=g.0eof   Then        /* token is end of file indication*/
+          type='X'
+        Otherwise Do                /* anything else is an error      */
+          Say 'li='li
+          Say l
+          Say 'token error'
+          Trace ?R
+          Exit err(62,'token' t 'is neither variable nor constant')
+          End
+        End
+      If left(l,1)='(' Then
+        type=type||'F'
+      End
+    End
+  Call addtoken t,type              /* store the token                */
+  Return
+addtoken:
+/***********************************************************************
+* Add a token to the token list
+***********************************************************************/
+  Parse Arg t,type                  /* token and its type             */
+  If type='O' Then Do               /* operator (special character)   */
+    If pos(t,'><=&|/*')>0 Then Do   /* char for composite operator    */
+      If wordpos(t.ti||t,g.0opx)>0 Then Do  /*  composite operator    */
+        t.ti=t.ti||t                /* use concatenation              */
+                                    /* does not handle =/**/=         */
+        t=''                        /* we are done                    */
+        Return
+        End
+      End
+    End
+
+  If type='CC' & t='*/' Then Do     /* The special case for SPA       */
+    Return
+    End
+
+  ti=ti+1                           /* increment index                */
+  t.ti=t                            /* store token's value            */
+  t.ti.0t=left(type,1)              /*  and its type                  */
+  t.ti.0nl=g.0newline               /* token starts a new line        */
+  g.0newline=''                     /* reset new line switch          */
+  If t.ti.0t='C' Then Do
+    t.ti.0t=type
+    If left(t.ti,3)='/* ' &,
+       right(t.ti,3)=' */' Then
+      t.ti='/*' strip(substr(t.ti,4,length(t.ti)-6)) '*/'
+    End
+  t.ti.0f=substr(type,2,1)          /* 'F' if possibly a function     */
+  Call setpos ti li g.0tb           /*    and its position            */
+  If left(type,1)='C' Then          /* ??? */
+    If left(t.ti,2)<>'/*' Then Do
+      ts=strip(t.ti,'L')
+      t.ti.0oc=t.ti.0oc+length(t.ti)-length(ts)
+      t.ti=ts
+      End
+  If t.ti.0ol='' Then t.ti.0ol=li
+  If t.ti.0oc='' Then t.ti.0oc=0
+  t.ti.0il=t.ti.0ol                 /*    and its position            */
+  t.ti.0ic=t.ti.0oc                 /*    and its position            */
+  Call dsp ti t.ti t.ti.0il'/'t.ti.0ic '->' t.ti.0ol'/'t.ti.0oc
+  t=''                              /* reset token variable           */
+  Return
+
+lookback:
+/***********************************************************************
+* Look back if...
+***********************************************************************/
+  Do i_=ti To 1 By -1
+    Select
+      When left(t.i_.0t,1)='C' Then Nop
+      When t.i_.0used<>1 &,
+           (t.i_=g.0comma |,
+            t.i_=g.0cont)  Then Do
+        t.i_.0used=1
+        t.i_=g.0cont
+        Return '0'
+        End
+      Otherwise
+        Return '1'
+      End
+    End
+  Return '1'
+
+isvar:
+/***********************************************************************
+* Determine if a string qualifies as variable name
+***********************************************************************/
+  Parse Arg a_ +1 b_
+  res=(pos(a_,g.0a)>0) &,
+    (verify(b_,g.0a||g.0n||'.')=0)
+  Return res
+
+isconst:
+/***********************************************************************
+* Determine if a string qualifies as constant
+***********************************************************************/
+  Parse Arg a_
+  res=(verify(a_,g.0a||g.0n||'.+-')=0) /* ??? */
+  Return res
+
+setpos:
+  Parse Arg seti sol soc
+  setz='setpos:' t.seti t.seti.0ol'/'t.seti.0oc '-->',
+                                                    sol'/'soc '('sigl')'
+  Call dsp setz
+  t.seti.0ol=sol
+  t.seti.0oc=soc
+  Return
+
+process_tokens:
+/***********************************************************************
+* Process the token list
+***********************************************************************/
+  Do i=1 To t.0
+    If g.0tokens Then
+      Call lineout g.0tkf,right(i,4) right(t.i.0il,3)'.'left(t.i.0ic,3),
+                                     right(t.i.0ol,3)'.'left(t.i.0oc,3),
+                                     left(t.i.0t,2) left(t.i,25)
+    If t.i='(' Then Do
+      j=i-1
+      If t.j.0ol=t.i.0il & ,
+         t.j.0oc+length(t.j)=t.i.0ic &,
+         pos(t.j.0t,'VS')>0 Then
+        Call store_f t.j
+      End
+    End
+  If g.0tokens Then
+    Call lineout g.0tkf
+  Return
+
+store_f:
+  Parse Arg funct
+  If wordpos(funct,g.0fun_list)=0 then
+    g.0fun_list=g.0fun_list funct
+  cnt.funct=cnt.funct+1
+  Return
+
+dsp:
+/***********************************************************************
+* Record (and display) a debug line
+***********************************************************************/
+  Parse Arg ol_.1
+  If g.0debug>0 Then
+    Call lineout g.0dbg,ol_.1
+  If g.0debug>1 Then
+    Say ol_.1
+  Return
+
+wordsort: Procedure
+/**********************************************************************
+* Sort the list of words supplied as argument. Return the sorted list
+**********************************************************************/
+  Parse Arg wl
+  wa.=''
+  wa.0=0
+  Do While wl<>''
+    Parse Var wl w wl
+    Do i=1 To wa.0
+      If wa.i>w Then Leave
+      End
+    If i<=wa.0 Then Do
+      Do j=wa.0 To i By -1
+        ii=j+1
+        wa.ii=wa.j
+        End
+      End
+    wa.i=w
+    wa.0=wa.0+1
+    End
+  swl=''
+  Do i=1 To wa.0
+    swl=swl wa.i
+    End
+  Return strip(swl)
+
+err:
+/***********************************************************************
+* Diagnostic error exit
+***********************************************************************/
+  Parse Arg errnum, errtxt
+  Say 'err:' errnum  errtxt
+  If t.ti.0il>g.0il Then
+    Say 'Error' arg(1) 'at end of file'
+  Else Do
+    Say 'Error' arg(1) 'around line' t.ti.0il', column' t.ti.0ic
+    _=t.ti.0il
+    Say l._
+    Say copies(' ',t.ti.0ic-1)'|'
+    End
+  If errtxt<>'' Then Say '  'errtxt
+  Exit 12

Task/Function-frequency/Racket/function-frequency-1.rkt

@@ -0,0 +1,8 @@
+#lang racket
+(require math)
+(define in (open-input-file "function-frequency.rkt"))
+(void (read-language in))
+(define s-exprs (for/list ([s (in-port read in)]) s))
+(define symbols (filter symbol? (flatten s-exprs)))
+(define counts  (sort (hash->list (samples->hash symbols)) >= #:key cdr))
+(take counts (min 10 (length counts)))

Task/Function-frequency/Racket/function-frequency-2.rkt

@@ -0,0 +1,10 @@
+'((define . 4)
+  (counts . 3)
+  (s-exprs . 2)
+  (s . 2)
+  (symbols . 2)
+  (a-program . 2)
+  (filter . 1)
+  (hash->list . 1)
+  (in-port . 1)
+  (sort . 1))

Task/Function-frequency/Raku/function-frequency.raku

@@ -0,0 +1,7 @@
+my $text = qqx[raku --target=ast @*ARGS[]];
+my %fun;
+for $text.lines {
+    %fun{$0}++ if / '(call &' (.*?) ')' /
+}
+
+for %fun.invert.sort.reverse[^10] { .value.say }

Task/Function-frequency/Sidef/function-frequency.sidef

@@ -0,0 +1,14 @@
+func foo { }
+func bar { }
+
+foo(); foo(); foo()
+bar(); bar();
+
+var data = Perl.to_sidef(Parser{:vars}{:main}).flatten
+
+data.sort_by { |v| -v{:count} }.first(10).each { |entry|
+    if (entry{:type} == :func) {
+        say ("Function `#{entry{:name}}` (declared at line",
+             " #{entry{:line}}) is used #{entry{:count}} times")
+    }
+}

Task/Function-frequency/Smalltalk/function-frequency.st

@@ -0,0 +1,9 @@
+bagOfCalls := Bag new.
+Smalltalk allClassesDo:[:cls |
+    cls instAndClassMethodsDo:[:mthd |
+        bagOfCalls addAll:mthd messagesSent
+    ].
+].
+(bagOfCalls sortedCounts to:10) do:[:assoc |
+    Stdout printCR: e'method {assoc value} is called {assoc key} times.'
+].

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]
+}

Task/Function-frequency/Wren/function-frequency.wren

@@ -0,0 +1,24 @@
+import "io" for File
+import "os" for Process
+import "/pattern" for Pattern
+import "/set" for Bag
+import "/sort" for Sort
+import "/fmt" for Fmt
+
+var args = Process.arguments
+if (args.count != 1) {
+    Fiber.abort("There should be exactly one argument - the file path to be analyzed")
+}
+var p = Pattern.new("[+1/x.+1/x](")
+var source = File.read(args[0])
+var matches = p.findAll(source)
+var bag = Bag.new(matches.map { |m| m.captures[0].text })
+var methodCalls = bag.toMap.toList
+var cmp = Fn.new { |i, j| (j.value - i.value).sign }
+Sort.quick(methodCalls, 0, methodCalls.count-1, cmp)
+System.print("Top ten method/function calls in %(args[0]):\n")
+System.print("Called  Method/Function")
+System.print("------  ----------------")
+for (mc in methodCalls.take(10)) {
+    Fmt.print(" $2d     $s", mc.value, mc.key)
+}

Task/Function-frequency/XPL0/function-frequency.xpl0

@@ -0,0 +1,100 @@
+\codesr.xpl     Complete set of intrinsics for XPL0 on the Raspberry Pi
+code    \var:=\Abs(int)=0,              \var:=\Ran(range)=1,
+        \var:=\Rem(expr)=2,             \adr:=\Reserve(bytes)=3,
+        \var:=\Swap(int)=4,             \var:=\Extend(byte)=5,
+        Restart=6,                      \var:=\ChIn(dev)=7,
+        ChOut(dev,byte)=8,              CrLf(dev)=9,
+        \var:=\IntIn(dev)=10,           IntOut(dev,int)=11,
+        Text(dev,str)=12,               OpenI(dev)=13,
+        OpenO(dev)=14,                  Close(dev)=15,
+        Abort=16,                       Trap(bits)=17,
+        \var:=\Free=18,                 \var:=\Rerun=19,
+        \adr:=\GetHP=20,                SetHP(adr)=21,
+        \var:=\GetErr=22,               Cursor(X,Y)=23,
+        FSet(hand,^I/^O)=24,            SetRun(bool)=25,
+        \var:=\HexIn(dev)=26,           HexOut(dev,int)=27,
+        \var:=\FOpen(pathname,0=r/1=w)=29, FClose(hand)=32,
+        \var:=\KeyHit=33,               \var:=\ChkKey=33,
+        Sound(vol,dur,period)=39,       Clear=40,
+        Point(X,Y,color)=41,            Line(X,Y,color)=42,
+        Move(X,Y)=43,                   \var:=\ReadPix(X,Y)=44,
+        SetVid(mode)=45,                \var:=\Fix(real)=50,
+        Attrib(bg:fg)=69,               SetWind(X0,Y0,X1,Y1,mode,fill)=70,
+        RawText(dev,str)=71,            Hilight(X0,Y0,X1,Y1,bg:fg)=72,
+        \adr:=\MAlloc(bytes)=73,        Release(adr)=74,
+        TrapC(bool)=75,                 \var:=\TestC=76,
+        ShowMouse(bool)=77,             MoveMouse=78,
+        RanSeed(int)=79,                \rgb:=\GetPalette(reg)=80,
+        Paint(X,Y,W,H,image,W2)=81,     \var:=\GetTime=82,
+        BackUp=83,                      SetFB(W,H,D)=84,
+        \var:=\OpenMouse=85,            \adr:=\GetMouse=86,
+        \adr:=\GetMouseMove=87,         ShowCursor(bool)=88,
+        \var:=\GetKey=89,               SetPalette(reg,R,G,B)=90,
+        \adr:=\GetFont(set)=91,         SetFont(height,adr)=92,
+        \var:=\GetShiftKeys=93,         DelayUS(int)=94,
+        \adr:=\GetDateTime=95,          InsertKey(byte)=96,
+        \adr:=\GetFB=97,                WaitForVSync=98,
+        ShowPage(0/1)=99,               CopyMem(dst,src,bytes)=100,
+        FillMem(adr,byte,bytes)=101,    \adr:=\ReallocMem(adr,bytes)=102,
+        PlaySoundFile(pathname)=103,    SetHexDigits(digits)=104,
+        \process:=\Fork(processes)=105, Join(process)=106,
+        \adr:=\SharedMem(bytes)=107,    Lock(adr)=108,
+        Unlock(adr)=109;
+code real
+        \adr:=\RlRes(int)=46,           \var:=\RlIn(dev)=47,
+        RlOut(dev,real)=48,             \var:=\Float(int)=49,
+        \var:=\RlAbs(real)=51,          Format(int,int)=52,
+        \var:=\Sqrt(real)=53,           \var:=\Ln(real)=54,
+        \var:=\Exp(real)=55,            \var:=\Sin(real)=56,
+        \var:=\ATan2(realY,realX)=57,   \var:=\Mod(real,real)=58,
+        \var:=\Log(real)=59,            \var:=\Cos(real)=60,
+        \var:=\Tan(real)=61,            \var:=\ASin(real)=62,
+        \var:=\ACos(real)=63,           \var:=\Floor(real)=64,
+        \var:=\Ceil(real)=65,           \var:=\Pow(realX,realY)=66;
+
+include xpllib;
+
+int  Counts(128), I, Ch, Num, Maxx, SI Cnt;
+char Str, Addr;
+
+[\Read this program's compiled assembly language into a string
+if not OpenInFile("funcfreq.s") then
+        [Text(0, "funcfreq.s not found");  exit 1];
+Str:= 0;  I:= 0;
+loop    [Str:= ReallocMem(Str, I+1);
+        Ch:= ChIn(3);
+        if Ch = EOF then quit;
+        Str(I):= Ch;
+        I:= I+1;
+        ];
+Str(I):= 0;
+
+\Count numbers of times each intrinsic is called
+for I:= 0 to 127 do Counts(I):= 0;
+Addr:= Str;
+loop    [Addr:= StrFind(Addr, "intr");
+        if Addr = 0 then quit;
+        Addr:= Addr+4;          \skip "intr"
+        Num:= 0;
+        while Addr(0)>=^0 and Addr(0)<=^9 do
+                [Num:= Num*10 + Addr(0) - ^0;
+                Addr:= Addr+1;
+                ];
+        if Num < 128 then       \for safety
+                Counts(Num):= Counts(Num)+1;
+        ];
+
+Print("Top ten intrinsic calls (code: freq):\n");
+Cnt:= 0;
+loop    [Maxx:= 0;
+        for I:= 0 to 127 do
+            if Counts(I) > Maxx then
+                [Maxx:= Counts(I);
+                SI:= I;
+                ];
+        Print("%2d: %2d\n", SI, Counts(SI));
+        Counts(SI):= 0;
+        Cnt:= Cnt+1;
+        if Cnt >= 10 then quit;
+        ];
+]