Back to dada's perl lab
|
|
Pliant |
Back to the Win32 Shootout Back to dada's perl lab |
| All Source For pliant |
|---|
| Ackermann's Function |
module "/pliant/language/context.pli"
function ack m n -> r
arg Int m n r
if m=0
return (n + 1)
eif n=0
return (ack m-1 1)
else
return (ack m-1 (ack m n-1))
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
console "Ack(3," n "): " (ack 3 n) eol
else
console "usage: ack.pli <number>" eol
|
| Array Access |
# $Id: ary3.pliant,v 1.0 2002/02/08 12:30:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Int i
gvar Int k
gvar Int last
gvar Array:Int X
gvar Array:Int Y
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
last := n - 1
X:size = n
Y:size = n
for i 0 last
X += i + 1
Y += 0
for k 0 999
for i last 0 step -1
Y:i += X:i
console Y:0 " " Y:last eol
else
console "usage: ary3.pliant <number>" eol
|
| Count Lines/Words/Chars |
# $Id: wc.pliant,v 1.0 2002/02/11 17:03:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/os.pli"
gvar Str line := ""
gvar Address Buf
gvar Int ReadSize := 4096
gvar Int i
gvar Int nl := 0
gvar Int nw := 0
gvar Int nc := 0
gvar Char ch
gvar Int j
gvar CBool state := false
gvar CBool ok
gvar Int ReadCount
gvar Int s := os_GetStdHandle -10
Buf := memory_allocate ReadSize+1 null
ok := os_ReadFile s Buf ReadSize ReadCount null
while ok and ReadCount > 0
line set Buf ReadCount false
nc := nc + (line len)
i := 0
while i<line:len
ch := line:i
if ch="[lf]"
nl += 1
if ch=" " or ch="[tab]" or ch="[lf]"
state := false
eif state = false
nw += 1
state := true
i += 1
ok := os_ReadFile s Buf ReadSize ReadCount null
console nl " " nw " " nc eol
|
| Fibonacci Numbers |
module "/pliant/language/context.pli"
function fibo n -> r
arg Int n r
if n < 2
return 1
else
return (fibo n-2) + (fibo n-1)
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
console (fibo n) eol
else
console "usage: fibo.pli <number>" eol
|
| Hash (Associative Array) Access |
# $Id: hash.pliant,v 1.0 2002/02/06 16:48:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar (Dictionary Str Int) X
gvar Int c
gvar Int i
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
c := 0
for (i) 1 n
X insert (string i "radix 16") i
for (i) n 1 step -1
if (X exists (string i))
c := c + 1
console c eol
else
console "usage: nestedloop.pli <number>" eol
|
| Hashes, Part II |
# $Id: hash.pliant,v 1.0 2002/02/07 14:45:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar (Index Str Int) hash1
gvar (Dictionary Str Int) hash2
gvar Str k
gvar Int i
gvar Pointer:Int v
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
for (i) 0 9999
hash1 insert "foo_"+(string i) i
for (i) 1 n
v :> hash1 first
k := hash1 key v
if addressof:(hash2 first k)<>null
hash2:k += hash1:k
else
hash2 insert k hash1:k
while addressof:v<>null
if addressof:(hash2 first k)<>null
hash2:k += hash1:k
else
hash2 insert k hash1:k
v :> hash1 next v
if addressof:v<>null
k := hash1 key v
console hash1:"foo_1" " " hash1:"foo_9999" " " hash2:"foo_1" " " hash2:"foo_9999" eol
else
console "usage: hash2.pliant <number>" eol
|
| Heapsort |
# $Id: heapsort.pliant,v 1.0 2002/02/07 15:44:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Int IM := 139968
gvar Int IA := 3877
gvar Int IC := 29573
gvar Int LAST := 42
function gen_random n -> r
arg Float n ; arg Float r
LAST := (LAST * IA + IC) % IM
r := (n * LAST) / IM
return r
function heapsort n ra
arg Int n ; arg_rw Array:Float ra
var Float rra
var Int i
var Int j
var Int l := (n\2) + 1
var Int ir := n
part heapsort_loop
if l>1
l := l - 1
rra := ra:l
else
rra := ra:ir
ra:ir := ra:1
ir := ir - 1
if ir=1
ra:1 := rra
leave heapsort_loop
i := l
j := l*2
while j<=ir
if j<ir and ra:j < ra:(j+1)
j := j + 1
if rra < ra:j
ra:i := ra:j
i := j
j := j + i
else
j := ir + 1
ra:i := rra
restart heapsort_loop
gvar Float result
gvar Int i
gvar Array:Float ary
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
for (i) 1 n
ary += gen_random(1.0)
heapsort n-1 ary
console (string ary:(ary:size-1) "fixed 9") eol
else
console "usage: heapsort.pliant <number>" eol
|
| Hello World |
# $Id: hello.pliant,v 1.0 2002/02/11 16:58:00 dada Exp $ # http://dada.perl.it/shootout/ console "hello world[lf]" |
| List Operations |
# $Id: lists.pliant,v 1.0 2002/02/08 10:09:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Int SIZE := 10000
function reverse l -> r
arg List:Int l
arg List:Int r
var Pointer:Int v
v :> l last
for (var Int i) l:size-1 0 step -1
r += v
v :> l previous v
return r
function test_lists -> r
arg Int r
var List:Int Li1
var List:Int Li2
var List:Int Li3
var Pointer:Int v
var Int len1
var Int len2
var Bool lists_equal := true
var Pointer:Int v1
var Pointer:Int v2
# create a list of integers (Li1) from 1 to SIZE
for (var Int i) 1 SIZE
Li1 += i
# copy the list to Li2 (not by individual items)
Li2 := Li1
# remove each individual item from left side of Li2 and
# append to right side of Li3 (preserving order)
while Li2:size > 0
v :> Li2 first
Li3 += v
Li2 -= v
# Li2 must now be empty
# remove each individual item from right side of Li3 and
# append to right side of Li2 (reversing list)
while Li3:size > 0
v :> Li3 last
Li2 += v
Li3 -= v
# Li3 must now be empty
# reverse Li1 in place
Li1 := reverse Li1
# check that first item is now SIZE
v :> Li1 first
if v <> SIZE
return 0
# compare Li1 and Li2 for equality
len1 := Li1:size
len2 := Li2:size
lists_equal := (len1=len2)
v1 :> Li1 first
v2 :> Li2 first
for (var Int i) 0 len1-1
if v1 <> v2
lists_equal := false
i := len1-1
v1 :> Li1 next v1
v2 :> Li2 next v2
if lists_equal = false
return 0
return len1
gvar Int r
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
while n > 0
r := test_lists
n := n - 1
console r eol
else
console "usage: lists.pliant <number>" eol
|
| Matrix Multiplication |
# $Id: matrix.pliant,v 1.0 2002/02/07 18:27:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Int size := 30
function mkmatrix rows cols -> mx
arg Int rows ; arg Int cols
arg_w Array:(Array:Int) mx
var Array:Int row
var Int count := 1
for (var Int r) 0 rows-1
row:size := 0
for (var Int c) 0 cols-1
row += count
count := count + 1
mx += row
return mx
function mmult rows cols m1 m2 m3
arg Int rows ; arg Int cols
arg Array:(Array:Int) m1
arg Array:(Array:Int) m2
arg_w Array:(Array:Int) m3
var Array:Int row
var Int val
for (var Int i) 0 rows-1
row:size := 0
for (var Int j) 0 cols-1
val := 0
for (var Int k) 0 cols-1
val := val + m1:i:k * m2:k:j
row += val
m3 += row
gvar Array:(Array:Int) m1
gvar Array:(Array:Int) m2
gvar Array:(Array:Int) mm
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
m1 := mkmatrix size size
m2 := mkmatrix size size
while n>0
mmult size size m1 m2 mm
n := n - 1
console mm:0:0 " " mm:2:3 " " mm:3:2 " " mm:4:4 eol
else
console "usage: matrix.pliant <number>" eol
|
| Method Calls |
# $Id: methcall.pliant,v 1.0 2002/02/07 16:39:00 dada Exp $
# http://dada.perl.it/shootout/
# (based on methcall.pliant by pixel@mandrakesoft)
module "/pliant/language/context.pli"
module "/pliant/language/compiler.pli"
meta inherit e
if e:size<>1
return
var Pointer:Type interface :> (e:0 constant Type) map Type
if addressof:interface=null
return
var Pointer:Arrow c :> e:module first "pliant type"
if c=null or entry_type:c<>Type
return
var Pointer:Type implementation :> c map Type
if interface:nb_fields<>0 and implementation:nb_fields<>0
return
for (var Int i) 0 interface:nb_fields-1
var Pointer:TypeField f :> interface field i
implementation define_field f:type f:name f:initial_value
interface maybe implementation
e set_void_result
type Toggle
field Bool state
function init t start_state
arg_w Toggle t ; arg Bool start_state
t:state := start_state
method t value -> r
arg Toggle t ; arg Bool r
return t:state
method t activate -> r
arg_rw Toggle t ; arg Toggle r
t:state := not t:state
return t
type NthToggle
inherit Toggle
field Int count_max
field Int counter
function init t start_state max_counter
arg_w NthToggle t ; arg Bool start_state ; arg Int max_counter
init t start_state
t:count_max := max_counter
t:counter := 0
method t activate -> r
arg_rw NthToggle t ; arg NthToggle r
t:counter += 1
if t:counter >= t:count_max
t:state := not t:state;
t:counter := 0;
return t
function doit n
arg Int n
var Toggle toggle
var Bool val := true
for (var Int i) 1 n
val := toggle:activate:value
console val eol
val := true
var NthToggle ntoggle
init ntoggle val 3
for (var Int i) 1 n
val := ntoggle:activate:value
console val eol
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
doit n
else
console "usage: methcall.pliant <number>" eol
|
| Nested Loops |
module "/pliant/language/context.pli"
function doit n
arg Int n
var Int x := 0
for (var Int a) 0 n-1
for (var Int b) 0 n-1
for (var Int c) 0 n-1
for (var Int d) 0 n-1
for (var Int e) 0 n-1
for (var Int f) 0 n-1
x += 1
console x eol
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
doit n
else
console "usage: nestedloop.pli <number>" eol
|
| Object Instantiation |
# $Id: objinst.pliant,v 1.0 2002/02/07 18:22:00 dada Exp $
# http://dada.perl.it/shootout/
# (based on methcall.pliant by pixel@mandrakesoft)
module "/pliant/language/context.pli"
module "/pliant/language/compiler.pli"
meta inherit e
if e:size<>1
return
var Pointer:Type interface :> (e:0 constant Type) map Type
if addressof:interface=null
return
var Pointer:Arrow c :> e:module first "pliant type"
if c=null or entry_type:c<>Type
return
var Pointer:Type implementation :> c map Type
if interface:nb_fields<>0 and implementation:nb_fields<>0
return
for (var Int i) 0 interface:nb_fields-1
var Pointer:TypeField f :> interface field i
implementation define_field f:type f:name f:initial_value
interface maybe implementation
e set_void_result
type Toggle
field Bool state
function init t start_state
arg_w Toggle t ; arg Bool start_state
t:state := start_state
method t value -> r
arg Toggle t ; arg Bool r
return t:state
method t activate -> r
arg_rw Toggle t ; arg Toggle r
t:state := not t:state
return t
type NthToggle
inherit Toggle
field Int count_max
field Int counter
function init t start_state max_counter
arg_w NthToggle t ; arg Bool start_state ; arg Int max_counter
init t start_state
t:count_max := max_counter
t:counter := 0
method t activate -> r
arg_rw NthToggle t ; arg NthToggle r
t:counter += 1
if t:counter >= t:count_max
t:state := not t:state;
t:counter := 0;
return t
function main n
arg Int n
var Toggle toggle
var Bool val := true
var NthToggle ntoggle
init toggle true
for (var Int i) 1 5
console toggle:activate:value eol
for (var Int i) 1 n
init toggle true
console eol
init ntoggle true 3
for (var Int i) 1 8
console ntoggle:activate:value eol
for (var Int i) 1 n
init ntoggle true 3
void
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
main n
else
console "usage: objinst.pliant <number>" eol
|
| Producer/Consumer Threads |
# $Id: prodcons.pliant,v 1.0 2002/02/25 11:58:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Sem s
gvar Int count := 0
gvar Int data := 0
gvar Int produced := 0
gvar Int consumed := 0
gvar Int done := 0
function consumer n
arg Int n
var Int i
part forever
part consumer_wait
if(count = 0)
restart consumer_wait
leave consumer_wait
i := data
count := 0
# console "consuming " i eol
consumed := consumed + 1
if (i = n)
leave forever
restart forever
function producer n
arg Int n
for (var Int i) 1 n
part producer_wait
if(count = 1)
restart producer_wait
leave producer_wait
data := i
count := 1
# console "producing " i eol
produced := produced + 1
done := 1
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
thread
# console "starting producer thread..." eol
share produced
share data
share count
share s
share done
producer n
thread
# console "starting consumer thread..." eol
share consumed
share data
share count
share s
consumer n
part wait_done
if (done = 1)
leave wait_done
restart wait_done
console produced " " consumed eol
s release
else
console "usage: prodcons.pliant <number>" eol
|
| Random Number Generator |
# $Id: random.pliant,v 1.0 2002/02/07 15:19:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Int IM := 139968
gvar Int IA := 3877
gvar Int IC := 29573
gvar Int LAST := 42
function gen_random n -> r
arg Int n ; arg Float r
LAST := (LAST * IA + IC) % IM
r := (n * LAST) / IM
return r
gvar Float result
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
while n > 0
result := gen_random(100)
n := n - 1
console (string result "fixed 9") eol
else
console "usage: random.pli <number>" eol
|
| Reverse a File |
# $Id: reversefile.pliant,v 1.0 2002/02/08 14:57:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/stream.pli"
module "/pliant/language/stream/pipe.pli"
module "/pliant/language/unsafe.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/asciifile.pli"
(gvar AsciiFile f) load "handle:0"
gvar Int l
for l f:size-1 0 step -1
console f:l eol
|
| Sieve of Erathostenes |
# $Id: sieve.pliant,v 1.0 2002/02/06 15:17:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Array:Int flags
gvar Int count
gvar Int i
gvar Int k
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
flags:size := 8192
while n > 0
count := 0
for (i) 0 (flags:size)
flags:i := 1
for (i) 2 8192
if flags:i = 1
for k i+i 8192 step i
flags:k := 0
count := count + 1
n := n - 1
console "Count: " count eol
else
console "usage: nestedloop.pli <number>" eol
|
| Statistical Moments |
# $Id: moments.pliant,v 1.0 2002/02/08 12:43:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/pipe.pli"
function heapsort n ra
arg Int n ; arg_rw Array:Int ra
var Int rra
var Int i
var Int j
var Int l := (n\2) + 1
var Int ir := n
part heapsort_loop
if l>1
l := l - 1
rra := ra:l
else
rra := ra:ir
ra:ir := ra:1
ir := ir - 1
if ir=1
ra:1 := rra
leave heapsort_loop
i := l
j := l*2
while j<=ir
if j<ir and ra:j < ra:(j+1)
j := j + 1
if rra < ra:j
ra:i := ra:j
i := j
j := j + i
else
j := ir + 1
ra:i := rra
restart heapsort_loop
gvar Str line := ""
(gvar Stream STDIN) open "handle:0" in
gvar Array:Int nums
gvar uInt sum := 0
gvar Int i
gvar Int n
gvar Int mid
gvar Float mean
gvar Float deviation
gvar Float average_deviation := 0
gvar Float standard_deviation := 0
gvar Float variance := 0
gvar Float devpow3
gvar Float skew := 0
gvar Float kurtosis := 0
gvar Float median
while (STDIN atend) = false
line := STDIN readline
i := 0
if(line parse i any)
nums += i
for i 0 nums:size-1
sum += nums:i
n := nums:size
mean := sum/n
for i 0 nums:size-1
deviation := nums:i - mean
average_deviation := average_deviation + (abs deviation)
variance := variance + ((abs deviation) ^ 2.0)
devpow3 := (abs deviation) ^ 3.0
if deviation < 0
devpow3 := -devpow3
skew := skew + devpow3
kurtosis := kurtosis + ((abs deviation) ^ 4.0)
average_deviation := average_deviation / n
variance := variance / (n-1)
standard_deviation := variance^0.5
if variance <> 0
skew := skew / (n * variance * standard_deviation)
kurtosis := kurtosis / (n * variance * variance) - 3.0
heapsort n nums
mid := n\2
median := shunt (n%2>0) nums:mid (nums:mid+nums:mid-1)/2
console "n: " n eol
console "median: " (string median "fixed 6") eol
console "mean: " (string mean "fixed 6") eol
console "average_deviation: " (string average_deviation "fixed 6") eol
console "standard_deviation: " (string standard_deviation "fixed 6") eol
console "variance: " (string variance "fixed 6") eol
console "skew: " (string skew "fixed 6") eol
console "kurtosis: " (string kurtosis "fixed 6") eol
|
| String Concatenation |
# $Id: strcat.pliant,v 1.0 2002/02/01 10:58:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
gvar Str string
gvar Int i
gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
for (i) 1 n
string := string + "hello[lf]"
console string:len eol
else
console "usage: strcat.pli <number>" eol
|
| Sum a Column of Integers |
# $Id: sumcol.pliant,v 1.0 2002/02/08 12:07:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/pipe.pli"
gvar Str line := ""
(gvar Stream STDIN) open "handle:0" in
gvar uInt sum := 0
gvar Int i
while (STDIN atend) = false
line := STDIN readline
i := 0
if(line parse i any)
sum := sum + i
console sum eol
|
| Word Frequency Count |
# $Id: wordfreq.pliant,v 1.1 2002/03/18 14:07:00 dada Exp $
# http://dada.perl.it/shootout/
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/pipe.pli"
function heapsort n ra
arg Int n ; arg_rw Array:Str ra
var Str rra
var Int i
var Int j
var Int l := (n\2) + 1
var Int ir := n
part heapsort_loop
if l>1
l := l - 1
rra := ra:l
else
rra := ra:ir
ra:ir := ra:1
ir := ir - 1
if ir=1
ra:1 := rra
leave heapsort_loop
i := l
j := l*2
while j<=ir
if j<ir and ra:j > ra:(j+1)
j := j + 1
if rra > ra:j
ra:i := ra:j
i := j
j := j + i
else
j := ir + 1
ra:i := rra
restart heapsort_loop
gvar Stream stdin
gvar Str line := ""
gvar Str l
gvar Str word
gvar Address Buf
gvar Int ReadCount
gvar CBool ok
gvar Int ReadSize := 4096
gvar Int eolpos
gvar Int i
gvar Int nl := 0
gvar Int nw := 0
gvar Int nc := 0
gvar Char ch
gvar Int j
gvar Array:Str lines
gvar (Dictionary Str Int) count
gvar Pointer:Int v
gvar Str k
stdin open "handle:0" in
while not stdin:atend
line := stdin readline
i := 0
while i<line:len
ch := line:i
if ch>="a" and ch<="z" or ch>="A" and ch<="Z"
j := i+1
part find_word
if j<line:len
ch := line:j
if ch>="a" and ch<="z" or ch>="A" and ch<="Z"
j += 1
restart find_word
word := lower (line i j-i)
if (count exists word)
count:word += 1
else
count insert word 1
i += j-i
else
i += 1
lines += ""
v :> count first
k := count key v
while addressof:v<>null
if addressof:(count first k)<>null
l := (string count:k)
l := (repeat 7-l:len " ")+l
line := l+"[tab]"+k+"[lf]"
lines += line
# console k "=" count:k eol
v :> count next v
if addressof:v<>null
k := count key v
heapsort lines:size-1 lines
for i 0 lines:size-1
console lines:i
|