Welcome to the Dictionary of Programming Languages, a compendium
of computer coding methods assembled to provide information and
aid your appreciation for computer science history.
Browse the dictionary by clicking on a section:
A
B
C
D
E
F
G
H
I
JK
L
M
N
O
P
QR
S
T
UV
WXYZ+
Get a full dump of the dictionary:
List of Names
Short Form
Full Form
HOW TO RETURN index doc: PUT {} IN where FOR line.no IN keys doc: TREAT LINE RETURN where TREAT LINE: FOR word IN split doc[line.no]: IF word not.in keys where: PUT {} IN where[word] INSERT line.no IN where[word]
PROGRAM ONE WHEEL " Simple model of a dynamical system " written in ACSL 1, circa 1982. INITIAL CINTERVAL CINT = 0.05 ALGORITHM IALG = 4 $ "RK3" CONSTANT X1IO = 0.0, X2IO=0.0, X1DIC=0.0, X2DIC = 0.0 CONSTANT M1 = 25.0, M2=2.0, DF=100.0, K2=5000 CONSTANT TDONE = 15.0 K1 = 1000.0 END $ "OF INITIALIZATION" DYNAMIC DERIVATIVE X3= STEP(0.0) X1D = INTEG((-DF/M1)*(X1D-X2D) - (K1/M1)*(X1-X2), X1DIC) X2D = INTEG((-DF/M1)*(X1D-X2D) - (K1/M1)*(X1-X2), ... (K2/M2)*(X2-X3*5.0), X2DIC) X1 = INTEG(X1D,X1IO) X2 = INTEG(X2D,X2IO) END "OF DERIVATIVE SECTION" TERMT(T .GE. TDONE) END "OF DYNAMIC SECTION" END "OF PROGRAM"
-- simple programming with floating-point #s with Ada.Float_Text_IO; use Ada.Float_Text_IO; procedure Think is A, B : Float := 0.0; -- A and B initially zero; note the period. I, J : Integer := 1; begin A := B * 7.0; I := J * 3; B := Float(I) / A; Put(B); end Think;
/* An Alef program to parse numbers out of * the string returned from /dev/time, and * print them from a separate proc. This is * a rather lame conglomeration of several * examples from Bob Flandrea's Alef * User's Guide */ tuple(int, uint, byte*) strtoui(byte* str, int base) { int val; while(*str != 0 && whitespace(*str)) str ; if(str == nil || *str == 0) return(0, 0, str); while(*str && !whitespace(*str)) { if(!validdigit(*str, base)) return (-1, val, str 1); /* extract digit into val */ str ; } return(1, val, str); } void receive(chan(uint) c) { int s; s = <-c; print("%d\n", s); if (s == 0) terminate(nil); } void main(void) { chan(uint) c; alloc c; proc receive(c); int ret; uint val; int fd; byte *p, buf[128], *newp; fd = open("/dev/time", OREAD|OCEXEC); if (fd >= 0) { read(fd, buf, sizeof(buf)); for(p = buf; *p; p = newp) { (ret, val, newp) = strtoui(p, 10); if(ret >= 0) c <-= val; if(ret == 0) break; } } }
// the main program, calculate the mean of // some numbers begin integer N; Read Int(N); begin real array Data[1:N]; real sum, avg; integer i; sum:=0; for i:=1 step 1 until N do begin real val; Read Real(val); Data[i]:=if val<0 then -val else val end; for i:=1 step 1 until N do sum:=sum Data[i]; avg:=sum/N; Print Real(avg) end end
Here is a better example, written in the
Algol60 publication language, from
Jean Sammet courtesy of
Glyn Webster.
procedure problem (a, b); value a, b; integer a, b; begin integer k; real e; for k := 2 × (a ÷ 2) 1 step 2 until b do begin e := if prime(k) then sqrt(3 × k sin(k)) else sqrt(4 × k cos(k)); if prime(k) then putlist(k, e, 'prime') else putlist(k, e, 'nonprime') end end problem;
-- Use the Finder to close all applications -- (by Joshua D. Baer) property specialApps : {"Finder"} tell application "Finder" set allApps to name of processes end tell repeat with someParticularApp in allApps if specialApps does not contain someParticularApp then tell application someParticularApp activate quit end tell end if end repeat
;; Very simple example of interactive extension ;; for AutoCAD (Defun c:SF2ACRE () (setq SF (getreal "Enter area in square feet: ")) (setq AGREAGE (/ SF 43560.0)) (alert (strcat "\nThe area in acres is " (rtos ARGEAGE 2 2))) )
BEGIN { if ("'$#argv'"==1) Col="'$1'"; else Col=1 } {Total = $Col; }; END { printf "Total for column %d with %d items: %d\n", Col,NR,Total }
class ACCOUNT feature balance: INTEGER; owner: PERSON; minimum_balance: INTEGER is 1000 open (who: PERSON) is -- Assign the account to owner who. do owner := who end deposit (sum: INTEGER) is -- Deposit sum into the account. do add (sum) end withdraw (sum: INTEGER) is -- Withdraw sum from the account. do add (-sum) end may_withdraw (sum: INTEGER): BOOLEAN is -- Is there enough money to withdraw sum? do Result := (balance >= sum + minimum_balance) end feature {NONE} add (sum: INTEGER) is -- Add sum to the balance. do balance := balance + sum end end -- class ACCOUNT
;; Simple Elisp example (defconst date-pattern-1 "\\(1?[0-9]\\)/\\([123]?[0-9]\\)/\\([0-9][0-9]\\)" "Regexp for one style of data string") (defun replace-all-dates () "Replace 1/27/93 dates with 27-1-93 dates" (interactive) (let ((mcount 0)) (while (re-search-forward date-pattern-1 nil t) (replace-match "\\2-\\1-\\3" nil nil) (setq mcount (+ 1 mcount))) (message (format "Replaced %d dates" mcount))) )
-module(sort). -export([sort/1]). sort([]) -> []; sort([Pivot|Rest]) -> {Smaller, Bigger} = split(Pivot, Rest), lists:append(sort(Smaller), [Pivot|sort(Bigger)]). split(Pivot, L) -> split(Pivot, L, [], []). split(Pivot, [], Smaller, Bigger) -> {Smaller, Bigger}; split(Pivot, [Hd|Tl], Smaller, Bigger) when Hd < Pivot -> split(Pivot, Tl, [Hd|Smaller], Bigger); split(Pivot, [Hd|Tl], Smaller, Bigger) when Hd >= Pivot -> split(Pivot, T, Smaller, [Hd|Bigger]).
Alternative version using Erlang 4.4 features:
-module(sort). -export([sort/1]). sort([Pivot|T]) -> sort([ X || X <- T, X < Pivot]) ++ [Pivot] ++ sort([ X || X <- T, X >= Pivot]); sort([]) -> [].
MODULE Lambda. CONSTRUCT Person/0. FUNCTION Jane, Mary, John: One -> Person. FUNCTION Mother : Person * Person -> Boolean. Mother(x,y) => x=Jane & y=Mary. FUNCTION Wife : Person * Person -> Boolean. Wife(x,y) => x=John & y=Jane. FUNCTION PrimitiveRel : (Person * Person -> Boolean) -> Boolean. PrimitiveRel(r) => r=Mother \/ r=Wife. FUNCTION Rel : (Person * Person -> Boolean) -> Boolean. Rel(r) => PrimitiveRel(r) \/ (SOME [r1,r2] (r = LAMBDA [u] (SOME [z] (r1(Fst(u),z) & r2(z,Snd(u)))) & PrimitiveRel(r1) & PrimitiveRel(r2))).
module AVERAGE: input INCREMENT_AVERAGE(integer); output AVERAGE_VALUE(integer); var TOTAL := 0, NUMBER := 0, : integer in every immediate INCREMENT_AVERAGE do TOTAL := TOTAL + ? INCREMENT_AVERAGE; NUMBER := NUMBER + 1; emit AVERAGE_VALUE (TOTAL / NUMBER) end end.
-- Prime sieve benchmark, adapted from Euphoria 2.0beta demos constant ON = 1, OFF = 0, SIZE = 5000, BATCH = 20 function sieve() sequence flags integer prime, start, count, still_prime count = 0 flags = repeat(ON, SIZE) for i = 1 to SIZE do still_prime = flags[i] if still_prime then prime = 2 * i prime = prime + 1 start = prime + i for k = start to SIZE by prime do flags[k] = OFF end for count = count + 1 end if end for return count end function atom t, cycles, p cycles = 0 t = time() while time() < t + 30 do -- test for 30 seconds for iter = 1 to BATCH do p = sieve() end for cycles = cycles + BATCH end while t = time() - t printf(1, "%6.1f sieves per second\n", cycles / t)
func cmplxplot(z, u) /* DOCUMENT cmplxplot, z, u * plots a scalar complex function of a complex variable. */ { resx=100; resy=100; s=[[sqrt(2./3.),0,1/sqrt(3)],[-1/sqrt(2*3.0),1/sqrt(2.),1/sqrt(3)], [-1/sqrt(2*3.0),-1/sqrt(2.),1/sqrt(3)]]; phi=span(-pi,pi,256); vec=array(double,3,256); vec(1,)=cos(phi); vec(2,)=sin(phi); vec(3,)=1/sqrt(2)(-); f=s(+,)*vec(+,); palette,bytscl(f(2,),top=255),bytscl(f(1,),top=255),bytscl(f(3,),top=255); xmin=min(u.re); xmax=max(u.re); ymin=min(u.im); ymax=max(u.im); zi=array(complex,resx,resy); zi.re=interp2(span(ymin,ymax,resy)(-:1:resx,),span(xmin,xmax,resx)(,-:1:resy), z.re,u.im,u.re); zi.im=interp2(span(ymin,ymax,resy)(-:1:resx,),span(xmin,xmax,resx)(,-:1:resy), z.im,u.im,u.re); // Caution: on some platforms atan(0,0) crashes ! arr=bytscl(atan(zi.im,zi.re+1e-200),cmin=-pi,cmax=pi); pli,arr, xmin,ymin,xmax,ymax; plc,abs(z),u.im,u.re,marks=0; }
(* Oberon module to read in numbers *) (* average them. *) MODULE Stats; IMPORT Texts, Oberon; TYPE Stat* = POINTER TO StatRec; StatRec *= RECORD count: LONGINT; total: REAL; END; PROCEDURE (s: Stat) Add* (REAL val); VAR this: Stat; BEGIN this := s; this.total := this.total + val; this.count := this.count + 1; END Add; PROCEDURE (s: Stat) Reset*; VAR this: Stat; BEGIN this := s; this.total := 0.0; this.count := 0; END Reset; PROCEDURE (s: Stat) IsValid*: BOOLEAN; VAR this: Stat; BEGIN this := s; RETURN (this.count > 0); END Reset; PROCEDURE (s: Stat) Average*: REAL; VAR this: Stat; BEGIN this := s; IF this.IsValid^() THEN RETURN 0.0 ELSE RETURN (this.total / this.count) END Average; END Stats;
/* still need an example here */
Server side:
(* A server for computing factorials. *) module FactServer; let fact = net_export("fact","", { m => meth(s,n) if n is 0 then 1 else n * s.m(n-1) end end });
Client side:
module FactClient; let fact = net_import("fact",""); fact.m(13);
-- Pipelined parallel sort in occam --(from Pountain and May, A Tutorial -- Introduction to Occam Programming) VAL numbers IS 100 : [numbers + 1] CHAN OF INT pipe: PAR PAR i = 0 FOR numbers input IS pipe[i] : output IS pipe[i+1] : INT highest : SEQ input ? highest SEQ j = 0 FOR numbers - 1 INT next: SEQ input ? next IF next <= highest output ! highest next > highest SEQ output ! highest highest := next SEQ i = 0 FOR numbers -- get unsorted INT unsortednumber : -- numbers SEQ input ? unsortednumber pipe[0] ! unsortednumber SEQ i = 0 FOR numbers -- dump sorted INT sortednumber : -- numbers SEQ pipe[numbers] ? sortednumber output ! sortednumber
; An OPS5 program that implements a model of ; rock climbers, from exercise solutions of ; "Expert Systems Programming in OPS5" (literalize rock-climber age ; young or old style ; timid or bold ) (p old-not-bold (rock-climber ^age old ^style <> bold) ---> (write (crlf) that is plausible)) (p bold-not-old (rock-climber ^age <> old ^style bold) ---> (write (crlf) that is quite possible)) (p error::old-and-bold (rock-climber ^age old ^style bold) ---> (write (crlf) There are no old, bold rock climbers)) (make rock-climber ^age young ^style bold)
# An example object from the paper # "Experiences with the Orca Programming Language" # by Bal and Wilson OBJECT IMPLEMENTATION buffer; CONST MAXSIZE = 10; # Maximum size of the buffer # Local state of the object: buf:ARRAY[integer 0..MAXSIZE-1] OF integer; # the buffer itself in, out: integer; # index of next element to put/get size: integer; # current size OPERATION put(x: integer); BEGIN GUARD size ! MAXSIZE DO # blocks until there is room buf[in] := x; # store element in := (in + 1) % MAXSIZE; # bump input index size +:= 1; # increment size OD; END; OPERATION get(x: OUT integer); BEGIN GUARD size ? 0 DO # blocks while buffer is empty x := buf[out]; # retrieve element out := (out + 1) % MAXSIZE; # bump output index size -:= 1; # decrement size OD; END; END;
local proc {AndThen BP1 BP2 ?B} case {BP1} then case {BP2} then B = true else B = false end else B = false end end in proc {BinaryTree T ?B} case T of nil then B = true [] tree(K V T1 T2) then {AndThen proc {$ B1}{BinaryTree T1 B1} end proc {$ B2}{BinaryTree T2 B2} end B} else B = false end end end
An example of using VBScript to check form data.
Function isSSN(ssns) isSSN = False If (len(ssns) = 9 or len(ssns) = 11) Then isSSN = True End If End Function Sub submit_OnClick dim namestr, ssnstr, psw, req set form = document.form1 namestr = Trim(form.NameStrField.Value) ssnstr = Trim(form.SSNStrField.Value) If (len(namestr) = 0) Then msgbox "Name is empty, please type in your name" Exit Sub ElseIf (not isSSN(ssnstr)) Then msgbox "SSN field is not the right length, please fix it" Exit Sub Else psw = InputBox("Enter your password:","Form Password","") End If req = "http://test.org/cgi/start.cgi?ssn=" & ssnstr & "&passwd=" psw loc.href = req End Sub
-- Behavioral model of a D flip-flop, from -- the US Army FCIM VHDL Tutorial. USE WORK.std_logic_1164.ALL ENTITY mydff IS GENERIC(q_out, qb_out :time); PORT(preset, clear, din, clock: :IN std_logic; q, qb : :OUT std_logic); END mydff ARCHITECTURE behavioral OF mydff IS BEGIN mydff_proc : PROCESS(preset, clear, clock) VARIABLE int_q :std_logic; BEGIN IF preset = '0' AND clear = '0' THEN IF(clock'EVENT) AND (clock = '1') THEN int_q := din; END IF; ELSEIF preset = '1' AND clear ='0' THEN int_q := '1'; ELSEIF clear = '1' AND preset = '0' THEN int_q := '0'; ELSE int_q := 'X'; ENDIF; q <= int_q AFTER q_out; int_q := NOT(int_q); qb <= int_q AFTER qb_out; END PROCESS mydff_proc; END behavioral;
' Simple program to compute factorials ' (placeholder until I write a better example) Function factorial(n as Long) If (n <= 0) Then factorial = 1 Else factorial = n * factorial(n - 1) End If End Function Dim fx(12) as Long For i = 1 to 12 fx(i) = factorial(i) Next
/* A program to count words in input files * (from examples at the ICI web site) */ static count_tokens(in) { auto count; count = 0; while (gettoken(in)) ++count; return count; } if (argc < 2) printf("%d\n", count_tokens(stdin)); else { auto f, fn, total; total = 0; forall (fn in interval(argv, 1)) { if (fn == "-") count = count_tokens(stdin); else { auto count; count = count_tokens(f = fopen(fn)); close(f); } printf("%s %d\n", fn, count); total += count; } if (argc > 2) printf("Total %d\n", total); }
# Example from New Mexico Tech Icon # tutorial by John Shipman procedure Quadratic_Roots ( a, b, c ) # Generates the real roots of ax^2+bx+c=0. local d # Discriminant d := b ^ 2 - 4.0 * a * c; # Compute the discriminant if d > 0 then { #-- Two roots suspend ( - b + sqrt ( d ) ) / ( 2.0 * a ); suspend ( - b - sqrt ( d ) ) / ( 2.0 * a ); } #-- Two roots else if d = 0 then suspend - b / ( 2.0 * a ); fail; # No more roots end procedure main () local root # Holds each root generated by the solver local count # Counts the number of roots returned count := 0; every root := Quadratic_Roots ( 1, -4, 3 ) do { #-- The braces {} group the next two statements together write ( "One solution is: x = ", root ); count +:= 1; # Count the roots generated } write ( "The number of solutions was ", count ); end
INTERCAL's main advantage over other programming languages is its simplicity. It has few capabilities, and thus there are few restrictions to be kept in mind. Since it is an exceedingly easy language to learn, one might expect it would be a good language for initiating novice programmers. Perhaps surprising, than [sic], is the fact that it would be more likely to initiate the novice into a search for another line of work.
PLEASE NOTE THIS PROGRAM PRINTS A LIST PLEASE DO NOT ASSUME THAT THE NUMBERS ARE COMPOSITE PLEASE NOTE THIS PROGRAM WAS SWIPED FROM LOUIS HOWELL DO READ OUT #2 DO .10 <- #1 PLEASE COME FROM (23) DO .11 <- !10$#1'~'#32767$#1' DO .12 <- #1 PLEASE COME FROM (16) DO .13 <- !12$#1'~'#32767$#1' DO .1 <- .11 DO .2 <- .13 DO (2030) NEXT DO (11) NEXT (15) DO (13) NEXT (13) DO .3 <- "?!4~.4'$#2"~#3 DO (14) NEXT PLEASE FORGET #1 DO .1 <- .12 DO (1020) NEXT (16) DO .12 <- .1 (12) DO .3 <- '?.2$.3'~'#0$#65535' DO .3 <- '?"'&"!2~.3'~'"?'?.3~.3'$#32768"~"#0$#65535"'"$ ".3~.3"'~#1"$#2'~#3 (14) PLEASE RESUME .3 (11) DO (12) NEXT DO FORGET #1 PLEASE READ OUT .11 DO COME FROM (15) DO .1 <- .10 DO (1020) NEXT DO .10 <- .1 (23) DO (21) NEXT (22) PLEASE RESUME "?!10~#32768'$#2"~#3 (21) DO (22) NEXT DO FORGET #1 PLEASE GIVE UP (2010) PLEASE ABSTAIN FROM (2004) (2000) PLEASE STASH .2 DO .2 <- #1 DO (2001) NEXT (2001) PLEASE FORGET #1 DO .1 <- '?.1$.2'~'#0$#65535' DO (2002) NEXT DO .2 <- !2$#0'~'#32767$#1' DO (2001) NEXT (2003) PLEASE RESUME "?!1~.2'$#1"~#3 (2002) DO (2003) NEXT PLEASE RETRIEVE .2 (2004) PLEASE RESUME #2 PLEASE DO REINSTATE (2004) PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 (2020) PLEASE STASH .2 + .3 DO (1021) NEXT (2030) DO STASH .1 + .5 DO .3 <- #0 DO .5 <- '?"!2~.2'~#1"$#1'~#3 PLEASE DO (2031) NEXT DO .4 <- #1 PLEASE DO (2033) NEXT (2033) DO FORGET #1 DO .5 <- '?".2~#32768"$#2'~#3 DO (2032) NEXT DO .2 <- !2$#0'~'#32767$#1' PLEASE DO .4 <- !4$#0'~'#32767$#1' DO (2033) NEXT (2032) DO (1001) NEXT (2036) PLEASE FORGET #1 DO .5 <- '?.1$.2'~'#0$#65535' DO .5 <- '?"'&"!2~.5'~'"?'?.5~.5'$#32768"~"#0$#65535"'"$ ".5~.5"'~#1"$#2'~#3 DO (2034) NEXT DO .5 <- .3 DO (1010) NEXT PLEASE DO .1 <- .3 DO .3 <- 'V.4$.5'~'#0$#65535' DO (2035) NEXT (2034) PLEASE DO (1001) NEXT (2035) DO FORGET #1 DO .5 <- "?'.4~#1'$#2"~#3 DO (2031) NEXT DO .2 <- .2~#65534 DO .4 <- .4~#65534 PLEASE DO (2036) NEXT (2031) DO (1001) NEXT PLEASE DO .4 <- .1 PLEASE RETRIEVE .1 + .5 PLEASE RESUME #2
HOW TO RETURN index doc: PUT {} IN where FOR line.no IN keys doc: TREAT LINE RETURN where TREAT LINE: FOR word IN split doc[line.no]: IF word not.in keys where: PUT {} IN where[word] INSERT line.no IN where[word]
PROGRAM ONE WHEEL " Simple model of a dynamical system " written in ACSL 1, circa 1982. INITIAL CINTERVAL CINT = 0.05 ALGORITHM IALG = 4 $ "RK3" CONSTANT X1IO = 0.0, X2IO=0.0, X1DIC=0.0, X2DIC = 0.0 CONSTANT M1 = 25.0, M2=2.0, DF=100.0, K2=5000 CONSTANT TDONE = 15.0 K1 = 1000.0 END $ "OF INITIALIZATION" DYNAMIC DERIVATIVE X3= STEP(0.0) X1D = INTEG((-DF/M1)*(X1D-X2D) - (K1/M1)*(X1-X2), X1DIC) X2D = INTEG((-DF/M1)*(X1D-X2D) - (K1/M1)*(X1-X2), ... (K2/M2)*(X2-X3*5.0), X2DIC) X1 = INTEG(X1D,X1IO) X2 = INTEG(X2D,X2IO) END "OF DERIVATIVE SECTION" TERMT(T .GE. TDONE) END "OF DYNAMIC SECTION" END "OF PROGRAM"
-- simple programming with floating-point #s with Ada.Float_Text_IO; use Ada.Float_Text_IO; procedure Think is A, B : Float := 0.0; -- A and B initially zero; note the period. I, J : Integer := 1; begin A := B * 7.0; I := J * 3; B := Float(I) / A; Put(B); end Think;
/* An Alef program to parse numbers out of * the string returned from /dev/time, and * print them from a separate proc. This is * a rather lame conglomeration of several * examples from Bob Flandrea's Alef * User's Guide */ tuple(int, uint, byte*) strtoui(byte* str, int base) { int val; while(*str != 0 && whitespace(*str)) str ; if(str == nil || *str == 0) return(0, 0, str); while(*str && !whitespace(*str)) { if(!validdigit(*str, base)) return (-1, val, str 1); /* extract digit into val */ str ; } return(1, val, str); } void receive(chan(uint) c) { int s; s = <-c; print("%d\n", s); if (s == 0) terminate(nil); } void main(void) { chan(uint) c; alloc c; proc receive(c); int ret; uint val; int fd; byte *p, buf[128], *newp; fd = open("/dev/time", OREAD|OCEXEC); if (fd >= 0) { read(fd, buf, sizeof(buf)); for(p = buf; *p; p = newp) { (ret, val, newp) = strtoui(p, 10); if(ret >= 0) c <-= val; if(ret == 0) break; } } }
// the main program, calculate the mean of // some numbers begin integer N; Read Int(N); begin real array Data[1:N]; real sum, avg; integer i; sum:=0; for i:=1 step 1 until N do begin real val; Read Real(val); Data[i]:=if val<0 then -val else val end; for i:=1 step 1 until N do sum:=sum Data[i]; avg:=sum/N; Print Real(avg) end end
Here is a better example, written in the
Algol60 publication language, from
Jean Sammet courtesy of
Glyn Webster.
procedure problem (a, b); value a, b; integer a, b; begin integer k; real e; for k := 2 × (a ÷ 2) 1 step 2 until b do begin e := if prime(k) then sqrt(3 × k sin(k)) else sqrt(4 × k cos(k)); if prime(k) then putlist(k, e, 'prime') else putlist(k, e, 'nonprime') end end problem;
-- Use the Finder to close all applications -- (by Joshua D. Baer) property specialApps : {"Finder"} tell application "Finder" set allApps to name of processes end tell repeat with someParticularApp in allApps if specialApps does not contain someParticularApp then tell application someParticularApp activate quit end tell end if end repeat
;; Very simple example of interactive extension ;; for AutoCAD (Defun c:SF2ACRE () (setq SF (getreal "Enter area in square feet: ")) (setq AGREAGE (/ SF 43560.0)) (alert (strcat "\nThe area in acres is " (rtos ARGEAGE 2 2))) )
BEGIN { if ("'$#argv'"==1) Col="'$1'"; else Col=1 } {Total = $Col; }; END { printf "Total for column %d with %d items: %d\n", Col,NR,Total }
{ Table data structure, adapted from an example in "Multiparadigm Data Structures in Leda" by Tim Budd, 1993 Assumes the list data structure is already defined. } class Association [X, Y : equality] of equality[Association]; var key : X; value : Y; function equals(argValue : Association[X, Y])->boolean; begin return key = argValue.key; end; end; class Table [X, Y : equality] { of equality[Association] }; var data : List[Association[X, Y]]; function add (newKey : X, newValue : Y); begin if ~ defined(data) then data := List[Association[X, Y]](); data.add(Association[X, Y](newKey, newValue)); end; function onEach (theFun : function(X, Y)); begin if defined(data) then data.onEach(function (item : Association[X, Y]); begin theFun(item.key, item.value); end); end; function items (byRef key : X, byRef value : Y)->relation; var element : Association[X, Y]; begin return defined(data) & data.items(element) & unify[X](key, element.key) & unify[Y](value, element.value); end; function includesKey (key : X)->boolean; var value : Y; begin if items(key, value) then return true; return false; end; function at (key : X)->Y; var value : Y; begin if items(key, value) then return value; return NIL; end; function atPut (key : X, value : Y); var element : Association[X, Y]; begin if defined(data) & data.items(element) & element.key = key then element.value := value else add(key, value); end; end;
global(sieve)? global(limit)? main :- write("N=?"), read_token(limit & int), next_prime(2), nl. remove_multiples(P,M) :- cond(M < limit, (sieve.M <-multiple_of(P),remove_multiples(P,M+P)) ). next_prime(P) :- P < limit, !, SP=sieve.P, ( SP=prime(P), !, write(P,' '), remove_multiples(P,2*P) ; succeed ), next_prime(P+1). next_prime(P).
# A simple program to sum up some numbers # presented on the command line, from # Bob Pike's forthcoming book on Limbo. implement Sum; include "sys.m"; sys: Sys; include "draw.m"; Sum: module { init: fn(context: ref Draw->Context, argl: list of string); }; init(context: ref Draw->Context, argl: list of string) { sys = load Sys Sys->PATH; argl = tl argl; # ignore command name if(len argl == 0){ sys->print("usage: sum numbers....\n"); return; } sum := 0.0; while(argl != nil){ arg := hd argl; sys->print("%s", arg); sum += real arg; argl = tl argl; if(argl != nil) sys->print(" + "); } sys->print(" = %g\n", sum); }
;; Simple factorial routine ;; (until I get a better example written) (defun fact1 (num) (cond ((not (integerp num)) nil) ((<= num 1) 1) (t (* num (fact1 (- num 1))))) )
; Recursive procedure to line, fractalized to DrawFractalLine :level :length ifelse :level < 1 [ fd :length] [ DrawFractalLine (sum -1 :level) (quotient :length 3.00) left 60 DrawFractalLine (sum -1 :level) (quotient :length 3.00) right 120 DrawFractalLine (sum -1 :level) (quotient :length 3.00) left 60 DrawFractalLine (sum -1 :level) (quotient :length 3.00) ] end ; procedure to clear screen and position turtle to SetupTurtle cs setpos [-160 -10] right 60 clean end ; setup turtle then draw Koch's snowflake(5) SetupTurtle setpensize [2 2] repeat 3 [DrawFractalLine 5 330 right 120]
' Find agents owned by the current user ' and remove them (Adapted from examples at ' www.lotus.com) Dim session As New NotesSession Dim db As NotesDatabase Dim agentArray(1 To 10) As NotesAgent Dim count as Integer Dim answer as string count = 0 Set db = session.CurrentDatabase Forall a In db.Agents If ( a.Owner = session.UserName ) Then Set agentArray(count) = a count = count + 1 If (count > 10) Then Exit Forall End If End If End Forall answer = Inputbox$( "You have " & count & " agents. Delete them?" ) If (answer = "y") Or (answer = "yes") Then Forall a in agentArray Call a.Remove End Foreall End If
-- Simple Lua program that implements the -- bisection method for solving non-linear equations function bisect(f,a,b,fa,fb) write(n," a=",a," fa=",fa," b=",b," fb=",fb,"\n") local c=(a+b)/2 if abs(a-b) < delta then return c end n=n+1 local fc=f(c) if fa*fc < 0 then return bisect(f,a,c,fa,fc) else return bisect(f,c,b,fc,fb) end end -- find root of f in the inverval [a,b]. -- bisection requires that f(a)*f(b) < 0 function solve(f,a,b) delta=1e-6 -- tolerance n=0 local z=bisect(f,a,b,f(a),f(b)) write(format("after %d steps, root is %.10g\n",n,z)) end -- test the bisection code with -- a function: x^3 - x - 1 function f(x) return x*x*x - x - 1 end solve(f,1,2)
h where h = 1 fby merge(merge(2 * h, 3 * h), 5 * h); merge(x,y) = if xx <= yy then xx else yy fi where xx = x upon xx <= yy; yy = y upon yy <= xx; end; end;
Descriptions in this dictionary are ©1997-99 Neal Ziring. Some examples copyright of their respective authors. Some technologies and languages are trademarked. Permission to copy descriptions is granted as long as authorship credit is preserved.
Comments on this dictionary, corrections and suggestions, are all welcome. Please use email, the address is ziring@home.com
[Ziring MicroWeb Home] [Dictionary Start] [Sign Guestbook]
Dictionary and script maintained by Neal Ziring, last major modifications 3/18/98. Most recent additions to dictionary and master list, 1/00.