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; }
/* 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
# Some S code to plot concentric convex hulls # around some data, from the documentation for # the chull function. drawhull <- function(xvec, yvec, ltype) { polygon(xvec, yvec, density=0, lty=ltype) } p <- chull(corn.rain, corn.yield, peel=T) which <- rep(seq(p$count), p$count) s <- split(p$hull, which) plot(corn.rain, corn.yield, pch="X") for(i in seq(s)) { j <- s[[i]] if (length(j) > 2) drawhull(corn.rain[j], corn.yield[j], i) }
-- Still working on a good code example here... -- A simple class from the Sather Essential manual class POINT is attr x,y:INT; create(x,y:INT):POINT is res:POINT := new; res.x := x; res.y := y; return res; end; add(xval,yval:INT):POINT is xsum:INT := x xval; ysum:INT := y yval; res:POINT := #POINT(xsum, ysum); return res; end; offset_by(val:INT):POINT is return add(val,val); end; end;
;;; takes two sorted lists merges them (define (merge! a b less?) (define (loop r a b) (if (less? (car b) (car a)) (begin (set-cdr! r b) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b)) )) ;; (car a) <= (car b) (begin (set-cdr! r a) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) )) ) (cond ((null? a) b) ((null? b) a) ((less? (car b) (car a)) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b))) b) (else ; (car a) <= (car b) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) a)))
$ A SETL program to do the sieve of $ Erastothenes (probably badly, but its my first $ SETL program) program sieve; read(mx); primes := {}; (for x in [3..mx] | odd x) primes with:= x; end; (for x in [3..ceil(mx / 2)] | odd x) primes := sieve1(x, primes); end; print(primes); proc sieve1(rd n, rd pset); (for x in pset | n < x and x mod n = 0) pset less:= x; end; return pset; end proc sieve1; end program sieve;
#!/bin/sh # Simple shell script to count files of size # greater than 1k if [ -z "$1" ] then pat="*" else pat="$1" fi cnt=0 for fname in $pat do if [ -r $fname -a ! -d $fname ] then size=`cat $fname | wc -c` if [ $size -gt 1024 ] then echo $fname ' ' $size cnt=`expr $cnt 1` fi fi done echo "${pat}: Files bigger than 1K: $cnt" exit
Preamble '' A simple telephone system model - CACI Products Company '' files: TELPHN1.SRC Normally mode is integer Processes include GENERATOR Every INCOMING.CALL has a CALL.ID Define NUMBER.BUSY and LOST.CALLS as integer variables End ''Preamble Main Activate a GENERATOR now Start simulation Print 1 line with LOST.CALLS thus 15 phone calls were made and ** were lost due to busy lines End ''Main Process GENERATOR For I = 1 to 15 do Activate a INCOMING.CALL now Let CALL.ID(INCOMING.CALL) = I Wait uniform.f (2.0, 6.0, 1) minutes Loop End ''GENERATOR Process INCOMING.CALL If NUMBER.BUSY < 2 Add 1 to NUMBER.BUSY Wait uniform.f(6.0, 10.0, 2) minutes Subtract 1 from NUMBER.BUSY Else Add 1 to LOST.CALLS Endif End ''INCOMING.CALL
Class Line(a,b,c); real a,b,c; begin boolean procedure parallelto(l); ref(Line) l; if l =/= none then parallelto := abs(a*l.b - b* l.a) < 0.00001; ref(Point) procedure meets(l); ref(Line) l; begin real t; if l =/= none and ~parallelto(l) then begin t := 1/(l.a * b - l.b * a); *** complicated expressions omitted below *** meets :- new Point(..., ...); end; end; ***meets*** real d; d := sqrt(a**2 b**2); if d = 0.0 then error else begin d := 1/d; a := a * d; b := b * d; c := c * d; end; end *** Line***
// an example from the Sina/st 3.1 distribution main comment ' Bring a salute to our globe'; temps hello: HelloWorld; begin hello.show end // main #Category 'Sina-Hello world'; class HelloWorld interface methods show returns nil; inputfilters disp: Dispatch = {inner.*}; end; // interface HelloWorld class HelloWorld implementation methods show begin self.printLine('Hello, world!'); return end; // show end; // implementation HelloWorld
% A simple example of using SISAL arrays, % adapted from various sample exercises in the % SISAL tutorial by John Feo. define main type Matrix = array [ array [ real ] ] % generate a square matrix where element [n,m] % is set to n m function gensquare(siz : integer returns Matrix ) for i in 1,siz cross j in 1,siz returns array of real(i) real(j) end for end function % perform one step of a relaxation, average each % element with its eight nearest neighbors function relax ( a : Matrix returns Matrix ) for row in a at i cross elt in row at j avg := (elt a[i, j-1] a[i, j 1] a[i 1, j-1] a[i 1, j] a[i 1, j 1] a[i-1, j-1] a[i-1, j] a[i-1, j 1]) / 9.0 returns array of avg end for end function % test the generator and relax function function main(returns Matrix) let a1 := gensquare(5) in a1 end let end function
GEN, PEGDEN, SERIAL WORK AREAS QUEUE MODEL, 7/14/77, 1; LIMITS,2,1,50; NETWORK; CREATE, EXPON(.4), , 1; QUEUE(1), 0, 4, BALK(SUB); ACT/1,EXPON(0.25); QUEUE(2), 0, 2, BLOCK; ACT/2,EXPON(0.50); COLCT, INT(1), TIME IN SYSTEM, 20/0/.25 TERM; SUB COLCT,BET,TIME BETWEEN BALKS; TERM; INIT,0,300; FIN;
' Smalltalk class to constraint a 2D point to a fixed grid ' (from Horan & Hopkins, Smalltalk: An Introduction...) Point subclass: #GriddedPoint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Exercise11.5'! !GriddedPoint methodsFor: 'accessing'! x: xInteger "Set the x coordinate gridded to 10 (using rounding, alternatively I could use truncating)." super x: (xInteger roundTo: 10)! y: yInteger "Set the y coordinate gridded to 10 (using rounding, alternatively I could use truncating)." super y: (yInteger roundTo: 10)! ! !GriddedPoint methodsFor: 'private'! setX: xPoint setY: yPoint "Initialize the instance variables rounding to 10." super setX: (xPoint roundTo: 10) setY: (yPoint roundTo: 10)! !
* Find biggest words and numbers in a test string * (from Griswold,Poage,& Polonsky, 1971) BIGP = (*P $ TRY *GT(SIZE(TRY,SIZE(BIG))) $ BIG FAIL STR = 'IN 1964 NFL ATTENDANCE JUMPED TO 4,807884; ' 'AN INCREASE OF 401,810.' P = SPAN('0123456789,') BIG = STR BIGP OUTPUT = 'LONGEST NUMBER IS ' BIG P = SPAN('ABCDEFGHIJKLMNOPQRSTUVWXYZ') BIG = STR BIGP OUTPUT = 'LONGEST WORD IS ' BIG END
** An example numerical integration program ** from the UFO1.0 Tutorial by J. Sargeant. polyf (x : Float) : Float is 2*x*x + 6*x + 1 trap(f: Float -> Float; a,b,approx : Float; n : Int) : Float is { h = (b - a) / n; return approx/2 + h* initially s = 0.0; for i in [1 to n step 2] do x = a + i * h ; new s = s + f(x) ; return s od } integrate(f : Float -> Float; a, b: Float) : Float is initially done = false; n = 1 ; integral = (f(a) + f(b)) * (b - a) / 2; while not done do next_integral = trap(f, a, b, integral, 2 * n) ; new n = 2 * n ; new done = abs(next_integral - integral) < 1.0e-4 new integral = next_integral return next_integral od main : String is "Integral is " ++ print(integrate(Float|polyf, 1.0, 6.0) ++ "\n"
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;
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 }
# Some S code to plot concentric convex hulls # around some data, from the documentation for # the chull function. drawhull <- function(xvec, yvec, ltype) { polygon(xvec, yvec, density=0, lty=ltype) } p <- chull(corn.rain, corn.yield, peel=T) which <- rep(seq(p$count), p$count) s <- split(p$hull, which) plot(corn.rain, corn.yield, pch="X") for(i in seq(s)) { j <- s[[i]] if (length(j) > 2) drawhull(corn.rain[j], corn.yield[j], i) }
-- Still working on a good code example here... -- A simple class from the Sather Essential manual class POINT is attr x,y:INT; create(x,y:INT):POINT is res:POINT := new; res.x := x; res.y := y; return res; end; add(xval,yval:INT):POINT is xsum:INT := x xval; ysum:INT := y yval; res:POINT := #POINT(xsum, ysum); return res; end; offset_by(val:INT):POINT is return add(val,val); end; end;
;;; takes two sorted lists merges them (define (merge! a b less?) (define (loop r a b) (if (less? (car b) (car a)) (begin (set-cdr! r b) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b)) )) ;; (car a) <= (car b) (begin (set-cdr! r a) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) )) ) (cond ((null? a) b) ((null? b) a) ((less? (car b) (car a)) (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b))) b) (else ; (car a) <= (car b) (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) a)))
$ A SETL program to do the sieve of $ Erastothenes (probably badly, but its my first $ SETL program) program sieve; read(mx); primes := {}; (for x in [3..mx] | odd x) primes with:= x; end; (for x in [3..ceil(mx / 2)] | odd x) primes := sieve1(x, primes); end; print(primes); proc sieve1(rd n, rd pset); (for x in pset | n < x and x mod n = 0) pset less:= x; end; return pset; end proc sieve1; end program sieve;
#!/bin/sh # Simple shell script to count files of size # greater than 1k if [ -z "$1" ] then pat="*" else pat="$1" fi cnt=0 for fname in $pat do if [ -r $fname -a ! -d $fname ] then size=`cat $fname | wc -c` if [ $size -gt 1024 ] then echo $fname ' ' $size cnt=`expr $cnt 1` fi fi done echo "${pat}: Files bigger than 1K: $cnt" exit
Preamble '' A simple telephone system model - CACI Products Company '' files: TELPHN1.SRC Normally mode is integer Processes include GENERATOR Every INCOMING.CALL has a CALL.ID Define NUMBER.BUSY and LOST.CALLS as integer variables End ''Preamble Main Activate a GENERATOR now Start simulation Print 1 line with LOST.CALLS thus 15 phone calls were made and ** were lost due to busy lines End ''Main Process GENERATOR For I = 1 to 15 do Activate a INCOMING.CALL now Let CALL.ID(INCOMING.CALL) = I Wait uniform.f (2.0, 6.0, 1) minutes Loop End ''GENERATOR Process INCOMING.CALL If NUMBER.BUSY < 2 Add 1 to NUMBER.BUSY Wait uniform.f(6.0, 10.0, 2) minutes Subtract 1 from NUMBER.BUSY Else Add 1 to LOST.CALLS Endif End ''INCOMING.CALL
Class Line(a,b,c); real a,b,c; begin boolean procedure parallelto(l); ref(Line) l; if l =/= none then parallelto := abs(a*l.b - b* l.a) < 0.00001; ref(Point) procedure meets(l); ref(Line) l; begin real t; if l =/= none and ~parallelto(l) then begin t := 1/(l.a * b - l.b * a); *** complicated expressions omitted below *** meets :- new Point(..., ...); end; end; ***meets*** real d; d := sqrt(a**2 b**2); if d = 0.0 then error else begin d := 1/d; a := a * d; b := b * d; c := c * d; end; end *** Line***
// an example from the Sina/st 3.1 distribution main comment ' Bring a salute to our globe'; temps hello: HelloWorld; begin hello.show end // main #Category 'Sina-Hello world'; class HelloWorld interface methods show returns nil; inputfilters disp: Dispatch = {inner.*}; end; // interface HelloWorld class HelloWorld implementation methods show begin self.printLine('Hello, world!'); return end; // show end; // implementation HelloWorld
% A simple example of using SISAL arrays, % adapted from various sample exercises in the % SISAL tutorial by John Feo. define main type Matrix = array [ array [ real ] ] % generate a square matrix where element [n,m] % is set to n m function gensquare(siz : integer returns Matrix ) for i in 1,siz cross j in 1,siz returns array of real(i) real(j) end for end function % perform one step of a relaxation, average each % element with its eight nearest neighbors function relax ( a : Matrix returns Matrix ) for row in a at i cross elt in row at j avg := (elt a[i, j-1] a[i, j 1] a[i 1, j-1] a[i 1, j] a[i 1, j 1] a[i-1, j-1] a[i-1, j] a[i-1, j 1]) / 9.0 returns array of avg end for end function % test the generator and relax function function main(returns Matrix) let a1 := gensquare(5) in a1 end let end function
GEN, PEGDEN, SERIAL WORK AREAS QUEUE MODEL, 7/14/77, 1; LIMITS,2,1,50; NETWORK; CREATE, EXPON(.4), , 1; QUEUE(1), 0, 4, BALK(SUB); ACT/1,EXPON(0.25); QUEUE(2), 0, 2, BLOCK; ACT/2,EXPON(0.50); COLCT, INT(1), TIME IN SYSTEM, 20/0/.25 TERM; SUB COLCT,BET,TIME BETWEEN BALKS; TERM; INIT,0,300; FIN;
' Smalltalk class to constraint a 2D point to a fixed grid ' (from Horan & Hopkins, Smalltalk: An Introduction...) Point subclass: #GriddedPoint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Exercise11.5'! !GriddedPoint methodsFor: 'accessing'! x: xInteger "Set the x coordinate gridded to 10 (using rounding, alternatively I could use truncating)." super x: (xInteger roundTo: 10)! y: yInteger "Set the y coordinate gridded to 10 (using rounding, alternatively I could use truncating)." super y: (yInteger roundTo: 10)! ! !GriddedPoint methodsFor: 'private'! setX: xPoint setY: yPoint "Initialize the instance variables rounding to 10." super setX: (xPoint roundTo: 10) setY: (yPoint roundTo: 10)! !
* Find biggest words and numbers in a test string * (from Griswold,Poage,& Polonsky, 1971) BIGP = (*P $ TRY *GT(SIZE(TRY,SIZE(BIG))) $ BIG FAIL STR = 'IN 1964 NFL ATTENDANCE JUMPED TO 4,807884; ' 'AN INCREASE OF 401,810.' P = SPAN('0123456789,') BIG = STR BIGP OUTPUT = 'LONGEST NUMBER IS ' BIG P = SPAN('ABCDEFGHIJKLMNOPQRSTUVWXYZ') BIG = STR BIGP OUTPUT = 'LONGEST WORD IS ' BIG END
/* 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
#include <stdio.h> /* count lines of standard input */ main(int argc, char *argv[]) { char lbuf[256]; int lcnt; for(lcnt = 0; fgets(lbuf,sizeof(lbuf) - 1, stdin); cnt ); printf("%d lines\n", lcnt); exit(0); }
// Adapted from the paper "The C* Parallel // Programming Language" by Andrews and Barszcz, 1992. // Skyline Matrix Problem solution #define N 4 #define BIG 1024 domain Matrix { float a; int i; int j; } A[N][N]; domain RHS { float b; int i; } B[N]; domain Skyline { float s; int i; int j; } SKY[BIG]; domain Vector { float element; int start; } I[N], J[N]; void main() { int k,l,m; float x[N], element; float rowsum, pivot; int NonZeros; readMatrix(); [domain RHS].{ i = (int)(this - &B[0]); } [domain Matrix].{ int offset = (int) (this - &A[0][0]); i = offset / N; j = offset % N; } for(k = 0; k<N; k ) { rowsum = 0; [domain Matrix].{ if (i == k) rowsum = a; } B[k].b = rowsum; } NonZeros = map(); /* put matrix in skyline form? */ for(k=0; k<(N-1); k ) { [domain Skyline].{ if ((i ==k) && (j==k)) Pivot ,= s; if (((i>k) && (j==k)) && (I[i].start <= k)) { s = s / Pivot; I[i].element = s; } if (((i==k) && (j > k)) && (J[j].start <= k)) J[j].element = s; if (((i > k) && (j > k)) && ((I[i].start <= k) && J[j].start <= k)) s = s - (I[i].element * J[j].element); } } for(k = (N-1); k > 0; k--) { [domain Skyline].{ if (((i <= k) && (j ==k)) && (J[k].start <= k)) J[j].element = s; } x[k] ,= B[k].b / J[j].element; [domain Skyline].{ if ((i < k) && (J[k].start < k)) b = b - (J[j].element * x[k]); } } [domain Skyline].{ if (i == 0 && j == 0) Pivot ,= s; } x[0] = B[0].b / Pivot; printf("x\n"); for(k = 0; k<N; k ) printf("%f\n",x[k]); }
// This is just a placehold until I write a // better example. #include <iostream.h> #include <String.h> main(int argc, char *argv[]) { String *s1; s1 = new String("Hello World!"); cout << *s1 << endl << "Length is:" << s1->length() << endl; }
-- Adapted from Cecil Project v2.0 distribution tests method copy_file_using_streams(name1@:string, name2@:string):void { let f1:unix_file := open_file(name1, open_for_reading); let f2:unix_file := open_file(name2, create_for_writing); (name1 || " is " || if(f1.is_unreadable, {"not "}, {""}) || "readable"). print_line; (name2 || " is " || if(f2.is_unreadable, {"not "}, {""}) || "readable"). print_line; while({ f1.before_end }, { f2.next := f1.next; }); close(f1); close(f2); } let var name1 := ask("Name of input file: "); let var name2 := ask("Name of output file: "); print("Copying using streams..."); copy_file_using_streams(name1, name2); print_line(" done.");
<CFSWITCH EXPRESSION="#ThisTag.ExecutionMode#"> <CFCASE VALUE="start"> <CFIF StructIsEmpty(attributes.EMPINFO)> <CFOUTPUT>Error. No employee data was passed.</CFOUTPUT> <CFEXIT METHOD="ExitTag"> <CFELSE> <!--- Add the employee ---> <CFQUERY NAME="AddEmployee" DATASOURCE="cfsnippets"> INSERT INTO Employees (FirstName, LastName, Email, Phone, Department) VALUES <CFOUTPUT> ( #StructFind(attributes.EMPINFO, "firstname")# , #StructFind(attributes.EMPINFO, "lastname")# , #StructFind(attributes.EMPINFO, "email")# , #StructFind(attributes.EMPINFO, "phone")# , #StructFind(attributes.EMPINFO, "department")# ) </CFOUTPUT> </CFQUERY> </CFIF> <CFOUTPUT><HR>Employee Add Complete</CFOUTPUT> </CFCASE> </CFSWITCH>
-- still looking for a good code example
#include <cilk.h>
#include <stdlib.h>
#include <stdio.h>
cilk int fib(int n)
{
if (n < 2)
return (n);
else {
int x, y;
x = spawn fib(n - 1);
y = spawn fib(n - 2);
sync;
return (x y);
}
}
cilk int main(int argc, char *argv[])
{
int n, result;
n=atoi(argv[1]);
result=spawn fib(n);
sync;
printf("Result: %d\n", result);
return 0;
}
// Very simple Fibonnacci example adapted from v2.1 // "Introduction to the CLAIRE Programming Language" begin(fib_module) fib[n:(0..10)] : integer := (if (n < 2) 1 else fib[n - 1] fib[n - 2]) test() -> (for i in (0 .. 10) printf("fib(~S) = ~S\n",i,fib[i]) end(fib_module)
% Driver and function to compute factorials % from the PCLU distribution. start_up = proc () pi: stream := stream$primary_input() po: stream := stream$primary_output() while true do stream$puts(po, "Enter an integer (or RETURN to exit): ") s: string := stream$getl(pi) if string$empty(s) then break end n: int := int$parse(s) except when bad_format: stream$putl(po, "Illegal integer") end stream$putl(po, int$unparse(n) || "! = " || int$unparse(factorial(n))) except when negative: stream$putl(po, "Integer must be positive") when overflow: stream$putl(po, "Overflow") end end end start_up factorial = proc (n: int) returns (int) signals (negative, overflow) if n < 0 then signal negative end if n = 0 then return(1) end return(n*factorial(n-1)) resignal overflow end factorial
Insufficient documentation for producing a reasonable example.
IDENTIFICATION DIVISION PROGRAM-ID. SUM-OF-PRICES. AUTHOR. TERENCE-PRATT. SOURCE. PROGRAMMING-LANGUAGES-2ND-EDITION-1984 ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT INP-DATA ASSIGN TO INPUT. SELECT RESULT-FILE ASSIGN TO OUTPUT. DATA DIVISION. FILE SECTION. FD INP-DATA LABEL RECORD IS OMITTED. 01 ITEM-PRICE 02 ITEM PICTURE X(30). 02 PRICE PICTURE 9999V99. 02 FILLER PICTURE X(44). FD RESULT-FILE LABEL RECORD IS OMITTED. 01 RESULT-LINE PICTURE X(132). WORKING-STORAGE SECTION. 77 TOT PICTURE 999999V99, VALUE 0, USAGE IS COMPUTATIONAL. 77 COUNT PCITURE 9999, VALUE 0, USAGE IS COMPUTATIONAL. 01 SUM-LINE. 02 FILLER VALUE ' SUM ='PICTURE X(12). 02 SUM-OUT PICTURE $$,$$$,$$9.99. 02 FILLER VALUE ' NO. OF ITEMS ='PICTURE X(21). 02 COUNT-OUT PICTURE ZZZ9.99. 01 ITEM-LINE. 02 ITEM-OUT PICTURE X(30). 02 PRICE-OUT PICTURE ZZZ9.99. PROCEDURE DIVISION. START. OPEN INPUT INP-DATA AND OUTPUT RESULT-FILE. READ-DATA. READ INP-DATA AT END GO TO PRINT-LINE. ADD PRICE TO TOT. ADD 1 TO COUNT. MOVE PRICE TO PRICE-OUT. MOVE ITEM TO ITEM-OUT. WRITE RESULT-LINE FROM ITEM-LINE. GO TO READ-DATA. PRINT-LINE. MOVE TOT TO SUM-OUT. MOVE COUNT TO COUNT-OUT. WRITE RESULT-LINE FROM SUM-LINE. CLOSE INP-DATA AND RESULT-FILE. STOP RUN.
;; An example of array search from the common ;; lisp standard (defun finder (obj vec start end) (let ((range (- end start))) (if (zerop range) (if (eql obj (aref vec start)) obj nil) (let ((mid ( start (round (/ range 2))))) (let ((obj2 (aref vec mid))) (if (< obj obj2) (finder obj vec start (- mid 1)) (if (> obj obj2) (finder obj vec ( mid 1) end) obj)))))))
// Solution to Hamming's problem in Clean, // generate an infinite sorted stream of numbers // of the form (2^n)*(3^m)*(5*p). From the examples // distributed with Concurrent Clean v1.2. Ham::[Int] Ham = y where y = [1:merge (merge (map ((*) 2) y) (map ((*) 3) y)) (map ((*) 5) y)] merge [] [] = [] merge f [] = f merge [] f = f merge f=:[a:b] g=:[c:d] | a<c = [a:merge b g] | a==c = merge f d | otherwise = [c: merge f d] Start::[Int] Start = take NrElements Ham NrElements :== 300 // Size of finite sample to take.
{ A small example monitor and process from Hansen's 1993 } { paper given at HOPL-II. } type linebuffer = monitor var contents : line; full : Boolean; sender, receiver : queue; procedure entry receive(var text : line); begin if not full then delay(receiver); text := contents; full := false; continue(sender); end; procedure entry send(text : line); begin if full then delay(sender); contents := text; full := true; continue(receiver); end; begin full := false; end; { linebuffer } type printerprocess = process(buffer: linebuffer) var param : ioparam; text : line; begin param.operation := output; cycle buffer.receive(text); repeat io(text,param,printdevice) until param.status = complete; end end;
WITHOBJECT "CorelPhotoPaint.Automation.7" .SetDocumentInfo 96, 96 .MaskSelectAll .EditCopy .ImagePapersize 192, 96, 0, 0, 5, 255, 255, 255, 0 .MaskInvert .EditPasteIntoSelection .MaskChannelAdd "Alpha 1" .MaskBorder 4, 1 .ImageBCI -20, 0, 0 .EndColorEffect .MaskChannelToMask 0, 0 offset% = 50 BEGIN DIALOG Dialog4 182, 79, "Corel SCRIPT Dialog" SPINCONTROL 91, 12, 76, 18, offset% TEXT 28, 17, 55, 11, "Offset amount:" OKBUTTON 56, 50, 69, 21 END DIALOG X = Dialog(Dialog4) .EffectOffset 0, offset%, TRUE, 0 .MaskRemove END WITHOBJECT
#!/bin/csh # A simple csh script to find a command on # the directories listed in the environment # variable PATH, and print out information # about it. set cmd=$1 if ("$cmd" == "") then echo "Usage: findcmd commandname" exit 1 endif set cnt=0 foreach dir ($path) set check="$dir/$cmd" if (-x "$check" && ! (-d "$check")) then file $check ls -ldg $check set cnt=$cnt 1 endif end if ($cnt == 0) then echo "Sorry, command $cmd not found." exit 1 else exit 0 endif
PHIL = *[ ...During n'th lifetime THINK; room!enter( ); fork(i)!pickup( ); fork((i 1) mod 5)!pickup; EAT; fork(i)!putdown( ); fork((i 1) mod 5)!putdown( ); room!exit( ); ] FORK = *[ phil(i)?pickup( ) -> phil(i)?putdown( ); [] phil((i - 1) mod 5)?pickup( ) -> phil((i - 1) mod 5)?putdown( ); ROOM = occupancy:integer; occupancy = 0; *[(i:0..4)phil(i)?enter( ) -> occupancy := occupancy 1; [] (i:0..4)phil(i)?exit( ) -> occupancy := occupancy - 1; MAIN = [room::ROOM || fork(i:0..4)::FORK || phil(i:0..4)::PHIL].
* A subroutine to draw 1-d chaos, from a * sample program by Bruce Sherwood. unit chaos f: pop, rate $$ population and growth rate i: n, TRIES=40, base=8 i: usecolor f: h, s, v calc usecolor := (zncolors >= 8 base) palette zred,100,0,0,zwhite if usecolor loop n := 0,7 $$ make hues from blue to red getrgb 240[1-(n 1)/8],100,100; h, s, v palette base n,h,s,v endloop endif color zwhite do graph color zred loop rate := 2.7, 3.99, .01 calc pop := .1 $$ starting population loop n := 1, TRIES * New population is rate times current population * times a resource-limiting factor (1-pop): calc pop := rate*pop*(1-pop) if usecolor color base int(8(n-1)/TRIES) elseif TRIES-n > 8 reloop endif gfill rate,pop;rate .01,pop .005 endloop endloop
The syntax of Curry is complex, compact, and similar to that of Haskell. Each statement of a Curry program is an equation or predicate. Executing a Curry program consists of simplifying equations and expressions until a particular specified goal is reached or a particular solution is obtained. Primitive data types supported by Curry include booleans, integers, reals, chars, and strings. Aggregate and specialized data types include tuples, lists, functions, and constraints. Oddly enough, Curry uses the same comment syntax as Ada. The module construct serves to encapsulate libraries of functions, data types, and expressions. The module seems to be the only program structuring facility in Curry.
Like many functional languages, Curry supports a declarative I/O model. This kind of model basically represents input and output operations as expressions involving 'the World'.
Some of the advanced features of Curry are listed below.
As an academic project, implementations of Curry are available free. Documentation is available on the web, but almost exclusively in DVI format.
Several implementations of Curry exist. The most viable one seems to be PACS, the Portland Aachen Curry System. It is a compiler that translates Curry programs into various intermediate forms: Prolog or Java. Free downloads of PACS for UNIX systems are available from RWTH Aachen. Other Curry implementations are interpreters written in Prolog.
There has been a trend in the 1990s to try to integrate ideas from some of the most powerful computer programming research paradigms. Curry, like LEDA and NIAL, is an example of this trend.
-- quicksort using higher-order functions: -- filter elements in a list (predefined as `filter'): filter_ :: (a -> Bool) -> [a] -> [a]; filter_ _ [] = [] filter_ p (x:xs) = if p x then x : filter_ p xs else filter_ p xs qsort :: [Int] -> [Int] qsort [] = [] qsort (x:l) = qsort (filter (< x) l) x : qsort (filter (>= x) l)
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.