aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Function-frequency/00DESCRIPTION
View file

@ -1,4 +1,4 @@
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).
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.

160
Task/Function-frequency/AWK/function-frequency.awk Normal file
View file

@ -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)
}
}
}

34
Task/Function-frequency/Common-Lisp/function-frequency.lisp Normal file
View file

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

56
Task/Function-frequency/J/function-frequency.j
View file

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

16
Task/Function-frequency/Perl/function-frequency.pl Normal file
View file

@ -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";
}

34
Task/Function-frequency/REXX/function-frequency-1.rexx Normal file
View file

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

510
Task/Function-frequency/REXX/function-frequency-2.rexx Normal file
View file

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

48
Task/Function-frequency/REXX/function-frequency.rexx
View file

@ -1,48 +0,0 @@
/*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))