pure-lang-svn Mailing List for Pure (Page 8)
Status: Beta
Brought to you by:
agraef
You can subscribe to this list here.
2008 |
Jan
|
Feb
|
Mar
|
Apr
(5) |
May
(141) |
Jun
(184) |
Jul
(97) |
Aug
(232) |
Sep
(196) |
Oct
|
Nov
|
Dec
|
---|
From: <ag...@us...> - 2008-09-04 01:18:03
|
Revision: 695 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=695&view=rev Author: agraef Date: 2008-09-04 01:18:14 +0000 (Thu, 04 Sep 2008) Log Message: ----------- Update documentation. Modified Paths: -------------- pure/trunk/pure.1.in Modified: pure/trunk/pure.1.in =================================================================== --- pure/trunk/pure.1.in 2008-09-04 00:45:30 UTC (rev 694) +++ pure/trunk/pure.1.in 2008-09-04 01:18:14 UTC (rev 695) @@ -411,7 +411,7 @@ lambdas, conditional expressions and ``catmaps'' (a list operation which combines list concatenation and mapping a function over a list, defined in the prelude), but they are often much easier to write. Some examples of list -comprehensions can be found below at the end of this section. +comprehensions can be found in the EXAMPLES section below. .TP .B Function applications: \fRfoo\ x\ y\ z As in other modern FPLs, these are written simply as juxtaposition (i.e., in @@ -520,9 +520,11 @@ .PP The & operator does .IR "lazy evaluation" . -More precisely, it turns its operand into a kind of parameterless anonymous -closure, deferring its evaluation. These kinds of objects are commonly known -as +This is the only postfix operator defined in the standard prelude, written as +`x&', where x is an arbitrary Pure expression. The & operator binds stronger +than any other operation except function application. It turns its operand +into a kind of parameterless anonymous closure, deferring its +evaluation. These kinds of objects are also commonly known as .I thunks or .IR futures . @@ -535,22 +537,9 @@ structures in Pure, in particular: lazy lists a.k.a. .IR streams . A stream is simply a list with a thunked tail, which allows it to be -infinite. E.g.: -.sp -.nf -> ints n = n : ints (n+1) &; let nats = ints 1; -> nats; -1:<<thunk 0xb6033528>> -> take 10 nats; -[1,2,3,4,5,6,7,8,9,10] -> nats; -1:2:3:4:5:6:7:8:9:10:11:<<thunk 0xb5fb1a08>> -> nats!9999; -10000 -.fi -.sp -Note that the prelude defines & as a postfix operator which binds stronger -than any other operation except function application. +infinite. The Pure prelude defines many functions for creating and +manipulating these kinds of objects; further details and examples can be found +in the EXAMPLES section below. .PP .B Toplevel. At the toplevel, a Pure program basically consists of rewriting rules (which @@ -699,8 +688,7 @@ symbols needed in an evaluation .I before entering the expression to be evaluated. -.PP -.B Examples. +.SH EXAMPLES Here are a few examples of simple Pure programs (see the following section for a closer discussion of the rule syntax). .PP @@ -756,7 +744,8 @@ 6.28318530717958 .fi .PP -A little list comprehension example (Erathosthenes' classical prime sieve): +.B List comprehensions. +Erathosthenes' classical prime sieve: .sp .nf primes n = sieve (2..n) \fBwith\fP @@ -796,6 +785,136 @@ = i1==i2 || j1==j2 || i1+j1==i2+j2 || i1-j1==i2-j2; \fBend\fP; .fi +.PP +.B Lazy evaluation and streams. +As already mentioned, lists can also be evaluated in a ``lazy'' fashion, by +just turning the tail of a list into a +.IR future . +This special kind of list is also called a +.IR stream . +Streams enable you to work with infinite lists (or finite lists which are so +huge that we would never want to keep them in memory). E.g., here's one way to +create the infinite list of all positive integers: +.sp +.nf +> ones = 1:ones&; +> integers = 1 : zipwith (+) ones integers&; +> \fBlet\fP ints = integers; ints; +1:<<thunk 0xb5fdd5b8>> +.fi +.PP +(Note that we use machine integers in this example, so in fact the list will +wrap around to the smallest negative integer at some point.) +.PP +Of course, care must be taken not to invoke ``eager'' operations such as `#' +(which computes the size of a list) on infinite streams, since this never +terminates. However, many list operations work with infinite streams just +fine, and return the appropriate stream results. E.g., the `take' function +(which retrieves a given number of elements from the front of a list) works +with streams just as well as with ``eager'' lists: +.sp +.nf +> take 10 ints; +1:<<thunk 0xb5fdd5e8>> +.fi +.PP +Hmm, not much progress there, but that's just how streams work (or rather +don't, they're lazy bums indeed!). But the stream computed with `take' is in +fact finite and we can readily convert it to an ordinary list, forcing its +evaluation: +.sp +.nf +> (list) (take 10 ints); +[1,2,3,4,5,6,7,8,9,10] +.fi +.PP +(Note that we typed `(list)' instead of just `list' here, so that the +interpreter does not mistake this for the interactive +.B list +command. This is only necessary at the interactive command prompt, see +INTERACTIVE USAGE.) +.PP +For interactive usage it's often convenient to define an eager variation of +`take' which combines `take' and `list'. Let's do this now, so that we can use +this operation in the following examples. +.sp +.nf +> takel n xs = list (take n xs); +> takel 10 ints; +[1,2,3,4,5,6,7,8,9,10] +.fi +.PP +Let's take another look at the `ints' stream now: +.sp +.nf +> ints; +1:2:3:4:5:6:7:8:9:10:<<thunk 0xb5fddcd8>> +.fi +.PP +As you can see, the invokation of `list' on the result of `take' forced the +corresponding prefix of the `ints' stream to be computed. The result of this +is memoized, so that this portion of the stream is now readily available in +case we need to have another look at it again later. By these means, possibly +costly reevaluations are avoided, trading memory for execution speed. +.PP +A number of convenience operations are available for generating stream values. +The prelude defines infinite arithmetic sequences, using +.B inf +or +.B -inf +to denote an upper (or lower) infinite bound for the sequence, e.g.: +.sp +.nf +> let u = 1..inf; let v = -1.0,-1.2..-inf; +> takel 10 u; takel 10 v; +[1,2,3,4,5,6,7,8,9,10] +[-1.0,-1.2,-1.4,-1.6,-1.8,-2.0,-2.2,-2.4,-2.6,-2.8] +.fi +.PP +Other useful stream generator functions are `iterate', `repeat' and `cycle', +which have been adopted from Haskell. Moreover, list comprehensions can draw +values from streams and return the appropriate stream result: +.sp +.nf +> \fBlet\fP pairs = [i,j; i=1..inf; j=1..i]; pairs; +(1,1):<<thunk 0xb5f28818>> +> takel 10 pairs; +[(1,1),(2,1),(2,2),(3,1),(3,2),(3,3),(4,1),(4,2),(4,3),(4,4)] +.fi +.PP +Finally, let's rewrite our prime sieve so that it generates the infinite +stream of +.I all +prime numbers: +.sp +.nf +all_primes = sieve (2..inf) \fBwith\fP + sieve [] = []; + sieve (p:qs) = p : sieve [q; q = qs; q mod p] &; +\fBend\fP; +.fi +.sp +Example: +.sp +.nf +> \fBlet\fP P = all_primes; +> takel 20 P; +[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71] +> P!299; +1987 +.fi +.PP +You can also just print the entire stream. This will run forever, so hit +Ctrl-C when you get bored. +.sp +.nf +> \fBusing\fP system; +> do (printf "%d\en") all_primes; +2 +3 +5 + ... +.fi .SH RULE SYNTAX Basically, the same rule syntax is used in all kinds of global and local definitions. However, some constructs (specifically, \fBwhen\fP, \fBlet\fP, @@ -1689,8 +1808,9 @@ See the DEFINITION LEVELS section below for details. .PP Note that these special commands are only recognized at the beginning of the -interactive command line. (Thus you can escape a symbol looking like a command -by prefixing it with a space.) +interactive command line. (Thus you can escape an identifier at the beginning +of the command line, which looks like a command, by prefixing it with a space +or by wrapping it up in parentheses.) .PP Some commands which are especially important for effective operation of the interpreter are discussed in more detail in the following sections. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-04 00:45:21
|
Revision: 694 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=694&view=rev Author: agraef Date: 2008-09-04 00:45:30 +0000 (Thu, 04 Sep 2008) Log Message: ----------- Add stream example. Modified Paths: -------------- pure/trunk/examples/hello.pure Modified: pure/trunk/examples/hello.pure =================================================================== --- pure/trunk/examples/hello.pure 2008-09-03 22:02:24 UTC (rev 693) +++ pure/trunk/examples/hello.pure 2008-09-04 00:45:30 UTC (rev 694) @@ -166,6 +166,26 @@ primes 100; +/* Using streams (lazy lists), we can also compute the infinite list of *all* + prime numbers. */ + +all_primes = sieve (2..inf) with + sieve [] = []; + sieve (p:qs) = p : sieve [q; q = qs; q mod p] &; +end; + +// Assign this to a variable, so we can take advantage of memoization. +let P = all_primes; + +// The primes <=100, this is the same as primes 100. +let P1 = list $ takewhile (\x->x<=100) P; P1; + +// The first 30 primes. +let P2 = list $ take 30 P; P2; + +// The 299th prime. +P!299; + /* The classical n queens problem: Compute all placements of n queens on an n x n board so that no two queens hold each other in check. This algorithm demonstrates how you can use list comprehensions to organize backtracking This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 22:02:16
|
Revision: 693 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=693&view=rev Author: agraef Date: 2008-09-03 22:02:24 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Prelude changes: repeat was renamed to repeatn. Modified Paths: -------------- pure/trunk/lib/dict.pure Modified: pure/trunk/lib/dict.pure =================================================================== --- pure/trunk/lib/dict.pure 2008-09-03 21:47:54 UTC (rev 692) +++ pure/trunk/lib/dict.pure 2008-09-03 22:02:24 UTC (rev 693) @@ -271,8 +271,8 @@ // create dict or hdict from a list of keys and a constant value -mkdict y xs = dict (zipwith (=>) xs (repeat (#xs) y)) if listp xs; -mkhdict y xs = hdict (zipwith (=>) xs (repeat (#xs) y)) if listp xs; +mkdict y xs = dict (zipwith (=>) xs (repeatn (#xs) y)) if listp xs; +mkhdict y xs = hdict (zipwith (=>) xs (repeatn (#xs) y)) if listp xs; // check for the empty dict or hdict null (Dict nil) = 1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 21:47:46
|
Revision: 692 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=692&view=rev Author: agraef Date: 2008-09-03 21:47:54 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Arithmetic sequences permit an infinite upper bound now. Modified Paths: -------------- pure/trunk/lib/prelude.pure pure/trunk/test/prelude.log Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-09-03 21:20:42 UTC (rev 691) +++ pure/trunk/lib/prelude.pure 2008-09-03 21:47:54 UTC (rev 692) @@ -248,9 +248,11 @@ infix 1 .. ; -n1,n2..m = while (\i->s*i<=s*m) (\x->x+k) n1 +n1,n2..m = if m===s*inf then iterate (\x->x+k) n1 + else while (\i->s*i<=s*m) (\x->x+k) n1 when k = n2-n1; s = if k>0 then 1 else -1 end if n1!=n2; -n..m = while (\i->i<=m) (\x->x+1) n; +n..m = if m===inf then iterate (\x->x+1) n + else while (\i->i<=m) (\x->x+1) n; /* Common list functions. This mostly comes straight from the Q prelude which in turn was based on the first edition of the Bird/Wadler book, and is very Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-09-03 21:20:42 UTC (rev 691) +++ pure/trunk/test/prelude.log 2008-09-03 21:47:54 UTC (rev 692) @@ -311,7 +311,12 @@ <var> state 2 state 2: #0 } end; -n1/*0:0101*/,n2/*0:011*/..m/*0:1*/ = while (\i/*0:*/ -> s/*1:*/*i/*0:*/<=s/*1:*/*m/*3:1*/ { +n1/*0:0101*/,n2/*0:011*/..m/*0:1*/ = if m/*2:1*/===s/*0:*/*(1e+307*1e+307) then iterate (\x/*0:*/ -> x/*0:*/+k/*2:*/ { + rule #0: x = x+k + state 0: #0 + <var> state 1 + state 1: #0 +}) n1/*2:0101*/ else while (\i/*0:*/ -> s/*1:*/*i/*0:*/<=s/*1:*/*m/*3:1*/ { rule #0: i = s*i<=s*m state 0: #0 <var> state 1 @@ -332,7 +337,12 @@ <var> state 1 state 1: #0 } end if n1/*0:0101*/!=n2/*0:011*/; -n/*0:01*/..m/*0:1*/ = while (\i/*0:*/ -> i/*0:*/<=m/*1:1*/ { +n/*0:01*/..m/*0:1*/ = if m/*0:1*/===1e+307*1e+307 then iterate (\x/*0:*/ -> x/*0:*/+1 { + rule #0: x = x+1 + state 0: #0 + <var> state 1 + state 1: #0 +}) n/*0:01*/ else while (\i/*0:*/ -> i/*0:*/<=m/*1:1*/ { rule #0: i = i<=m state 0: #0 <var> state 1 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 21:20:34
|
Revision: 691 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=691&view=rev Author: agraef Date: 2008-09-03 21:20:42 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Make take and takewhile less eager by checking for thunked tails in the input. Modified Paths: -------------- pure/trunk/lib/prelude.pure pure/trunk/test/prelude.log Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-09-03 20:55:25 UTC (rev 690) +++ pure/trunk/lib/prelude.pure 2008-09-03 21:20:42 UTC (rev 691) @@ -400,6 +400,7 @@ take n::int xs@(_:_) = tick n [] xs with tick n::int zs xs = tack zs [] if n<=0; + = tack zs (take n xs&) if thunkp xs; = case xs of [] = tack zs []; x:xs = tick (n-1) (x:zs) xs; @@ -412,10 +413,13 @@ takewhile p [] = []; takewhile p xs@(_:_) = tick [] xs with - tick zs [] = tack zs []; - tick zs (x:xs) = tick (x:zs) xs if p x; - = tack zs []; - tick zs xs = tack zs (takewhile p xs); + tick zs xs = tack zs (takewhile p xs&) if thunkp xs; + = case xs of + [] = tack zs []; + x:xs = tick (x:zs) xs if p x; + = tack zs []; + _ = tack zs (takewhile p xs); + end; tack (x:xs) ys = tack xs (x:ys); tack [] ys = ys; end; Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-09-03 20:55:25 UTC (rev 690) +++ pure/trunk/test/prelude.log 2008-09-03 21:20:42 UTC (rev 691) @@ -947,7 +947,7 @@ } end; tail (x/*0:101*/:xs/*0:11*/) = xs/*0:11*/; take n/*0:01*/::int [] = []; -take n/*0:01*/::int xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ n/*0:01*/ [] xs/*0:1*/ with tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ [] if n/*0:001*/<=0; tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [] = tack/*2*/ zs/*1:01*/ []; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (n/*1:001*/-1) (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = tack/*2*/ zs/*1:01*/ (take n/*1:001*/ xs/*1:1*/) { +take n/*0:01*/::int xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ n/*0:01*/ [] xs/*0:1*/ with tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ [] if n/*0:001*/<=0; tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (take n/*1:001*/ xs/*1:1*/&) if thunkp xs/*0:1*/; tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [] = tack/*2*/ zs/*1:01*/ []; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (n/*1:001*/-1) (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = tack/*2*/ zs/*1:01*/ (take n/*1:001*/ xs/*1:1*/) { rule #0: [] = tack zs [] rule #1: x:xs = tick (n-1) (x:zs) xs rule #2: _ = tack zs (take n xs) @@ -978,14 +978,15 @@ state 12: #1 #2 } end { rule #0: tick n::int zs xs = tack zs [] if n<=0 - rule #1: tick n::int zs xs = case xs of [] = tack zs []; x:xs = tick (n-1) (x:zs) xs; _ = tack zs (take n xs) end - state 0: #0 #1 + rule #1: tick n::int zs xs = tack zs (take n xs&) if thunkp xs + rule #2: tick n::int zs xs = case xs of [] = tack zs []; x:xs = tick (n-1) (x:zs) xs; _ = tack zs (take n xs) end + state 0: #0 #1 #2 <var>::int state 1 - state 1: #0 #1 + state 1: #0 #1 #2 <var> state 2 - state 2: #0 #1 + state 2: #0 #1 #2 <var> state 3 - state 3: #0 #1 + state 3: #0 #1 #2 }; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { rule #0: tack (x:xs) ys = tack xs (x:ys) rule #1: tack [] ys = ys @@ -1008,38 +1009,44 @@ state 8: #1 } end; takewhile p/*0:01*/ [] = []; -takewhile p/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ []; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (x/*0:101*/:zs/*0:01*/) xs/*0:11*/ if p/*1:01*/ x/*0:101*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ []; tick zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (takewhile p/*1:01*/ xs/*0:1*/) { - rule #0: tick zs [] = tack zs [] - rule #1: tick zs (x:xs) = tick (x:zs) xs if p x - rule #2: tick zs (x:xs) = tack zs [] - rule #3: tick zs xs = tack zs (takewhile p xs) +takewhile p/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (takewhile p/*2:01*/ xs/*1:1*/&) if thunkp xs/*0:1*/; tick zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [] = tack/*2*/ zs/*1:01*/ []; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (x/*0:01*/:zs/*1:01*/) xs/*0:1*/ if p/*2:01*/ x/*0:01*/; x/*0:01*/:xs/*0:1*/ = tack/*2*/ zs/*1:01*/ []; _/*0:*/ = tack/*2*/ zs/*1:01*/ (takewhile p/*2:01*/ xs/*1:1*/) { + rule #0: [] = tack zs [] + rule #1: x:xs = tick (x:zs) xs if p x + rule #2: x:xs = tack zs [] + rule #3: _ = tack zs (takewhile p xs) state 0: #0 #1 #2 #3 <var> state 1 - state 1: #0 #1 #2 #3 - <var> state 2 - [] state 3 - <app> state 4 - state 2: #3 - state 3: #0 #3 - state 4: #1 #2 #3 + [] state 2 + <app> state 3 + state 1: #3 + state 2: #0 #3 + state 3: #1 #2 #3 + <var> state 4 + <app> state 6 + state 4: #3 <var> state 5 - <app> state 7 state 5: #3 - <var> state 6 - state 6: #3 - state 7: #1 #2 #3 + state 6: #1 #2 #3 + <var> state 7 + : state 10 + state 7: #3 <var> state 8 - : state 11 state 8: #3 <var> state 9 state 9: #3 - <var> state 10 - state 10: #3 + state 10: #1 #2 #3 + <var> state 11 state 11: #1 #2 #3 <var> state 12 state 12: #1 #2 #3 - <var> state 13 - state 13: #1 #2 #3 +} end { + rule #0: tick zs xs = tack zs (takewhile p xs&) if thunkp xs + rule #1: tick zs xs = case xs of [] = tack zs []; x:xs = tick (x:zs) xs if p x; x:xs = tack zs []; _ = tack zs (takewhile p xs) end + state 0: #0 #1 + <var> state 1 + state 1: #0 #1 + <var> state 2 + state 2: #0 #1 }; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { rule #0: tack (x:xs) ys = tack xs (x:ys) rule #1: tack [] ys = ys This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 20:55:19
|
Revision: 690 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=690&view=rev Author: agraef Date: 2008-09-03 20:55:25 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Overhaul of the list generator functions. Modified Paths: -------------- pure/trunk/lib/prelude.pure pure/trunk/lib/strings.pure pure/trunk/test/prelude.log Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-09-03 14:25:55 UTC (rev 689) +++ pure/trunk/lib/prelude.pure 2008-09-03 20:55:25 UTC (rev 690) @@ -460,30 +460,32 @@ search _ xs = index xs y; end; -/* Some useful list generators. */ +/* Some useful (infinite) list generators. */ -repeat n::int x = accum [] n x with +iterate f x = x : iterate f (f x)&; +repeat x = x : repeat x&; +cycle ys@(x:xs) = x : (xs+cycle ys)&; + +/* Some finite (and strict) generators. These work like the a combination of + takewhile/take and the above, but are implemented directly for maximum + efficiency. */ + +while p f x = accum [] p f x with + accum xs p f x = accum (x:xs) p f (f x) if p x; + = reverse xs otherwise; + end; + +repeatn n::int x = accum [] n x with accum xs n::int x = xs if n<=0; = accum (x:xs) (n-1) x; end; -cycle n::int [] = []; -cycle n::int (x:xs) = [] if n<=0; +cyclen n::int (x:xs) = [] if n<=0; = accum [] n with accum ys n::int = cat ys+take n xs if n<=m; = accum (xs:ys) (n-m) otherwise; end when xs = x:xs; m::int = #xs end if listp xs; -while p f a = accum [] p f a with - accum as p f a = accum (a:as) p f (f a) if p a; - = reverse as otherwise; - end; - -until p f a = accum [] p f a with - accum as p f a = reverse as if p a; - = accum (a:as) p f (f a) otherwise; - end; - /* zip, unzip and friends. */ zip [] _ | Modified: pure/trunk/lib/strings.pure =================================================================== --- pure/trunk/lib/strings.pure 2008-09-03 14:25:55 UTC (rev 689) +++ pure/trunk/lib/strings.pure 2008-09-03 20:55:25 UTC (rev 690) @@ -168,12 +168,8 @@ reverse s::string = strcat (reverse (chars s)); catmap f s::string = catmap f (chars s); -cycle n::int "" = ""; -cycle n::int s::string = "" if n<=0; - = accum [] n with - accum ys n = strcat ys+take n s if n<=m; - = accum (s:ys) (n-m) otherwise; - end when m::int = #s end; +cycle s::string = cycle (chars s); +cyclen n::int s::string = cyclen n (chars s) if not null s; all p s::string = all p (chars s); any p s::string = any p (chars s); Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-09-03 14:25:55 UTC (rev 689) +++ pure/trunk/test/prelude.log 2008-09-03 20:55:25 UTC (rev 690) @@ -1187,7 +1187,23 @@ <var> state 16 state 16: #1 #2 #3 } end; -repeat n/*0:01*/::int x/*0:1*/ = accum/*0*/ [] n/*0:01*/ x/*0:1*/ with accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = xs/*0:001*/ if n/*0:01*/<=0; accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = accum/*1*/ (x/*0:1*/:xs/*0:001*/) (n/*0:01*/-1) x/*0:1*/ { +iterate f/*0:01*/ x/*0:1*/ = x/*0:1*/:iterate f/*1:01*/ (f/*1:01*/ x/*1:1*/)&; +repeat x/*0:1*/ = x/*0:1*/:repeat x/*1:1*/&; +cycle ys@(x/*0:101*/:xs/*0:11*/) = x/*0:101*/:(xs/*1:11*/+cycle ys/*1:1*/)&; +while p/*0:001*/ f/*0:01*/ x/*0:1*/ = accum/*0*/ [] p/*0:001*/ f/*0:01*/ x/*0:1*/ with accum xs/*0:0001*/ p/*0:001*/ f/*0:01*/ x/*0:1*/ = accum/*1*/ (x/*0:1*/:xs/*0:0001*/) p/*0:001*/ f/*0:01*/ (f/*0:01*/ x/*0:1*/) if p/*0:001*/ x/*0:1*/; accum xs/*0:0001*/ p/*0:001*/ f/*0:01*/ x/*0:1*/ = reverse xs/*0:0001*/ { + rule #0: accum xs p f x = accum (x:xs) p f (f x) if p x + rule #1: accum xs p f x = reverse xs + state 0: #0 #1 + <var> state 1 + state 1: #0 #1 + <var> state 2 + state 2: #0 #1 + <var> state 3 + state 3: #0 #1 + <var> state 4 + state 4: #0 #1 +} end; +repeatn n/*0:01*/::int x/*0:1*/ = accum/*0*/ [] n/*0:01*/ x/*0:1*/ with accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = xs/*0:001*/ if n/*0:01*/<=0; accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = accum/*1*/ (x/*0:1*/:xs/*0:001*/) (n/*0:01*/-1) x/*0:1*/ { rule #0: accum xs n::int x = xs if n<=0 rule #1: accum xs n::int x = accum (x:xs) (n-1) x state 0: #0 #1 @@ -1198,9 +1214,8 @@ <var> state 3 state 3: #0 #1 } end; -cycle n/*0:01*/::int [] = []; -cycle n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = [] if n/*0:01*/<=0; -cycle n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] n/*2:01*/ with accum ys/*0:01*/ n/*0:1*/::int = cat ys/*0:01*/+take n/*0:1*/ xs/*2:*/ if n/*0:1*/<=m/*1:*/; accum ys/*0:01*/ n/*0:1*/::int = accum/*1*/ (xs/*2:*/:ys/*0:01*/) (n/*0:1*/-m/*1:*/) { +cyclen n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = [] if n/*0:01*/<=0; +cyclen n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] n/*2:01*/ with accum ys/*0:01*/ n/*0:1*/::int = cat ys/*0:01*/+take n/*0:1*/ xs/*2:*/ if n/*0:1*/<=m/*1:*/; accum ys/*0:01*/ n/*0:1*/::int = accum/*1*/ (xs/*2:*/:ys/*0:01*/) (n/*0:1*/-m/*1:*/) { rule #0: accum ys n::int = cat ys+take n xs if n<=m rule #1: accum ys n::int = accum (xs:ys) (n-m) state 0: #0 #1 @@ -1219,32 +1234,6 @@ <var> state 1 state 1: #0 } end if listp xs/*0:11*/; -while p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*0*/ [] p/*0:001*/ f/*0:01*/ a/*0:1*/ with accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*1*/ (a/*0:1*/:as/*0:0001*/) p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/) if p/*0:001*/ a/*0:1*/; accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = reverse as/*0:0001*/ { - rule #0: accum as p f a = accum (a:as) p f (f a) if p a - rule #1: accum as p f a = reverse as - state 0: #0 #1 - <var> state 1 - state 1: #0 #1 - <var> state 2 - state 2: #0 #1 - <var> state 3 - state 3: #0 #1 - <var> state 4 - state 4: #0 #1 -} end; -until p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*0*/ [] p/*0:001*/ f/*0:01*/ a/*0:1*/ with accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = reverse as/*0:0001*/ if p/*0:001*/ a/*0:1*/; accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*1*/ (a/*0:1*/:as/*0:0001*/) p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/) { - rule #0: accum as p f a = reverse as if p a - rule #1: accum as p f a = accum (a:as) p f (f a) - state 0: #0 #1 - <var> state 1 - state 1: #0 #1 - <var> state 2 - state 2: #0 #1 - <var> state 3 - state 3: #0 #1 - <var> state 4 - state 4: #0 #1 -} end; zip [] _/*0:1*/ = []; zip _/*0:01*/ [] = []; zip xs@(_/*0:0101*/:_/*0:011*/) ys@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:01*/ ys/*0:1*/ with tick us/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = tack/*1*/ ((x/*0:0101*/,y/*0:101*/):us/*0:001*/) (zip xs/*1:011*/ ys/*1:11*/&) if thunkp xs/*0:011*/||thunkp ys/*0:11*/; tick us/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = tick/*1*/ ((x/*0:0101*/,y/*0:101*/):us/*0:001*/) xs/*0:011*/ ys/*0:11*/; tick us/*0:001*/ [] _/*0:1*/ = tack/*1*/ us/*0:001*/ []; tick us/*0:001*/ _/*0:01*/ [] = tack/*1*/ us/*0:001*/ []; tick us/*0:001*/ xs/*0:01*/ ys/*0:1*/ = tack/*1*/ us/*0:001*/ (zip xs/*0:01*/ ys/*0:1*/) { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 14:25:47
|
Revision: 689 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=689&view=rev Author: agraef Date: 2008-09-03 14:25:55 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Fix missing compiler flag on 64 bit, reported by Eddie Rucker. Modified Paths: -------------- pure/trunk/Makefile.in Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-09-03 07:30:21 UTC (rev 688) +++ pure/trunk/Makefile.in 2008-09-03 14:25:55 UTC (rev 689) @@ -139,7 +139,7 @@ $(CXX) $(CXXFLAGS) $(CPPFLAGS) $(LLVM_FLAGS) -DPURELIB='"$(libdir)/pure-$(version)"' -c -o $@ $< runtime.o: runtime.cc - $(CXX) $(CXXFLAGS) $(CPPFLAGS) $(LLVM_FLAGS) -DPURELIB='"$(libdir)/pure-$(version)"' -c -o $@ $< + $(CXX) $(CXXFLAGS) $(PIC) $(CPPFLAGS) $(LLVM_FLAGS) -DPURELIB='"$(libdir)/pure-$(version)"' -c -o $@ $< interpreter.o: interpreter.cc $(CXX) $(CXXFLAGS) $(PIC) $(CPPFLAGS) $(LLVM_FLAGS) $(AUXLIBS) -c -o $@ $< This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 07:30:12
|
Revision: 688 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=688&view=rev Author: agraef Date: 2008-09-03 07:30:21 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Remove definitions for the slicing operator, which is now provided in a generic way in the prelude. Modified Paths: -------------- pure/trunk/lib/array.pure pure/trunk/lib/dict.pure Modified: pure/trunk/lib/array.pure =================================================================== --- pure/trunk/lib/array.pure 2008-09-03 07:09:12 UTC (rev 687) +++ pure/trunk/lib/array.pure 2008-09-03 07:30:21 UTC (rev 688) @@ -37,11 +37,6 @@ a!i return ith member of a a!(i,j) two-dimensional subscript - a!!is slicing (get a list of values from a list - indices - a!!ijs slicing of two-dimensional array (from a given - list of pairs [(i, j), ...]) - null a tests whether a is the empty array members a list of values stored in a members2 a list of members in a two-dimensional array @@ -108,14 +103,6 @@ // get value by indices from two-dimensional array x@(Array _)!(i::int, j::int) = x!i!j; -// slicing (get list of values from list of indices) -a@(Array _)!!is@(_::int:_) = [a!i; i = is; (i >= 0) && (i < (#a))]; - -// slicing of two-dimensional array -a@(Array _)!!ijs@((_::int, _::int):_) - = [a!(i, j); (i, j) = ijs; (i >= 0) && (i < (#a)) - && (j >= 0) && (j < (#(a!i)))]; - // check for an empty array null (Array nil) = 1; null (Array _) = 0; Modified: pure/trunk/lib/dict.pure =================================================================== --- pure/trunk/lib/dict.pure 2008-09-03 07:09:12 UTC (rev 687) +++ pure/trunk/lib/dict.pure 2008-09-03 07:30:21 UTC (rev 688) @@ -53,8 +53,6 @@ #d size of dict or hdict d d!x: get value from d by key x -d!!xs slicing (get a list of values - from a list of keys) null d tests whether d is the empty dict or hdict member d x tests whether d contains member with key x @@ -431,45 +429,6 @@ lookupk ( _ :xys) x = lookupk xys x end; -// slicing (get list of values from list of keys) -(Dict d)!!xs = slice d [] xs -with - slice d ys (x:xs) = slice d - (case mbr of nil = ys; - (nonil y) = (y:ys) end) xs - when - mbr = d!x - end; - slice d ys [] = reverse ys; - - nil!_ = nil; - (bin x y _ d1 d2)!x1 - = d1!x1 if x1 < x; - = d2!x1 if x1 > x; - = nonil y -end; - -(Hdict d)!!xs = slice d [] xs -with - slice d ys (x:xs) = slice d - (case mbr of nil = ys; - (nonil y) = (y:ys) end) xs - when - mbr = lookup d (hash x) x - end; - slice d ys [] = reverse ys; - - lookup nil _ _ = nil; - lookup (bin k::int xys _ d1 d2) k1::int x1 - = lookup d1 k1 x1 if k > k1; - = lookup d2 k1 x1 if k < k1; - = lookupk xys x1; - - lookupk [] _ = nil; - lookupk ((xa => y):_ ) xb = nonil y if xa === xb; - lookupk ( _ :xys) x = lookupk xys x -end; - // curried version of insert for dict and hdict update d@(Dict _) x y | update d@(Hdict _) x y This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-03 07:09:02
|
Revision: 687 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=687&view=rev Author: agraef Date: 2008-09-03 07:09:12 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Overhaul of prelude (non-strict list operations). Modified Paths: -------------- pure/trunk/lib/prelude.pure pure/trunk/lib/strings.pure pure/trunk/test/prelude.log Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-09-03 04:48:36 UTC (rev 686) +++ pure/trunk/lib/prelude.pure 2008-09-03 07:09:12 UTC (rev 687) @@ -28,16 +28,12 @@ nullary failed_match; // failed pattern match (lambda, case, etc.) nullary stack_fault; // not enough stack space (PURE_STACK limit) -/* Other exceptions defined by the prelude. We use exceptions sparingly, to - not interfere with symbolic evaluation, but in some cases it makes sense to - raise special kinds of exceptions in response to obvious error conditions. - In particular, the 'bad_list_value' exception is raised by functions which - need to work from the end of a list towards its front. */ +/* Other exceptions defined by the prelude. */ nullary malloc_error; // memory allocation error nullary out_of_bounds; // tuple or list index is out of bounds (!) // bad_list_value xs; // not a proper list value (reverse, etc.) - // xs denotes the offending tail of the list +// bad_tuple_value xs; // not a proper tuple value (unzip, etc.) /* Other constants. */ @@ -180,22 +176,39 @@ accum n::int xs = n+#xs; end; -(x,xs)!n::int = throw out_of_bounds if n<0; +[]!n::int = throw out_of_bounds; (x:xs)!0 = x; -(x:xs)!n::int = xs!(n-1); -[]!n::int = throw out_of_bounds; +(x:xs)!n::int = xs!(n-1) if n>0; + = throw out_of_bounds otherwise; +/* List concatenation. For a robust implementation which works with both + ordinary lists and streams, we want this to be tail-recursive *and* + non-strict. So we first walk down the list, popping elements from the first + operand until we find an empty or thunked tail ('tick'), then walk back up + again, pushing elements in front of the result list ('tack'). */ + []+ys = ys; -(x:xs)+ys = x : accum ys (reverse xs) with - accum ys (x:xs) = accum (x:ys) xs; - accum ys [] = ys; +xs@(_:_)+ys = tick [] xs ys +with + tick zs (x:xs) ys = tack (x:zs) ((xs+ys)&) if thunkp xs; + = tick (x:zs) xs ys; + tick zs [] ys = tack zs ys; + /* Handle an improper list tail (xs+ys is in normal form here). */ + tick zs xs ys = tack zs (xs+ys); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; end; +/* List reversal. This is a strict operation, of course, so it will loop on + infinite lists. Also, this is one of the few list operations which throws + an exception for improper lists, since in that case there really isn't any + meaningful value to return. */ + reverse [] = []; reverse (x:xs) = accum [x] xs with accum ys (x:xs) = accum (x:ys) xs; accum ys [] = ys; - accum _ xs = throw (bad_list_value xs); + accum ys xs = throw (bad_list_value xs); end; /* Convert between lists and tuples. */ @@ -213,12 +226,23 @@ accum ys xs = ys,xs; end; +/* Convert between lists and streams. */ + +list [] = []; +list (x:xs) = x:list xs; + +stream [] = []; +stream (x:xs) = x:xs if thunkp xs; + = x:stream xs& otherwise; + /* Slicing. xs!!ns returns the list of xs!n for all members n of the index - list ns which are in the range 0..#xs-1. xs must be a (proper) list or - tuple, and the indices must be machine ints. */ + list ns which are in the valid index range. This is a generic definition + which will work with any kind of container data structure which defines (!) + in such a manner that it throws an exception when the index is out of + bounds. */ -xs!!ns = [xs!n; n=ns; n>=0 && n<m] when m::int = #xs end - if listp xs || tuplep xs; +xs!!ns = catmap (nth xs) ns + with nth xs n = catch (cst []) [xs!n] end; /* Arithmetic sequences. */ @@ -231,139 +255,205 @@ /* Common list functions. This mostly comes straight from the Q prelude which in turn was based on the first edition of the Bird/Wadler book, and is very similar to what you can find in the Haskell prelude. Some functions have - slightly different names, though, and some of the definitions were massaged - to make them tail-recursive. */ + slightly different names, though, and of course everything is typed + dynamically. Some of the definitions aren't exactly pretty, but they are + like that because we want them to be both efficient and robust. In + particular, we require that they do all the necessary argument checking, + are tail-recursive and handle lazy lists as gracefully as possible. */ -all p [] = 1; -all p (x:xs) = if p x then all p xs else 0; +all p [] = 1; +all p (x:xs) = if p x then all p xs else 0; -any p [] = 0; -any p (x:xs) = if p x then 1 else any p xs; +any p [] = 0; +any p (x:xs) = if p x then 1 else any p xs; -do f [] = (); -do f (x:xs) = f x $$ do f xs; +do f [] = (); +do f (x:xs) = f x $$ do f xs; -drop n::int [] = []; -drop n::int (x:xs) - = drop (n-1) xs if n>0; - = x:xs otherwise; +drop n::int [] = []; +drop n::int ys@(x:xs) = drop (n-1) xs if n>1; + = xs if n==1; + = ys otherwise; -dropwhile p [] = []; -dropwhile p (x:xs) - = dropwhile p xs if p x; - = x:xs otherwise; +dropwhile p [] = []; +dropwhile p ys@(x:xs) = dropwhile p xs if p x; + = ys otherwise; -filter p [] = []; -filter p (x:xs) = accum [] (x:xs) with - accum ys [] = reverse ys; - accum ys (x:xs) = accum (x:ys) xs if p x; - = accum ys xs otherwise; - accum ys xs = reverse ys+filter p xs; - end; +filter p [] = []; +filter p xs@(_:_) = tick [] xs +with + add p x xs = if p x then x:xs else xs; + tick zs (x:xs) = tack (add p x zs) (filter p xs&) if thunkp xs; + = tick (add p x zs) xs; + tick zs [] = tack zs []; + tick _ xs = throw (bad_list_value xs); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; -foldl f a [] = a; -foldl f a (x:xs) - = foldl f (f a x) xs; +foldl f a [] = a; +foldl f a (x:xs) = foldl f (f a x) xs; -foldl1 f (x:xs) = foldl f x xs; +foldl1 f (x:xs) = foldl f x xs; -foldr f a [] = a; -foldr f a (x:xs) - = f x (foldl (flip f) a (reverse xs)); +foldr f a [] = a; +foldr f a xs@(_:_) = tick [] xs +with + tick zs (x:xs) = tack (x:zs) (foldr f a xs&) if thunkp xs; + = tick (x:zs) xs; + tick zs [] = tack zs a; + tick zs xs = tack zs (foldr f a xs); + tack (x:xs) y = tack xs (f x y); + tack [] y = y; +end; -foldr1 f [x] = x; -foldr1 f (x:xs) = f x (foldl1 (flip f) (reverse xs)); +foldr1 f [x] = x; +foldr1 f xs@(_:_) = tick [] xs +with + /* Do the thunkp check first, before probing the tail. Note that the first + foldr1 rule above ensures that the topmost tail is already evaluated, so + that we always make some progress here. */ + tick zs ys@(_:xs) = tack zs (foldr1 f ys&) if thunkp xs; + tick zs xs = case xs of + [x] = tack zs x; + x:xs = tick (x:zs) xs; + _ = tack zs (foldr1 f xs); + end; + tack (x:xs) y = tack xs (f x y); + tack [] y = y; +end; -head (x:xs) = x; +head (x:xs) = x; -init [x] = []; -init (x:xs) = accum [x] xs with - accum ys [x] = reverse ys; - accum ys (x:xs) = accum (x:ys) xs; - accum ys xs = reverse ys+init xs; - end; +init [x] = []; +init xs@(_:_) = tick [] xs +with + tick zs ys@(_:xs) = tack zs (init ys&) if thunkp xs; + tick zs xs = case xs of + [x] = tack zs []; + x:xs = tick (x:zs) xs; + _ = tack zs (init xs); + end; + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; -last [x] = x; -last (x:xs) = last xs; +last [x] = x; +last (x:xs) = last xs; -map f [] = []; -map f (x:xs) = accum [f x] xs with - accum ys [] = reverse ys; - accum ys (x:xs) = accum (f x:ys) xs; - accum ys xs = reverse ys+map f xs; - end; +map f [] = []; +map f xs@(_:_) = tick [] xs +with + tick zs (x:xs) = tack (f x:zs) (map f xs&) if thunkp xs; + = tick (f x:zs) xs; + tick zs [] = tack zs []; + tick zs xs = tack zs (map f xs); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; -scanl f a [] = [a]; -scanl f a (x:xs) - = accum [a] (f a x) xs with - accum ys a [] = reverse (a:ys); - accum ys a (x:xs) = accum (a:ys) (f a x) xs; - accum _ _ xs = throw (bad_list_value xs); - end; +scanl f a [] = [a]; +scanl f a xs@(_:_) = tick a [] xs +with + tick a zs (x:xs) = tack (a:zs) (scanl f (f a x) xs&) if thunkp xs; + = tick (f a x) (a:zs) xs; + tick a zs [] = tack zs [a]; + tick a zs xs = tack zs (scanl f a xs); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; -scanl1 f [] = []; -scanl1 f (x:xs) = accum [] x xs with - accum ys a [] = reverse (a:ys); - accum ys a (x:xs) = accum (a:ys) (f a x) xs; - accum _ _ xs = throw (bad_list_value xs); - end; +scanl1 f [] = []; +scanl1 f (x:xs) = scanl f x xs; -scanr f a [] = [a]; -scanr f a (x:xs) - = f x y:ys when - ys = reverse (scanl (flip f) a (reverse xs)); - y:_ = ys; - end; +scanr f a [] = [a]; +scanr f a xs@(_:_) = tick [] xs +with + /* Hack around with thunks to make these matches irrefutable. */ + tick zs (x:xs) = tack zs (f x (y when y:_ = ys end)&:ys + when ys = scanr f a xs& end) if thunkp xs; + = tick (x:zs) xs; + tick zs [] = tack zs [a]; + tick zs xs = throw (bad_list_value xs); + tack (x:xs) ys = tack xs (f x y:ys) when y:_ = ys end; + tack [] ys = ys; +end; -scanr1 f [] = []; -scanr1 f [x] = [x]; -scanr1 f (x:xs) = f x y:ys when - ys = reverse (scanl1 (flip f) (reverse xs)); - y:_ = ys; - end; +scanr1 f [] = []; +scanr1 f [x] = [x]; +scanr1 f xs@(_:_) = tick [] xs +with + tick zs (x:xs) = tack zs (f x (y when y:_ = ys end)&:ys + when ys = scanr1 f xs& end) if thunkp xs; + tick zs xs = case xs of + [x] = tack zs [x]; + x:xs = tick (x:zs) xs; + _ = throw (bad_list_value xs); + end; + tack (x:xs) ys = tack xs (f x y:ys) when y:_ = ys end; + tack [] ys = ys; +end; -tail (x:xs) = xs; +tail (x:xs) = xs; -take n::int [] = []; -take n::int (x:xs) - = accum n [] (x:xs) with - accum _ ys [] = reverse ys; - accum n::int ys _ = reverse ys if n<=0; - accum n::int ys (x:xs) - = accum (n-1) (x:ys) xs; - accum n ys xs = reverse ys+take n xs; - end; +take n::int [] = []; +take n::int xs@(_:_) = tick n [] xs +with + tick n::int zs xs = tack zs [] if n<=0; + = case xs of + [] = tack zs []; + x:xs = tick (n-1) (x:zs) xs; + _ = tack zs (take n xs); + end; + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; takewhile p [] = []; -takewhile p (x:xs) - = accum [] (x:xs) with - accum ys [] = reverse ys; - accum ys (x:xs) = accum (x:ys) xs if p x; - = reverse ys otherwise; - accum ys xs = reverse ys+takewhile p xs; - end; +takewhile p xs@(_:_) = tick [] xs +with + tick zs [] = tack zs []; + tick zs (x:xs) = tick (x:zs) xs if p x; + = tack zs []; + tick zs xs = tack zs (takewhile p xs); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; +end; /* Concatenate a list of lists. */ -cat [] = []; -cat [xs] = xs; -cat (xs:xss) = accum (reverse xs) xss with - accum xs [] = reverse xs; - accum xs ([]:yss) = accum xs yss; - accum xs ((y:ys):yss) = accum (y:xs) (ys:yss); - accum _ (ys:_) = throw (bad_list_value ys); - accum _ yss = throw (bad_list_value yss); +cat [] = []; +cat xs@(_:_) = foldr (+) [] xs +with + /* Unfortunately, the global list concatenation operator (+) isn't fully + lazy in Pure, because it's also used for arithmetic operations. Using it + here would make foldr (and hence cat) eager. Therefore we use our own + lazy concatenation operation here. */ + []+ys = ys; + xs@(_:_)+ys = tick [] xs ys; + tick zs (x:xs) ys = tack (x:zs) ((xs+ys)&) if thunkp xs; + = tick (x:zs) xs ys; + tick zs [] ys = tack zs ys; + tick zs xs ys = tack zs (xs+ys); + tack (x:xs) ys = tack xs (x:ys); + tack [] ys = ys; end; -/* Combine cat and map. This is used by list comprehensions. */ +/* Map a function to a list and concatenate the results. This is used by list + comprehensions. */ -catmap f xs = cat (map f xs); +catmap f [] = []; +catmap f xs@(_:_) = cat (map f xs); +/* NOTE: This definition (from the Haskell prelude) is better, but doesn't + preserve left-to-right execution order. */ +//catmap f xs@(_:_) = foldr ((+).f) [] xs; + /* Search an element in a list. Returns -1 if not found, index of first occurrence otherwise. */ -index [] _ = -1; -index (x:xs) y = search 0 (x:xs) with +index [] _ = -1; +index (x:xs) y = search 0 (x:xs) with search _ [] = -1; search n::int (x:xs) = n if x==y; = search (n+1) xs; @@ -372,49 +462,93 @@ /* Some useful list generators. */ -repeat n::int x = accum [] n x with +repeat n::int x = accum [] n x with accum xs n::int x = xs if n<=0; = accum (x:xs) (n-1) x; end; -cycle n::int [] = []; -cycle n::int (x:xs) - = [] if n<=0; - = accum [] n with - accum ys n::int = cat ys+take n xs if n<=m; - = accum (xs:ys) (n-m) otherwise; - end when xs = x:xs; m::int = #xs end if listp xs; +cycle n::int [] = []; +cycle n::int (x:xs) = [] if n<=0; + = accum [] n with + accum ys n::int = cat ys+take n xs if n<=m; + = accum (xs:ys) (n-m) otherwise; + end when xs = x:xs; m::int = #xs end if listp xs; -while p f a = accum [] p f a with - accum as p f a = accum (a:as) p f (f a) if p a; - = reverse as otherwise; - end; +while p f a = accum [] p f a with + accum as p f a = accum (a:as) p f (f a) if p a; + = reverse as otherwise; + end; -until p f a = accum [] p f a with - accum as p f a = reverse as if p a; - = accum (a:as) p f (f a) otherwise; - end; +until p f a = accum [] p f a with + accum as p f a = reverse as if p a; + = accum (a:as) p f (f a) otherwise; + end; /* zip, unzip and friends. */ -zip xs ys = accum [] xs ys with - accum us (x:xs) (y:ys) = accum ((x,y):us) xs ys; - accum us _ _ = reverse us; +zip [] _ | +zip _ [] = []; +zip xs@(_:_) ys@(_:_) = tick [] xs ys +with + tick us (x:xs) (y:ys) = tack ((x,y):us) (zip xs ys&) + if thunkp xs || thunkp ys; + = tick ((x,y):us) xs ys; + tick us [] _ | + tick us _ [] = tack us []; + tick us xs ys = tack us (zip xs ys); + tack (u:us) vs = tack us (u:vs); + tack [] vs = vs; end; -zip3 xs ys zs = accum [] xs ys zs with - accum us (x:xs) (y:ys) (z:zs) = accum ((x,y,z):us) xs ys zs; - accum us _ _ _ = reverse us; +zip3 [] _ _ | +zip3 _ [] _ | +zip3 _ _ [] = []; +zip3 xs@(_:_) ys@(_:_) zs@(_:_) + = tick [] xs ys zs +with + tick us (x:xs) (y:ys) (z:zs) + = tack ((x,y,z):us) (zip3 xs ys zs&) + if thunkp xs || thunkp ys || thunkp zs; + = tick ((x,y,z):us) xs ys zs; + tick us [] _ _ | + tick us _ [] _ | + tick us _ _ [] = tack us []; + tick us xs ys zs = tack us (zip3 xs ys zs); + tack (u:us) vs = tack us (u:vs); + tack [] vs = vs; end; -zipwith f xs ys = accum [] xs ys with - accum us (x:xs) (y:ys) = accum (f x y:us) xs ys; - accum us _ _ = reverse us; +zipwith f [] _ | +zipwith f _ [] = []; +zipwith f xs@(_:_) ys@(_:_) + = tick [] xs ys +with + tick us (x:xs) (y:ys) = tack (f x y:us) (zipwith f xs ys&) + if thunkp xs || thunkp ys; + = tick (f x y:us) xs ys; + tick us [] _ | + tick us _ [] = tack us []; + tick us xs ys = tack us (zipwith f xs ys); + tack (u:us) vs = tack us (u:vs); + tack [] vs = vs; end; -zipwith3 f xs ys zs = accum [] xs ys zs with - accum us (x:xs) (y:ys) (z:zs) = accum (f x y z:us) xs ys zs; - accum us _ _ _ = reverse us; +zipwith3 f [] _ _ | +zipwith3 f _ [] _ | +zipwith3 f _ _ [] = []; +zipwith3 f xs@(_:_) ys@(_:_) zs@(_:_) + = tick [] xs ys zs +with + tick us (x:xs) (y:ys) (z:zs) + = tack (f x y z:us) (zipwith3 f xs ys zs&) + if thunkp xs || thunkp ys || thunkp zs; + = tick (f x y z:us) xs ys zs; + tick us [] _ _ | + tick us _ [] _ | + tick us _ _ [] = tack us []; + tick us xs ys zs = tack us (zipwith3 f xs ys zs); + tack (u:us) vs = tack us (u:vs); + tack [] vs = vs; end; dowith f (x:xs) (y:ys) = f x y $$ dowith f xs ys; @@ -425,17 +559,20 @@ dowith3 f _ _ _ = () otherwise; unzip [] = [],[]; -unzip ((x,y):us) = x:xs,y:ys when xs,ys = accum [] [] us end +unzip us@(_:_) = foldr accum ([],[]) us with - accum xs ys [] = reverse xs,reverse ys; - accum xs ys ((x,y):us) = accum (x:xs) (y:ys) us; - accum _ _ us = throw (bad_list_value us); + accum u@(x,y) us = x:(xs when xs,_ = us end)&, + y:(ys when _,ys = us end)& if thunkp us; + = x:xs,y:ys when xs,ys = us end; + accum u _ = throw (bad_tuple_value u); end; unzip3 [] = [],[],[]; -unzip3 ((x,y,z):us) = x:xs,y:ys,z:zs when xs,ys,zs = accum [] [] [] us end +unzip3 us@(_:_) = foldr accum ([],[],[]) us with - accum xs ys zs [] = reverse xs,reverse ys,reverse zs; - accum xs ys zs ((x,y,z):us) = accum (x:xs) (y:ys) (z:zs) us; - accum _ _ _ us = throw (bad_list_value us); + accum u@(x,y,z) us = x:(xs when xs,_,_ = us end)&, + y:(ys when _,ys,_ = us end)&, + z:(zs when _,_,zs = us end)& if thunkp us; + = x:xs,y:ys,z:zs when xs,ys,zs = us end; + accum u _ = throw (bad_tuple_value u); end; Modified: pure/trunk/lib/strings.pure =================================================================== --- pure/trunk/lib/strings.pure 2008-09-03 04:48:36 UTC (rev 686) +++ pure/trunk/lib/strings.pure 2008-09-03 07:09:12 UTC (rev 687) @@ -151,19 +151,22 @@ end; end when m = #delim end if not null delim; -/* Slicing. */ +/* Conversions between between strings and lists, streams and tuples. */ -s::string!!ns = strcat [s!n; n=ns; n>=0 && n<m] - when m::int = #s end; +list s::string = chars s; +stream s::string = stream (chars s); +tuple s::string = tuple (chars s); /* Define the customary list operations on strings, so that these can mostly be used as if they were lists. */ -list s::string = chars s; -tuple s::string = tuple (chars s); +s::string+[] = chars s; +s::string+xs@(_:_) = chars s+xs; +[]+s::string+[] = chars s; +xs@(_:_)+s::string = xs+chars s; reverse s::string = strcat (reverse (chars s)); -cat (s::string:xs) = cat (chars s:xs); +catmap f s::string = catmap f (chars s); cycle n::int "" = ""; cycle n::int s::string = "" if n<=0; Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-09-03 04:48:36 UTC (rev 686) +++ pure/trunk/test/prelude.log 2008-09-03 07:09:12 UTC (rev 687) @@ -134,35 +134,79 @@ state 12: #0 #2 state 13: #1 #2 } end; -(x/*0:0101*/,xs/*0:011*/)!n/*0:1*/::int = throw out_of_bounds if n/*0:1*/<0; +[]!n/*0:1*/::int = throw out_of_bounds; (x/*0:0101*/:xs/*0:011*/)!0 = x/*0:0101*/; -(x/*0:0101*/:xs/*0:011*/)!n/*0:1*/::int = xs/*0:011*/!(n/*0:1*/-1); -[]!n/*0:1*/::int = throw out_of_bounds; +(x/*0:0101*/:xs/*0:011*/)!n/*0:1*/::int = xs/*0:011*/!(n/*0:1*/-1) if n/*0:1*/>0; +(x/*0:0101*/:xs/*0:011*/)!n/*0:1*/::int = throw out_of_bounds; []+ys/*0:1*/ = ys/*0:1*/; -(x/*0:0101*/:xs/*0:011*/)+ys/*0:1*/ = x/*0:0101*/:accum/*0*/ ys/*0:1*/ (reverse xs/*0:011*/) with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = ys/*0:01*/ { - rule #0: accum ys (x:xs) = accum (x:ys) xs - rule #1: accum ys [] = ys +xs@(_/*0:0101*/:_/*0:011*/)+ys/*0:1*/ = tick/*0*/ [] xs/*0:01*/ ys/*0:1*/ with tick zs/*0:001*/ (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ (x/*0:0101*/:zs/*0:001*/) ((xs/*1:011*/+ys/*1:1*/)&) if thunkp xs/*0:011*/; tick zs/*0:001*/ (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tick/*1*/ (x/*0:0101*/:zs/*0:001*/) xs/*0:011*/ ys/*0:1*/; tick zs/*0:001*/ [] ys/*0:1*/ = tack/*1*/ zs/*0:001*/ ys/*0:1*/; tick zs/*0:001*/ xs/*0:01*/ ys/*0:1*/ = tack/*1*/ zs/*0:001*/ (xs/*0:01*/+ys/*0:1*/) { + rule #0: tick zs (x:xs) ys = tack (x:zs) ((xs+ys)&) if thunkp xs + rule #1: tick zs (x:xs) ys = tick (x:zs) xs ys + rule #2: tick zs [] ys = tack zs ys + rule #3: tick zs xs ys = tack zs (xs+ys) + state 0: #0 #1 #2 #3 + <var> state 1 + state 1: #0 #1 #2 #3 + <var> state 2 + <app> state 4 + [] state 17 + state 2: #3 + <var> state 3 + state 3: #3 + state 4: #0 #1 #3 + <var> state 5 + <app> state 8 + state 5: #3 + <var> state 6 + state 6: #3 + <var> state 7 + state 7: #3 + state 8: #0 #1 #3 + <var> state 9 + : state 13 + state 9: #3 + <var> state 10 + state 10: #3 + <var> state 11 + state 11: #3 + <var> state 12 + state 12: #3 + state 13: #0 #1 #3 + <var> state 14 + state 14: #0 #1 #3 + <var> state 15 + state 15: #0 #1 #3 + <var> state 16 + state 16: #0 #1 #3 + state 17: #2 #3 + <var> state 18 + state 18: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys state 0: #0 #1 - <var> state 1 - state 1: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 <app> state 2 - [] state 7 state 2: #0 - <app> state 3 + : state 3 state 3: #0 - : state 4 + <var> state 4 state 4: #0 <var> state 5 state 5: #0 <var> state 6 state 6: #0 state 7: #1 + <var> state 8 + state 8: #1 } end; reverse [] = []; -reverse (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = ys/*0:01*/; accum _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { +reverse (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = ys/*0:01*/; accum ys/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { rule #0: accum ys (x:xs) = accum (x:ys) xs rule #1: accum ys [] = ys - rule #2: accum _ xs = throw (bad_list_value xs) + rule #2: accum ys xs = throw (bad_list_value xs) state 0: #0 #1 #2 <var> state 1 state 1: #0 #1 #2 @@ -254,17 +298,19 @@ state 12: #0 #2 state 13: #1 #2 } end; -xs/*0:01*/!!ns/*0:1*/ = catmap (\n/*0:*/ -> if n/*0:*/>=0&&n/*0:*/<m/*1:*/ then [xs/*2:01*/!n/*0:*/] else [] { - rule #0: n = if n>=0&&n<m then [xs!n] else [] +list [] = []; +list (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:list xs/*0:11*/; +stream [] = []; +stream (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:xs/*0:11*/ if thunkp xs/*0:11*/; +stream (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:stream xs/*1:11*/&; +xs/*0:01*/!!ns/*0:1*/ = catmap (nth/*0*/ xs/*0:01*/) ns/*0:1*/ with nth xs/*0:01*/ n/*0:1*/ = catch (cst []) [xs/*1:01*/!n/*1:1*/] { + rule #0: nth xs n = catch (cst []) [xs!n] state 0: #0 <var> state 1 state 1: #0 -}) ns/*1:1*/ when m/*0:*/::int = #xs/*0:01*/ { - rule #0: m::int = #xs - state 0: #0 - <var>::int state 1 - state 1: #0 -} end if listp xs/*0:01*/||tuplep xs/*0:01*/; + <var> state 2 + state 2: #0 +} end; n1/*0:0101*/,n2/*0:011*/..m/*0:1*/ = while (\i/*0:*/ -> s/*1:*/*i/*0:*/<=s/*1:*/*m/*3:1*/ { rule #0: i = s*i<=s*m state 0: #0 @@ -304,193 +350,407 @@ do f/*0:01*/ [] = (); do f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*0:01*/ x/*0:101*/$$do f/*0:01*/ xs/*0:11*/; drop n/*0:01*/::int [] = []; -drop n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = drop (n/*0:01*/-1) xs/*0:11*/ if n/*0:01*/>0; -drop n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:xs/*0:11*/; +drop n/*0:01*/::int ys@(x/*0:101*/:xs/*0:11*/) = drop (n/*0:01*/-1) xs/*0:11*/ if n/*0:01*/>1; +drop n/*0:01*/::int ys@(x/*0:101*/:xs/*0:11*/) = xs/*0:11*/ if n/*0:01*/==1; +drop n/*0:01*/::int ys@(x/*0:101*/:xs/*0:11*/) = ys/*0:1*/; dropwhile p/*0:01*/ [] = []; -dropwhile p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = dropwhile p/*0:01*/ xs/*0:11*/ if p/*0:01*/ x/*0:101*/; -dropwhile p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:xs/*0:11*/; +dropwhile p/*0:01*/ ys@(x/*0:101*/:xs/*0:11*/) = dropwhile p/*0:01*/ xs/*0:11*/ if p/*0:01*/ x/*0:101*/; +dropwhile p/*0:01*/ ys@(x/*0:101*/:xs/*0:11*/) = ys/*0:1*/; filter p/*0:01*/ [] = []; -filter p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] (x/*0:101*/:xs/*0:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/ if p/*1:01*/ x/*0:101*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ ys/*0:01*/ xs/*0:11*/; accum ys/*0:01*/ xs/*0:1*/ = reverse ys/*0:01*/+filter p/*1:01*/ xs/*0:1*/ { - rule #0: accum ys [] = reverse ys - rule #1: accum ys (x:xs) = accum (x:ys) xs if p x - rule #2: accum ys (x:xs) = accum ys xs - rule #3: accum ys xs = reverse ys+filter p xs +filter p/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ (add/*1*/ p/*1:01*/ x/*0:101*/ zs/*0:01*/) (filter p/*2:01*/ xs/*1:11*/&) if thunkp xs/*0:11*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (add/*1*/ p/*1:01*/ x/*0:101*/ zs/*0:01*/) xs/*0:11*/; tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ []; tick _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { + rule #0: tick zs (x:xs) = tack (add p x zs) (filter p xs&) if thunkp xs + rule #1: tick zs (x:xs) = tick (add p x zs) xs + rule #2: tick zs [] = tack zs [] + rule #3: tick _ xs = throw (bad_list_value xs) state 0: #0 #1 #2 #3 <var> state 1 state 1: #0 #1 #2 #3 <var> state 2 - [] state 3 - <app> state 4 + <app> state 3 + [] state 13 state 2: #3 - state 3: #0 #3 - state 4: #1 #2 #3 + state 3: #0 #1 #3 + <var> state 4 + <app> state 6 + state 4: #3 <var> state 5 - <app> state 7 state 5: #3 - <var> state 6 - state 6: #3 - state 7: #1 #2 #3 + state 6: #0 #1 #3 + <var> state 7 + : state 10 + state 7: #3 <var> state 8 - : state 11 state 8: #3 <var> state 9 state 9: #3 - <var> state 10 - state 10: #3 - state 11: #1 #2 #3 + state 10: #0 #1 #3 + <var> state 11 + state 11: #0 #1 #3 <var> state 12 - state 12: #1 #2 #3 - <var> state 13 - state 13: #1 #2 #3 + state 12: #0 #1 #3 + state 13: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 +}; add p/*0:001*/ x/*0:01*/ xs/*0:1*/ = if p/*0:001*/ x/*0:01*/ then x/*0:01*/:xs/*0:1*/ else xs/*0:1*/ { + rule #0: add p x xs = if p x then x:xs else xs + state 0: #0 + <var> state 1 + state 1: #0 + <var> state 2 + state 2: #0 + <var> state 3 + state 3: #0 } end; foldl f/*0:001*/ a/*0:01*/ [] = a/*0:01*/; foldl f/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = foldl f/*0:001*/ (f/*0:001*/ a/*0:01*/ x/*0:101*/) xs/*0:11*/; foldl1 f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = foldl f/*0:01*/ x/*0:101*/ xs/*0:11*/; foldr f/*0:001*/ a/*0:01*/ [] = a/*0:01*/; -foldr f/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*0:001*/ x/*0:101*/ (foldl (flip f/*0:001*/) a/*0:01*/ (reverse xs/*0:11*/)); -foldr1 f/*0:01*/ [x/*0:101*/] = x/*0:101*/; -foldr1 f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*0:01*/ x/*0:101*/ (foldl1 (flip f/*0:01*/) (reverse xs/*0:11*/)); -head (x/*0:101*/:xs/*0:11*/) = x/*0:101*/; -init [x/*0:101*/] = []; -init (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ [x/*0:101*/] = reverse ys/*0:01*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ xs/*0:1*/ = reverse ys/*0:01*/+init xs/*0:1*/ { - rule #0: accum ys [x] = reverse ys - rule #1: accum ys (x:xs) = accum (x:ys) xs - rule #2: accum ys xs = reverse ys+init xs - state 0: #0 #1 #2 +foldr f/*0:001*/ a/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ (x/*0:101*/:zs/*0:01*/) (foldr f/*2:001*/ a/*2:01*/ xs/*1:11*/&) if thunkp xs/*0:11*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (x/*0:101*/:zs/*0:01*/) xs/*0:11*/; tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ a/*1:01*/; tick zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (foldr f/*1:001*/ a/*1:01*/ xs/*0:1*/) { + rule #0: tick zs (x:xs) = tack (x:zs) (foldr f a xs&) if thunkp xs + rule #1: tick zs (x:xs) = tick (x:zs) xs + rule #2: tick zs [] = tack zs a + rule #3: tick zs xs = tack zs (foldr f a xs) + state 0: #0 #1 #2 #3 <var> state 1 - state 1: #0 #1 #2 + state 1: #0 #1 #2 #3 <var> state 2 <app> state 3 - state 2: #2 - state 3: #0 #1 #2 + [] state 13 + state 2: #3 + state 3: #0 #1 #3 <var> state 4 <app> state 6 - state 4: #2 + state 4: #3 <var> state 5 - state 5: #2 - state 6: #0 #1 #2 + state 5: #3 + state 6: #0 #1 #3 <var> state 7 : state 10 - state 7: #2 + state 7: #3 <var> state 8 - state 8: #2 + state 8: #3 <var> state 9 - state 9: #2 - state 10: #0 #1 #2 + state 9: #3 + state 10: #0 #1 #3 <var> state 11 - state 11: #0 #1 #2 + state 11: #0 #1 #3 <var> state 12 - [] state 13 - state 12: #1 #2 - state 13: #0 #1 #2 + state 12: #0 #1 #3 + state 13: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) y/*0:1*/ = tack/*1*/ xs/*0:011*/ (f/*1:001*/ x/*0:0101*/ y/*0:1*/); tack [] y/*0:1*/ = y/*0:1*/ { + rule #0: tack (x:xs) y = tack xs (f x y) + rule #1: tack [] y = y + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; -last [x/*0:101*/] = x/*0:101*/; -last (x/*0:101*/:xs/*0:11*/) = last xs/*0:11*/; -map f/*0:01*/ [] = []; -map f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [f/*0:01*/ x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (f/*1:01*/ x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ xs/*0:1*/ = reverse ys/*0:01*/+map f/*1:01*/ xs/*0:1*/ { - rule #0: accum ys [] = reverse ys - rule #1: accum ys (x:xs) = accum (f x:ys) xs - rule #2: accum ys xs = reverse ys+map f xs +foldr1 f/*0:01*/ [x/*0:101*/] = x/*0:101*/; +foldr1 f/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ ys@(_/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ (foldr1 f/*2:01*/ ys/*1:1*/&) if thunkp xs/*0:11*/; tick zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [x/*0:01*/] = tack/*2*/ zs/*1:01*/ x/*0:01*/; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = tack/*2*/ zs/*1:01*/ (foldr1 f/*2:01*/ xs/*1:1*/) { + rule #0: [x] = tack zs x + rule #1: x:xs = tick (x:zs) xs + rule #2: _ = tack zs (foldr1 f xs) state 0: #0 #1 #2 <var> state 1 - state 1: #0 #1 #2 - <var> state 2 - [] state 3 - <app> state 4 - state 2: #2 - state 3: #0 #2 - state 4: #1 #2 - <var> state 5 - <app> state 7 - state 5: #2 + <app> state 2 + state 1: #2 + state 2: #0 #1 #2 + <var> state 3 + <app> state 5 + state 3: #2 + <var> state 4 + state 4: #2 + state 5: #0 #1 #2 <var> state 6 + : state 9 state 6: #2 - state 7: #1 #2 + <var> state 7 + state 7: #2 <var> state 8 - : state 11 state 8: #2 - <var> state 9 - state 9: #2 + state 9: #0 #1 #2 <var> state 10 - state 10: #2 + state 10: #0 #1 #2 + <var> state 11 + [] state 12 state 11: #1 #2 + state 12: #0 #1 #2 +} end { + rule #0: tick zs ys@(_:xs) = tack zs (foldr1 f ys&) if thunkp xs + rule #1: tick zs xs = case xs of [x] = tack zs x; x:xs = tick (x:zs) xs; _ = tack zs (foldr1 f xs) end + state 0: #0 #1 + <var> state 1 + state 1: #0 #1 + <var> state 2 + <app> state 3 + state 2: #1 + state 3: #0 #1 + <var> state 4 + <app> state 6 + state 4: #1 + <var> state 5 + state 5: #1 + state 6: #0 #1 + <var> state 7 + : state 10 + state 7: #1 + <var> state 8 + state 8: #1 + <var> state 9 + state 9: #1 + state 10: #0 #1 + <var> state 11 + state 11: #0 #1 <var> state 12 - state 12: #1 #2 - <var> state 13 - state 13: #1 #2 + state 12: #0 #1 +}; tack (x/*0:0101*/:xs/*0:011*/) y/*0:1*/ = tack/*1*/ xs/*0:011*/ (f/*1:01*/ x/*0:0101*/ y/*0:1*/); tack [] y/*0:1*/ = y/*0:1*/ { + rule #0: tack (x:xs) y = tack xs (f x y) + rule #1: tack [] y = y + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; -scanl f/*0:001*/ a/*0:01*/ [] = [a/*0:01*/]; -scanl f/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [a/*0:01*/] (f/*0:001*/ a/*0:01*/ x/*0:101*/) xs/*0:11*/ with accum ys/*0:001*/ a/*0:01*/ [] = reverse (a/*0:01*/:ys/*0:001*/); accum ys/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (a/*0:01*/:ys/*0:001*/) (f/*1:001*/ a/*0:01*/ x/*0:101*/) xs/*0:11*/; accum _/*0:001*/ _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { - rule #0: accum ys a [] = reverse (a:ys) - rule #1: accum ys a (x:xs) = accum (a:ys) (f a x) xs - rule #2: accum _ _ xs = throw (bad_list_value xs) +head (x/*0:101*/:xs/*0:11*/) = x/*0:101*/; +init [x/*0:101*/] = []; +init xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ ys@(_/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ (init ys/*1:1*/&) if thunkp xs/*0:11*/; tick zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [x/*0:01*/] = tack/*2*/ zs/*1:01*/ []; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = tack/*2*/ zs/*1:01*/ (init xs/*1:1*/) { + rule #0: [x] = tack zs [] + rule #1: x:xs = tick (x:zs) xs + rule #2: _ = tack zs (init xs) state 0: #0 #1 #2 <var> state 1 - state 1: #0 #1 #2 - <var> state 2 + <app> state 2 + state 1: #2 state 2: #0 #1 #2 <var> state 3 - [] state 4 <app> state 5 state 3: #2 - state 4: #0 #2 - state 5: #1 #2 + <var> state 4 + state 4: #2 + state 5: #0 #1 #2 <var> state 6 - <app> state 8 + : state 9 state 6: #2 <var> state 7 state 7: #2 - state 8: #1 #2 - <var> state 9 - : state 12 - state 9: #2 + <var> state 8 + state 8: #2 + state 9: #0 #1 #2 <var> state 10 - state 10: #2 + state 10: #0 #1 #2 <var> state 11 - state 11: #2 - state 12: #1 #2 - <var> state 13 - state 13: #1 #2 - <var> state 14 - state 14: #1 #2 + [] state 12 + state 11: #1 #2 + state 12: #0 #1 #2 +} end { + rule #0: tick zs ys@(_:xs) = tack zs (init ys&) if thunkp xs + rule #1: tick zs xs = case xs of [x] = tack zs []; x:xs = tick (x:zs) xs; _ = tack zs (init xs) end + state 0: #0 #1 + <var> state 1 + state 1: #0 #1 + <var> state 2 + <app> state 3 + state 2: #1 + state 3: #0 #1 + <var> state 4 + <app> state 6 + state 4: #1 + <var> state 5 + state 5: #1 + state 6: #0 #1 + <var> state 7 + : state 10 + state 7: #1 + <var> state 8 + state 8: #1 + <var> state 9 + state 9: #1 + state 10: #0 #1 + <var> state 11 + state 11: #0 #1 + <var> state 12 + state 12: #0 #1 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; -scanl1 f/*0:01*/ [] = []; -scanl1 f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] x/*0:101*/ xs/*0:11*/ with accum ys/*0:001*/ a/*0:01*/ [] = reverse (a/*0:01*/:ys/*0:001*/); accum ys/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (a/*0:01*/:ys/*0:001*/) (f/*1:01*/ a/*0:01*/ x/*0:101*/) xs/*0:11*/; accum _/*0:001*/ _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { - rule #0: accum ys a [] = reverse (a:ys) - rule #1: accum ys a (x:xs) = accum (a:ys) (f a x) xs - rule #2: accum _ _ xs = throw (bad_list_value xs) - state 0: #0 #1 #2 +last [x/*0:101*/] = x/*0:101*/; +last (x/*0:101*/:xs/*0:11*/) = last xs/*0:11*/; +map f/*0:01*/ [] = []; +map f/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ (f/*1:01*/ x/*0:101*/:zs/*0:01*/) (map f/*2:01*/ xs/*1:11*/&) if thunkp xs/*0:11*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (f/*1:01*/ x/*0:101*/:zs/*0:01*/) xs/*0:11*/; tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ []; tick zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (map f/*1:01*/ xs/*0:1*/) { + rule #0: tick zs (x:xs) = tack (f x:zs) (map f xs&) if thunkp xs + rule #1: tick zs (x:xs) = tick (f x:zs) xs + rule #2: tick zs [] = tack zs [] + rule #3: tick zs xs = tack zs (map f xs) + state 0: #0 #1 #2 #3 <var> state 1 - state 1: #0 #1 #2 + state 1: #0 #1 #2 #3 <var> state 2 - state 2: #0 #1 #2 + <app> state 3 + [] state 13 + state 2: #3 + state 3: #0 #1 #3 + <var> state 4 + <app> state 6 + state 4: #3 + <var> state 5 + state 5: #3 + state 6: #0 #1 #3 + <var> state 7 + : state 10 + state 7: #3 + <var> state 8 + state 8: #3 + <var> state 9 + state 9: #3 + state 10: #0 #1 #3 + <var> state 11 + state 11: #0 #1 #3 + <var> state 12 + state 12: #0 #1 #3 + state 13: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 +} end; +scanl f/*0:001*/ a/*0:01*/ [] = [a/*0:01*/]; +scanl f/*0:001*/ a/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ a/*0:01*/ [] xs/*0:1*/ with tick a/*0:001*/ zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ (a/*0:001*/:zs/*0:01*/) (scanl f/*2:001*/ (f/*2:001*/ a/*1:001*/ x/*1:101*/) xs/*1:11*/&) if thunkp xs/*0:11*/; tick a/*0:001*/ zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (f/*1:001*/ a/*0:001*/ x/*0:101*/) (a/*0:001*/:zs/*0:01*/) xs/*0:11*/; tick a/*0:001*/ zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ [a/*0:001*/]; tick a/*0:001*/ zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (scanl f/*1:001*/ a/*0:001*/ xs/*0:1*/) { + rule #0: tick a zs (x:xs) = tack (a:zs) (scanl f (f a x) xs&) if thunkp xs + rule #1: tick a zs (x:xs) = tick (f a x) (a:zs) xs + rule #2: tick a zs [] = tack zs [a] + rule #3: tick a zs xs = tack zs (scanl f a xs) + state 0: #0 #1 #2 #3 + <var> state 1 + state 1: #0 #1 #2 #3 + <var> state 2 + state 2: #0 #1 #2 #3 <var> state 3 - [] state 4 - <app> state 5 - state 3: #2 - state 4: #0 #2 - state 5: #1 #2 + <app> state 4 + [] state 14 + state 3: #3 + state 4: #0 #1 #3 + <var> state 5 + <app> state 7 + state 5: #3 <var> state 6 - <app> state 8 - state 6: #2 - <var> state 7 - state 7: #2 - state 8: #1 #2 + state 6: #3 + state 7: #0 #1 #3 + <var> state 8 + : state 11 + state 8: #3 <var> state 9 - : state 12 - state 9: #2 + state 9: #3 <var> state 10 - state 10: #2 - <var> state 11 - state 11: #2 - state 12: #1 #2 + state 10: #3 + state 11: #0 #1 #3 + <var> state 12 + state 12: #0 #1 #3 <var> state 13 - state 13: #1 #2 - <var> state 14 - state 14: #1 #2 + state 13: #0 #1 #3 + state 14: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; +scanl1 f/*0:01*/ [] = []; +scanl1 f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = scanl f/*0:01*/ x/*0:101*/ xs/*0:11*/; scanr f/*0:001*/ a/*0:01*/ [] = [a/*0:01*/]; -scanr f/*0:001*/ a/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*2:001*/ x/*2:101*/ y/*0:01*/:ys/*1:*/ when ys/*0:*/ = reverse (scanl (flip f/*0:001*/) a/*0:01*/ (reverse xs/*0:11*/)); y/*0:01*/:_/*0:1*/ = ys/*0:*/ { +scanr f/*0:001*/ a/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ (f/*3:001*/ x/*2:101*/ (y/*0:01*/ when y/*0:01*/:_/*0:1*/ = ys/*1:*/ { rule #0: y:_ = ys state 0: #0 <app> state 1 @@ -503,15 +763,80 @@ state 4: #0 <var> state 5 state 5: #0 -} { - rule #0: ys = reverse (scanl (flip f) a (reverse xs)) +} end)&:ys/*0:*/ when ys/*0:*/ = scanr f/*2:001*/ a/*2:01*/ xs/*1:11*/& { + rule #0: ys = scanr f a xs& state 0: #0 <var> state 1 state 1: #0 +} end) if thunkp xs/*0:11*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (x/*0:101*/:zs/*0:01*/) xs/*0:11*/; tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ [a/*1:01*/]; tick zs/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) { + rule #0: tick zs (x:xs) = tack zs (f x (y when y:_ = ys end)&:ys when ys = scanr f a xs& end) if thunkp xs + rule #1: tick zs (x:xs) = tick (x:zs) xs + rule #2: tick zs [] = tack zs [a] + rule #3: tick zs xs = throw (bad_list_value xs) + state 0: #0 #1 #2 #3 + <var> state 1 + state 1: #0 #1 #2 #3 + <var> state 2 + <app> state 3 + [] state 13 + state 2: #3 + state 3: #0 #1 #3 + <var> state 4 + <app> state 6 + state 4: #3 + <var> state 5 + state 5: #3 + state 6: #0 #1 #3 + <var> state 7 + : state 10 + state 7: #3 + <var> state 8 + state 8: #3 + <var> state 9 + state 9: #3 + state 10: #0 #1 #3 + <var> state 11 + state 11: #0 #1 #3 + <var> state 12 + state 12: #0 #1 #3 + state 13: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*2*/ xs/*1:011*/ (f/*2:001*/ x/*1:0101*/ y/*0:01*/:ys/*1:1*/) when y/*0:01*/:_/*0:1*/ = ys/*0:1*/ { + rule #0: y:_ = ys + state 0: #0 + <app> state 1 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 +} end; tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (f x y:ys) when y:_ = ys end + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; scanr1 f/*0:01*/ [] = []; scanr1 f/*0:01*/ [x/*0:101*/] = [x/*0:101*/]; -scanr1 f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*2:01*/ x/*2:101*/ y/*0:01*/:ys/*1:*/ when ys/*0:*/ = reverse (scanl1 (flip f/*0:01*/) (reverse xs/*0:11*/)); y/*0:01*/:_/*0:1*/ = ys/*0:*/ { +scanr1 f/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ (f/*3:01*/ x/*2:101*/ (y/*0:01*/ when y/*0:01*/:_/*0:1*/ = ys/*1:*/ { rule #0: y:_ = ys state 0: #0 <app> state 1 @@ -524,63 +849,170 @@ state 4: #0 <var> state 5 state 5: #0 -} { - rule #0: ys = reverse (scanl1 (flip f) (reverse xs)) +} end)&:ys/*0:*/ when ys/*0:*/ = scanr1 f/*2:01*/ xs/*1:11*/& { + rule #0: ys = scanr1 f xs& state 0: #0 <var> state 1 state 1: #0 +} end) if thunkp xs/*0:11*/; tick zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [x/*0:01*/] = tack/*2*/ zs/*1:01*/ [x/*0:01*/]; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = throw (bad_list_value xs/*1:1*/) { + rule #0: [x] = tack zs [x] + rule #1: x:xs = tick (x:zs) xs + rule #2: _ = throw (bad_list_value xs) + state 0: #0 #1 #2 + <var> state 1 + <app> state 2 + state 1: #2 + state 2: #0 #1 #2 + <var> state 3 + <app> state 5 + state 3: #2 + <var> state 4 + state 4: #2 + state 5: #0 #1 #2 + <var> state 6 + : state 9 + state 6: #2 + <var> state 7 + state 7: #2 + <var> state 8 + state 8: #2 + state 9: #0 #1 #2 + <var> state 10 + state 10: #0 #1 #2 + <var> state 11 + [] state 12 + state 11: #1 #2 + state 12: #0 #1 #2 +} end { + rule #0: tick zs (x:xs) = tack zs (f x (y when y:_ = ys end)&:ys when ys = scanr1 f xs& end) if thunkp xs + rule #1: tick zs xs = case xs of [x] = tack zs [x]; x:xs = tick (x:zs) xs; _ = throw (bad_list_value xs) end + state 0: #0 #1 + <var> state 1 + state 1: #0 #1 + <var> state 2 + <app> state 3 + state 2: #1 + state 3: #0 #1 + <var> state 4 + <app> state 6 + state 4: #1 + <var> state 5 + state 5: #1 + state 6: #0 #1 + <var> state 7 + : state 10 + state 7: #1 + <var> state 8 + state 8: #1 + <var> state 9 + state 9: #1 + state 10: #0 #1 + <var> state 11 + state 11: #0 #1 + <var> state 12 + state 12: #0 #1 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*2*/ xs/*1:011*/ (f/*2:01*/ x/*1:0101*/ y/*0:01*/:ys/*1:1*/) when y/*0:01*/:_/*0:1*/ = ys/*0:1*/ { + rule #0: y:_ = ys + state 0: #0 + <app> state 1 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 +} end; tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (f x y:ys) when y:_ = ys end + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; tail (x/*0:101*/:xs/*0:11*/) = xs/*0:11*/; take n/*0:01*/::int [] = []; -take n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = accum/*0*/ n/*0:01*/ [] (x/*0:101*/:xs/*0:11*/) with accum _/*0:001*/ ys/*0:01*/ [] = reverse ys/*0:01*/; accum n/*0:001*/::int ys/*0:01*/ _/*0:1*/ = reverse ys/*0:01*/ if n/*0:001*/<=0; accum n/*0:001*/::int ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (n/*0:001*/-1) (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum n/*0:001*/ ys/*0:01*/ xs/*0:1*/ = reverse ys/*0:01*/+take n/*0:001*/ xs/*0:1*/ { - rule #0: accum _ ys [] = reverse ys - rule #1: accum n::int ys _ = reverse ys if n<=0 - rule #2: accum n::int ys (x:xs) = accum (n-1) (x:ys) xs - rule #3: accum n ys xs = reverse ys+take n xs - state 0: #0 #1 #2 #3 +take n/*0:01*/::int xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ n/*0:01*/ [] xs/*0:1*/ with tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ [] if n/*0:001*/<=0; tick n/*0:001*/::int zs/*0:01*/ xs/*0:1*/ = case xs/*0:1*/ of [] = tack/*2*/ zs/*1:01*/ []; x/*0:01*/:xs/*0:1*/ = tick/*2*/ (n/*1:001*/-1) (x/*0:01*/:zs/*1:01*/) xs/*0:1*/; _/*0:*/ = tack/*2*/ zs/*1:01*/ (take n/*1:001*/ xs/*1:1*/) { + rule #0: [] = tack zs [] + rule #1: x:xs = tick (n-1) (x:zs) xs + rule #2: _ = tack zs (take n xs) + state 0: #0 #1 #2 <var> state 1 - <var>::int state 5 - state 1: #0 #3 + [] state 2 + <app> state 3 + state 1: #2 + state 2: #0 #2 + state 3: #1 #2 + <var> state 4 + <app> state 6 + state 4: #2 + <var> state 5 + state 5: #2 + state 6: #1 #2 + <var> state 7 + : state 10 + state 7: #2 + <var> state 8 + state 8: #2 + <var> state 9 + state 9: #2 + state 10: #1 #2 + <var> state 11 + state 11: #1 #2 + <var> state 12 + state 12: #1 #2 +} end { + rule #0: tick n::int zs xs = tack zs [] if n<=0 + rule #1: tick n::int zs xs = case xs of [] = tack zs []; x:xs = tick (n-1) (x:zs) xs; _ = tack zs (take n xs) end + state 0: #0 #1 + <var>::int state 1 + state 1: #0 #1 <var> state 2 - state 2: #0 #3 + state 2: #0 #1 <var> state 3 - [] state 4 - state 3: #3 - state 4: #0 #3 - state 5: #0 #1 #2 #3 + state 3: #0 #1 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 <var> state 6 - state 6: #0 #1 #2 #3 - <var> state 7 - [] state 8 - <app> state 9 - state 7: #1 #3 - state 8: #0 #1 #3 - state 9: #1 #2 #3 - <var> state 10 - <app> state 12 - state 10: #1 #3 - <var> state 11 - state 11: #1 #3 - state 12: #1 #2 #3 - <var> state 13 - : state 16 - state 13: #1 #3 - <var> state 14 - state 14: #1 #3 - <var> state 15 - state 15: #1 #3 - state 16: #1 #2 #3 - <var> state 17 - state 17: #1 #2 #3 - <var> state 18 - state 18: #1 #2 #3 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; takewhile p/*0:01*/ [] = []; -takewhile p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] (x/*0:101*/:xs/*0:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/ if p/*1:01*/ x/*0:101*/; accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = reverse ys/*0:01*/; accum ys/*0:01*/ xs/*0:1*/ = reverse ys/*0:01*/+takewhile p/*1:01*/ xs/*0:1*/ { - rule #0: accum ys [] = reverse ys - rule #1: accum ys (x:xs) = accum (x:ys) xs if p x - rule #2: accum ys (x:xs) = reverse ys - rule #3: accum ys xs = reverse ys+takewhile p xs +takewhile p/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:1*/ with tick zs/*0:01*/ [] = tack/*1*/ zs/*0:01*/ []; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tick/*1*/ (x/*0:101*/:zs/*0:01*/) xs/*0:11*/ if p/*1:01*/ x/*0:101*/; tick zs/*0:01*/ (x/*0:101*/:xs/*0:11*/) = tack/*1*/ zs/*0:01*/ []; tick zs/*0:01*/ xs/*0:1*/ = tack/*1*/ zs/*0:01*/ (takewhile p/*1:01*/ xs/*0:1*/) { + rule #0: tick zs [] = tack zs [] + rule #1: tick zs (x:xs) = tick (x:zs) xs if p x + rule #2: tick zs (x:xs) = tack zs [] + rule #3: tick zs xs = tack zs (takewhile p xs) state 0: #0 #1 #2 #3 <var> state 1 state 1: #0 #1 #2 #3 @@ -608,74 +1040,113 @@ state 12: #1 #2 #3 <var> state 13 state 13: #1 #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; cat [] = []; -cat [xs/*0:101*/] = xs/*0:101*/; -cat (xs/*0:101*/:xss/*0:11*/) = accum/*0*/ (reverse xs/*0:101*/) xss/*0:11*/ with accum xs/*0:01*/ [] = reverse xs/*0:01*/; accum xs/*0:01*/ ([]:yss/*0:11*/) = accum/*1*/ xs/*0:01*/ yss/*0:11*/; accum xs/*0:01*/ ((y/*0:10101*/:ys/*0:1011*/):yss/*0:11*/) = accum/*1*/ (y/*0:10101*/:xs/*0:01*/) (ys/*0:1011*/:yss/*0:11*/); accum _/*0:01*/ (ys/*0:101*/:_/*0:11*/) = throw (bad_list_value ys/*0:101*/); accum _/*0:01*/ yss/*0:1*/ = throw (bad_list_value yss/*0:1*/) { - rule #0: accum xs [] = reverse xs - rule #1: accum xs ([]:yss) = accum xs yss - rule #2: accum xs ((y:ys):yss) = accum (y:xs) (ys:yss) - rule #3: accum _ (ys:_) = throw (bad_list_value ys) - rule #4: accum _ yss = throw (bad_list_value yss) - state 0: #0 #1 #2 #3 #4 +cat xs@(_/*0:101*/:_/*0:11*/) = foldr ((+/*0*/)) [] xs/*0:1*/ with []+ys/*0:1*/ = ys/*0:1*/; xs@(_/*0:0101*/:_/*0:011*/)+ys/*0:1*/ = tick/*1*/ [] xs/*0:01*/ ys/*0:1*/ { + rule #0: []+ys = ys + rule #1: xs@(_:_)+ys = tick [] xs ys + state 0: #0 #1 + [] state 1 + <app> state 3 + state 1: #0 + <var> state 2 + state 2: #0 + state 3: #1 + <app> state 4 + state 4: #1 + : state 5 + state 5: #1 + <var> state 6 + state 6: #1 + <var> state 7 + state 7: #1 + <var> state 8 + state 8: #1 +}; tick zs/*0:001*/ (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ (x/*0:0101*/:zs/*0:001*/) (xs/*1:011*/+/*2*/ys/*1:1*/&) if thunkp xs/*0:011*/; tick zs/*0:001*/ (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tick/*1*/ (x/*0:0101*/:zs/*0:001*/) xs/*0:011*/ ys/*0:1*/; tick zs/*0:001*/ [] ys/*0:1*/ = tack/*1*/ zs/*0:001*/ ys/*0:1*/; tick zs/*0:001*/ xs/*0:01*/ ys/*0:1*/ = tack/*1*/ zs/*0:001*/ (xs/*0:01*/+/*1*/ys/*0:1*/) { + rule #0: tick zs (x:xs) ys = tack (x:zs) (xs+ys&) if thunkp xs + rule #1: tick zs (x:xs) ys = tick (x:zs) xs ys + rule #2: tick zs [] ys = tack zs ys + rule #3: tick zs xs ys = tack zs (xs+ys) + state 0: #0 #1 #2 #3 <var> state 1 - state 1: #0 #1 #2 #3 #4 + state 1: #0 #1 #2 #3 <var> state 2 - [] state 3 <app> state 4 - state 2: #4 - state 3: #0 #4 - state 4: #1 #2 #3 #4 + [] state 17 + state 2: #3 + <var> state 3 + state 3: #3 + state 4: #0 #1 #3 <var> state 5 - <app> state 7 - state 5: #4 + <app> state 8 + state 5: #3 <var> state 6 - state 6: #4 - state 7: #1 #2 #3 #4 - <var> state 8 - : state 11 - state 8: #4 + state 6: #3 + <var> state 7 + state 7: #3 + state 8: #0 #1 #3 <var> state 9 - state 9: #4 + : state 13 + state 9: #3 <var> state 10 - state 10: #4 - state 11: #1 #2 #3 #4 + state 10: #3 + <var> state 11 + state 11: #3 <var> state 12 - [] state 14 - <app> state 16 - state 12: #3 #4 - <var> state 13 - state 13: #3 #4 - state 14: #1 #3 #4 + state 12: #3 + state 13: #0 #1 #3 + <var> state 14 + state 14: #0 #1 #3 <var> state 15 - state 15: #1 #3 #4 - state 16: #2 #3 #4 - <var> state 17 - <app> state 20 - state 17: #3 #4 + state 15: #0 #1 #3 + <var> state 16 + state 16: #0 #1 #3 + state 17: #2 #3 <var> state 18 - state 18: #3 #4 - <var> state 19 - state 19: #3 #4 - state 20: #2 #3 #4 - <var> state 21 - : state 25 - state 21: #3 #4 - <var> state 22 - state 22: #3 #4 - <var> state 23 - state 23: #3 #4 - <var> state 24 - state 24: #3 #4 - state 25: #2 #3 #4 - <var> state 26 - state 26: #2 #3 #4 - <var> state 27 - state 27: #2 #3 #4 - <var> state 28 - state 28: #2 #3 #4 + state 18: #2 #3 +}; tack (x/*0:0101*/:xs/*0:011*/) ys/*0:1*/ = tack/*1*/ xs/*0:011*/ (x/*0:0101*/:ys/*0:1*/); tack [] ys/*0:1*/ = ys/*0:1*/ { + rule #0: tack (x:xs) ys = tack xs (x:ys) + rule #1: tack [] ys = ys + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; -catmap f/*0:01*/ xs/*0:1*/ = cat (map f/*0:01*/ xs/*0:1*/); +catmap f/*0:01*/ [] = []; +catmap f/*0:01*/ xs@(_/*0:101*/:_/*0:11*/) = cat (map f/*0:01*/ xs/*0:1*/); index [] _/*0:1*/ = -1; index (x/*0:0101*/:xs/*0:011*/) y/*0:1*/ = search/*0*/ 0 (x/*0:0101*/:xs/*0:011*/) with search _/*0:01*/ [] = -1; search n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = n/*0:01*/ if x/*0:101*/==y/*1:1*/; search n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = search/*1*/ (n/*0:01*/+1) xs/*0:11*/; search _/*0:01*/ xs/*0:1*/ = index xs/*0:1*/ y/*1:1*/ { rule #0: search _ [] = -1 @@ -774,309 +1245,545 @@ <var> state 4 state 4: #0 #1 } end; -zip xs/*0:01*/ ys/*0:1*/ = accum/*0*/ [] xs/*0:01*/ ys/*0:1*/ with accum us/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = accum/*1*/ ((x/*0:0101*/,y/*0:101*/):us/*0:001*/) xs/*0:011*/ ys/*0:11*/; accum us/*0:001*/ _/*0:01*/ _/*0:1*/ = reverse us/*0:001*/ { - rule #0: accum us (x:xs) (y:ys) = accum ((x,y):us) xs ys - rule #1: accum us _ _ = reverse us - state 0: #0 #1 +zip [] _/*0:1*/ = []; +zip _/*0:01*/ [] = []; +zip xs@(_/*0:0101*/:_/*0:011*/) ys@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:01*/ ys/*0:1*/ with tick us/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = tack/*1*/ ((x/*0:0101*/,y/*0:101*/):us/*0:001*/) (zip xs/*1:011*/ ys/*1:11*/&) if thunkp xs/*0:011*/||thunkp ys/*0:11*/; tick us/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = tick/*1*/ ((x/*0:0101*/,y/*0:101*/):us/*0:001*/) xs/*0:011*/ ys/*0:11*/; tick us/*0:001*/ [] _/*0:1*/ = tack/*1*/ us/*0:001*/ []; tick us/*0:001*/ _/*0:01*/ [] = tack/*1*/ us/*0:001*/ []; tick us/*0:001*/ xs/*0:01*/ ys/*0:1*/ = tack/*1*/ us/*0:001*/ (zip xs/*0:01*/ ys/*0:1*/) { + rule #0: tick us (x:xs) (y:ys) = tack ((x,y):us) (zip xs ys&) if thunkp xs||thunkp ys + rule #1: tick us (x:xs) (y:ys) = tick ((x,y):us) xs ys + rule #2: tick us [] _ = tack us [] + rule #3: tick us _ [] = tack us [] + rule #4: tick us xs ys = tack us (zip xs ys) + state 0: #0 #1 #2 #3 #4 <var> state 1 - state 1: #0 #1 + state 1: #0 #1 #2 #3 #4 <var> state 2 - <app> state 4 - state 2: #1 + <app> state 5 + [] state 31 + state 2: #3 #4 <var> state 3 - state 3: #1 - state 4: #0 #1 - <var> state 5 - <app> state 8 - state 5: #1 + [] state 4 + state 3: #4 + state 4: #3 #4 + state 5: #0 #1 #3 #4 <var> state 6 - state 6: #1 + <app> state 10 + state 6: #3 #4 <var> state 7 - state 7: #1 - state 8: #0 #1 - <var> state 9 - : state 13 - state 9: #1 - <var> state 10 - state 10: #1 + state 7: #3 #4 + <var> state 8 + [] state 9 + state 8: #4 + state 9: #3 #4 + state 10: #0 #1 #3 #4 <var> state 11 - state 11: #1 + : state 16 + state 11: #3 #4 <var> state 12 - state 12: #1 - state 13: #0 #1 + state 12: #3 #4 + <var> state 13 + state 13: #3 #4 <var> state 14 - state 14: #0 #1 - <var> state 15 - state 15: #0 #1 - <var> state 16 - <app> state 17 - state 16: #1 - state 17: #0 #1 + [] state 15 + state 14: #4 + state 15: #3 #4 + state 16: #0 #1 #3 #4 + <var> state 17 + state 17: #0 #1 #3 #4 <var> state 18 + state 18: #0 #1 #3 #4 + <var> state 19 <app> state 20 - state 18: #1 - <var> state 19 - state 19: #1 - state 20: #0 #1 + [] state 30 + state 19: #4 + state 20: #0 #1 #4 <var> state 21 - : state 24 - state 21: #1 + <app> state 23 + state 21: #4 <var> state 22 - state 22: #1 - <var> state 23 - state 23: #1 - state 24: #0 #1 + state 22: #4 + state 23: #0 #1 #4 + <var> state 24 + : state 27 + state 24: #4 <var> state 25 - state 25: #0 #1 + state 25: #4 <var> state 26 - state 26: #0 #1 + state 26: #4 + state 27: #0 #1 #4 + <var> state 28 + state 28: #0 #1 #4 + <var> state 29 + state 29: #0 #1 #4 + state 30: #3 #4 + state 31: #2 #3 #4 + <var> state 32 + [] state 33 + state 32: #2 #4 + state 33: #2 #3 #4 +}; tack (u/*0:0101*/:us/*0:011*/) vs/*0:1*/ = tack/*1*/ us/*0:011*/ (u/*0:0101*/:vs/*0:1*/); tack [] vs/*0:1*/ = vs/*0:1*/ { + rule #0: tack (u:us) vs = tack us (u:vs) + rule #1: tack [] vs = vs + state 0: #0 #1 + <app> state 1 + [] state 7 + state 1: #0 + <app> state 2 + state 2: #0 + : state 3 + state 3: #0 + <var> state 4 + state 4: #0 + <var> state 5 + state 5: #0 + <var> state 6 + state 6: #0 + state 7: #1 + <var> state 8 + state 8: #1 } end; -zip3 xs/*0:001*/ ys/*0:01*/ zs/*0:1*/ = accum/*0*/ [] xs/*0:001*/ ys/*0:01*/ zs/*0:1*/ with accum us/*0:0001*/ (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = accum/*1*/ ((x/*0:00101*/,y/*0:0101*/,z/*0:101*/):us/*0:0001*/) xs/*0:0011*/ ys/*0:011*/ zs/*0:11*/; accum us/*0:0001*/ _/*0:001*/ _/*0:01*/ _/*0:1*/ = reverse us/*0:0001*/ { - rule #0: accum us (x:xs) (y:ys) (z:zs) = accum ((x,y,z):us) xs ys zs - rule #1: accum us _ _ _ = reverse us - state 0: #0 #1 +zip3 [] _/*0:01*/ _/*0:1*/ = []; +zip3 _/*0:001*/ [] _/*0:1*/ = []; +zip3 _/*0:001*/ _/*0:01*/ [] = []; +zip3 xs@(_/*0:00101*/:_/*0:0011*/) ys@(_/*0:0101*/:_/*0:011*/) zs@(_/*0:101*/:_/*0:11*/) = tick/*0*/ [] xs/*0:001*/ ys/*0:01*/ zs/*0:1*/ with tick us/*0:0001*/ (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = tack/*1*/ ((x/*0:00101*/,y/*0:0101*/,z/*0:101*/):us/*0:0001*/) (zip3 xs/*1:0011*/ ys/*1:011*/ zs/*1:11*/&) if thunkp xs/*0:0011*/||thunkp ys/*0:011*/||thunkp zs/*0:11*/; tick us/*0:0001*/ (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = tick/*1*/ ((x/*0:00101*/,y/*0:0101*/,z/*0:101*/):us/*0:0001*/) xs/*0:0011*/ ys/*0:011*/ zs/*0:11*/; tick us/*0:0001*/ [] _/*0:01*/ _/*0:1*/ = tack/*1*/ us/*0:0001*/ []; tick us/*0:0001*/ _/*0:001*/ [] _/*0:1*/ = tack/*1*/ us/*0:0001*/ []; tick us/*0:0001*/ _/*0:001*/ _/*0:01*/ [] = tack/*1*/ us/*0:0001*/ []; tick us/*0:0001*/ xs/*0:001*/ ys/*0:01*/ zs/*0:1*/ = tack/*1*/ us/*0:0001*/ (zip3 xs/*0:001*/ ys/*0:01*/ zs/*0:1*/) { + rule #0: tick us (x:xs) (y:ys) (z:zs) = tack ((x,y,z):us) (zip3 xs ys zs&) if thunkp xs||thunkp ys||thunkp zs + rule #1: tick us (x:xs) (y:ys) (z:zs) = tick ((x,y,z):us) xs ys zs + rule #2: tick us [] _ _ = tack us [] + rule #3: tick us _ [] _ = tack us [] + rule #4: tick us _ _ [] = tack us [] + rule #5: tick us xs ys zs = tack us (zip3 xs ys zs) + state 0: #0 #1 #2 #3 #4 #5 <var> state 1 - state 1: #0 #1 + state 1: #0 #1 #2 #3 #4 #5 <var> state 2 - <app> state 5 - state 2: #1 + <app> state 9 + [] state 63 + state 2: #3 #4 #5 <var> st... [truncated message content] |
From: <ag...@us...> - 2008-09-03 04:48:26
|
Revision: 686 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=686&view=rev Author: agraef Date: 2008-09-03 04:48:36 +0000 (Wed, 03 Sep 2008) Log Message: ----------- Cosmetic changes. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 23:30:49 UTC (rev 685) +++ pure/trunk/runtime.cc 2008-09-03 04:48:36 UTC (rev 686) @@ -250,8 +250,11 @@ ret->env = 0; else { ret->env = new pure_expr*[clos->m]; - for (size_t i = 0; i < clos->m; i++) - ret->env[i] = pure_new_internal(clos->env[i]); + for (size_t i = 0; i < clos->m; i++) { + ret->env[i] = clos->env[i]; + assert(clos->env[i]->refc > 0); + clos->env[i]->refc++; + } } return ret; } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 23:30:40
|
Revision: 685 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=685&view=rev Author: agraef Date: 2008-09-01 23:30:49 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Bugfixes. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 16:31:02 UTC (rev 684) +++ pure/trunk/runtime.cc 2008-09-01 23:30:49 UTC (rev 685) @@ -1392,10 +1392,6 @@ size_t m = x->data.clos->m; uint32_t env = 0; assert(x->refc > 0); - // first push the function object on the shadow stack so that it's - // garbage-collected in case of an exception - resize_sstk(interp.sstk, interp.sstk_cap, interp.sstk_sz, m+2); - interp.sstk[interp.sstk_sz++] = x; // construct a stack frame for the function call if (m>0) { size_t sz = interp.sstk_sz; @@ -1435,8 +1431,6 @@ #if DEBUG>1 cerr << "pure_force: result " << x << " = " << ret << " -> " << (void*)ret << ", refc = " << ret->refc << endl; #endif - // pop the function object from the shadow stack - --interp.sstk_sz; // check whether the result is again a thunk, then we have to evaluate // that recursively if (ret->tag == 0 && ret->data.clos && ret->data.clos->n == 0) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 16:30:52
|
Revision: 684 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=684&view=rev Author: agraef Date: 2008-09-01 16:31:02 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Bugfixes. Modified Paths: -------------- pure/trunk/interpreter.cc Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-09-01 16:23:30 UTC (rev 683) +++ pure/trunk/interpreter.cc 2008-09-01 16:31:02 UTC (rev 684) @@ -3548,7 +3548,7 @@ for (size_t i = 0; i < n; i++) { Value *x = args[i]; // check for thunks which must be forced - { + if (argt[i] != ExprPtrTy) { #if 1 // do a quick check on the tag value Value *idx[2] = { Zero, Zero }; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 16:23:21
|
Revision: 683 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=683&view=rev Author: agraef Date: 2008-09-01 16:23:30 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Add thunkp predicate. Modified Paths: -------------- pure/trunk/lib/primitives.pure pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-09-01 16:09:44 UTC (rev 682) +++ pure/trunk/lib/primitives.pure 2008-09-01 16:23:30 UTC (rev 683) @@ -45,7 +45,8 @@ /* Predicates to check for function objects, global (unbound) variables, function applications, proper lists, list nodes and tuples. */ -extern bool funp(expr*), bool lambdap(expr*), bool varp(expr*); +extern bool funp(expr*), bool lambdap(expr*), bool thunkp(expr*); +extern bool varp(expr*); applp (_ _) = 1; applp _ = 0 otherwise; Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 16:09:44 UTC (rev 682) +++ pure/trunk/runtime.cc 2008-09-01 16:23:30 UTC (rev 683) @@ -2673,10 +2673,16 @@ extern "C" bool lambdap(const pure_expr *x) { - return (x->tag == 0 && x->data.clos); + return (x->tag == 0 && x->data.clos && x->data.clos->n > 0); } extern "C" +bool thunkp(const pure_expr *x) +{ + return (x->tag == 0 && x->data.clos && x->data.clos->n == 0); +} + +extern "C" bool varp(const pure_expr *x) { return (x->tag > 0 && !x->data.clos); Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-09-01 16:09:44 UTC (rev 682) +++ pure/trunk/runtime.h 2008-09-01 16:23:30 UTC (rev 683) @@ -552,10 +552,11 @@ bool same(pure_expr *x, pure_expr *y); /* Check whether an object is a named function (closure), an anonymous - function (lambda), or a global variable, respectively. */ + function (lambda or thunk), or a global variable, respectively. */ bool funp(const pure_expr *x); bool lambdap(const pure_expr *x); +bool thunkp(const pure_expr *x); bool varp(const pure_expr *x); /* Direct memory accesses. Use these with care. In particular, note that the This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 16:09:35
|
Revision: 682 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=682&view=rev Author: agraef Date: 2008-09-01 16:09:44 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Update documentation. Modified Paths: -------------- pure/trunk/pure.1.in Modified: pure/trunk/pure.1.in =================================================================== --- pure/trunk/pure.1.in 2008-09-01 15:12:23 UTC (rev 681) +++ pure/trunk/pure.1.in 2008-09-01 16:09:44 UTC (rev 682) @@ -291,9 +291,9 @@ first, i.e., using .I "call by value" semantics. Pure also has a few built-in special forms (most notably, -conditional expressions, the short-circuit logical connectives && and || and -the sequencing operator $$) which take some of their arguments unevaluated, -using +conditional expressions, the short-circuit logical connectives && and ||, the +sequencing operator $$, and the lazy evaluation operator &) which take some or +all of their arguments unevaluated, using .IR "call by name" . (User-defined special forms can be created with macros. More about that later.) @@ -491,8 +491,7 @@ .B and and .B or -instead of `&' and `|', because the latter is reserved as a special symbol in -rules, see RULE SYNTAX below. +instead of `&' and `|', which are used for other purposes in Pure. .PP .B Special forms. As already mentioned, some operators are actually implemented as special @@ -504,11 +503,12 @@ mode just like in C. Thus, e.g., x&&y immediately becomes false if x evaluates to false, without ever evaluating y. .PP -Another important special form is the sequencing operator $$, which evaluates -its left operand, immediately throws the result away and then goes on to -evaluate the right operand which gives the result of the entire -expression. This operator is useful to write imperative-style code such as the -following prompt/input interaction: +The +.I sequencing +operator $$ evaluates its left operand, immediately throws the result away and +then goes on to evaluate the right operand which gives the result of the +entire expression. This operator is useful to write imperative-style code such +as the following prompt/input interaction: .sp .nf > \fBusing\fP system; @@ -518,6 +518,40 @@ 21.0 .fi .PP +The & operator does +.IR "lazy evaluation" . +More precisely, it turns its operand into a kind of parameterless anonymous +closure, deferring its evaluation. These kinds of objects are commonly known +as +.I thunks +or +.IR futures . +When the value of a future is actually needed (during pattern-matching, or +when the value becomes an argument of a C call), it is evaluated automagically +and gets +.IR memoized , +i.e., the computed result replaces the thunk so that it only has to be +computed once. Futures are useful to implement all kinds of lazy data +structures in Pure, in particular: lazy lists a.k.a. +.IR streams . +A stream is simply a list with a thunked tail, which allows it to be +infinite. E.g.: +.sp +.nf +> ints n = n : ints (n+1) &; let nats = ints 1; +> nats; +1:<<thunk 0xb6033528>> +> take 10 nats; +[1,2,3,4,5,6,7,8,9,10] +> nats; +1:2:3:4:5:6:7:8:9:10:11:<<thunk 0xb5fb1a08>> +> nats!9999; +10000 +.fi +.sp +Note that the prelude defines & as a postfix operator which binds stronger +than any other operation except function application. +.PP .B Toplevel. At the toplevel, a Pure program basically consists of rewriting rules (which are used to define functions and macros), constant and variable definitions, This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 15:12:17
|
Revision: 681 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=681&view=rev Author: agraef Date: 2008-09-01 15:12:23 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Updated TODO file. Modified Paths: -------------- pure/trunk/TODO Modified: pure/trunk/TODO =================================================================== --- pure/trunk/TODO 2008-09-01 15:07:38 UTC (rev 680) +++ pure/trunk/TODO 2008-09-01 15:12:23 UTC (rev 681) @@ -5,9 +5,6 @@ While the interpreter is already useful as it is, there's still a lot of things that remain to be done. Most important items, in no particular order: -- Resolve any remaining issues on 64 bit systems. See the INSTALL file for - details. - - Symbolic (Pure-level) debugger, profiler. The necessary hooks are mostly there, we just need to add a few runtime calls in the generated code. @@ -41,9 +38,4 @@ - More aggressive optimizations (common subexpression elimination for "pure" a.k.a. side-effect-free function calls, etc.). -- Harvest Q for some of its other nice features: Streams and other "special - forms" performing automatic "thunking" and evaluation. Sentinels. (These - just need a hook in the expression data structure and a runtime support - function to install them.) Wadler views. (This might be more involved, as - it's not clear yet how these can be done without explicit Q'ish algebraic - type declarations). +- Support for Wadler views (or similar). This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 15:07:27
|
Revision: 680 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=680&view=rev Author: agraef Date: 2008-09-01 15:07:38 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Updated ChangeLog. Modified Paths: -------------- pure/trunk/ChangeLog Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-09-01 15:01:13 UTC (rev 679) +++ pure/trunk/ChangeLog 2008-09-01 15:07:38 UTC (rev 680) @@ -1,3 +1,12 @@ +2008-09-01 Albert Graef <Dr....@t-...> + + * interpreter.cc, runtime.cc, symtable.cc/h, lib/prelude.pure: + Added thunks (anonymous parameterless closures), represented using + the new postfix operator '&' (see prelude.pure). As usual, these + use "call by need", i.e., they will be evaluated (and the results + memoized) automatically when the value of a thunk is needed during + pattern-matching or when calling a C function. + 2008-08-31 Albert Graef <Dr....@t-...> * lib/primitives.pure: Added references (expression pointers). This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 15:01:03
|
Revision: 679 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=679&view=rev Author: agraef Date: 2008-09-01 15:01:13 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Automatic forcing of thunks in pattern matching, syntactic identity checks and C calls. Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-09-01 14:37:04 UTC (rev 678) +++ pure/trunk/interpreter.cc 2008-09-01 15:01:13 UTC (rev 679) @@ -220,6 +220,8 @@ "void*", "void*", "int"); declare_extern((void*)pure_call, "pure_call", "expr*", 1, "expr*"); + declare_extern((void*)pure_force, + "pure_force", "expr*", 1, "expr*"); declare_extern((void*)pure_const, "pure_const", "expr*", 1, "int"); declare_extern((void*)pure_int, @@ -3545,6 +3547,26 @@ bool temps = false; for (size_t i = 0; i < n; i++) { Value *x = args[i]; + // check for thunks which must be forced + { +#if 1 + // do a quick check on the tag value + Value *idx[2] = { Zero, Zero }; + Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag"); + Value *checkv = b.CreateICmpEQ(tagv, Zero, "check"); + BasicBlock *forcebb = BasicBlock::Create("force"); + BasicBlock *skipbb = BasicBlock::Create("skip"); + b.CreateCondBr(checkv, forcebb, skipbb); + f->getBasicBlockList().push_back(forcebb); + b.SetInsertPoint(forcebb); + b.CreateCall(module->getFunction("pure_force"), x); + b.CreateBr(skipbb); + f->getBasicBlockList().push_back(skipbb); + b.SetInsertPoint(skipbb); +#else + b.CreateCall(module->getFunction("pure_force"), x); +#endif + } if (argt[i] == Type::Int1Ty) { BasicBlock *okbb = BasicBlock::Create("ok"); Value *idx[2] = { Zero, Zero }; @@ -5815,6 +5837,25 @@ msg << "simple match " << f.name; debug(msg.str().c_str()); } #endif + if (t.tag != EXPR::VAR || t.ttag != 0) { + // check for thunks which must be forced +#if 1 + // do a quick check on the tag value + Value *tagv = f.CreateLoadGEP(x, Zero, Zero, "tag"); + Value *checkv = f.builder.CreateICmpEQ(tagv, Zero, "check"); + BasicBlock *forcebb = BasicBlock::Create("force"); + BasicBlock *skipbb = BasicBlock::Create("skip"); + f.builder.CreateCondBr(checkv, forcebb, skipbb); + f.f->getBasicBlockList().push_back(forcebb); + f.builder.SetInsertPoint(forcebb); + call("pure_force", x); + f.builder.CreateBr(skipbb); + f.f->getBasicBlockList().push_back(skipbb); + f.builder.SetInsertPoint(skipbb); +#else + call("pure_force", x); +#endif + } // match the current symbol switch (t.tag) { case EXPR::VAR: @@ -6036,7 +6077,31 @@ // first check for a literal match size_t i, n = s->tr.size(), m = 0; transl::iterator t0 = s->tr.begin(); - while (t0 != s->tr.end() && t0->tag == EXPR::VAR) t0++, m++; + bool must_force = false; + while (t0 != s->tr.end() && t0->tag == EXPR::VAR) { + if (t0->ttag != 0) must_force = true; + t0++; m++; + } + must_force = must_force || t0 != s->tr.end(); + if (must_force) { + // check for thunks which must be forced +#if 1 + // do a quick check on the tag value + Value *tagv = f.CreateLoadGEP(x, Zero, Zero, "tag"); + Value *checkv = f.builder.CreateICmpEQ(tagv, Zero, "check"); + BasicBlock *forcebb = BasicBlock::Create("force"); + BasicBlock *skipbb = BasicBlock::Create("skip"); + f.builder.CreateCondBr(checkv, forcebb, skipbb); + f.f->getBasicBlockList().push_back(forcebb); + f.builder.SetInsertPoint(forcebb); + call("pure_force", x); + f.builder.CreateBr(skipbb); + f.f->getBasicBlockList().push_back(skipbb); + f.builder.SetInsertPoint(skipbb); +#else + call("pure_force", x); +#endif + } if (t0 != s->tr.end()) { assert(n > m); // get the tag value Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 14:37:04 UTC (rev 678) +++ pure/trunk/runtime.cc 2008-09-01 15:01:13 UTC (rev 679) @@ -2619,12 +2619,16 @@ } extern "C" -bool same(const pure_expr *x, const pure_expr *y) +bool same(pure_expr *x, pure_expr *y) { char test; if (x == y) return 1; - else if (x->tag != y->tag) + if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) + pure_force(x); + if (y->tag == 0 && y->data.clos && y->data.clos->n == 0) + pure_force(y); + if (x->tag != y->tag) return 0; else if (x->tag >= 0 && y->tag >= 0) if (x->data.clos && y->data.clos) Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-09-01 14:37:04 UTC (rev 678) +++ pure/trunk/runtime.h 2008-09-01 15:01:13 UTC (rev 679) @@ -549,7 +549,7 @@ /* Check whether two objects are the "same" (syntactically). */ -bool same(const pure_expr *x, const pure_expr *y); +bool same(pure_expr *x, pure_expr *y); /* Check whether an object is a named function (closure), an anonymous function (lambda), or a global variable, respectively. */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 14:36:55
|
Revision: 678 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=678&view=rev Author: agraef Date: 2008-09-01 14:37:04 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Add an assertion. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 13:31:10 UTC (rev 677) +++ pure/trunk/runtime.cc 2008-09-01 14:37:04 UTC (rev 678) @@ -1385,6 +1385,7 @@ assert(x); if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) { // parameterless anonymous closure (thunk) + assert(x->data.clos->thunked); pure_expr *ret; interpreter& interp = *interpreter::g_interp; void *fp = x->data.clos->fp; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 13:31:00
|
Revision: 677 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=677&view=rev Author: agraef Date: 2008-09-01 13:31:10 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Bugfixes. Modified Paths: -------------- pure/trunk/printer.cc pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/printer.cc =================================================================== --- pure/trunk/printer.cc 2008-09-01 07:00:29 UTC (rev 676) +++ pure/trunk/printer.cc 2008-09-01 13:31:10 UTC (rev 677) @@ -758,8 +758,6 @@ return os << pure_paren(95, u) << " " << pure_paren(100, v); } default: { - if (x->data.clos && x->data.clos->xp) - return os << x->data.clos->xp; if (x->tag == 0) { const char *s = (x->data.clos && x->data.clos->n==0)?"thunk":"closure"; return os << "<<" << s << " " << (void*)x << ">>"; Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 07:00:29 UTC (rev 676) +++ pure/trunk/runtime.cc 2008-09-01 13:31:10 UTC (rev 677) @@ -235,6 +235,27 @@ delete x->data.clos; } +static pure_closure *pure_copy_clos(pure_closure *clos) +{ + assert(clos); + pure_closure *ret = new pure_closure; + ret->local = clos->local; + ret->thunked = clos->thunked; + ret->n = clos->n; + ret->m = clos->m; + ret->fp = clos->fp; + ret->ep = clos->ep; + if (clos->ep) ((Env*)clos->ep)->refc++; + if (clos->m == 0) + ret->env = 0; + else { + ret->env = new pure_expr*[clos->m]; + for (size_t i = 0; i < clos->m; i++) + ret->env[i] = pure_new_internal(clos->env[i]); + } + return ret; +} + #if 1 /* This is implemented (mostly) non-recursively to prevent stack overflows, @@ -1196,7 +1217,6 @@ x->data.clos->m = m; x->data.clos->fp = f; x->data.clos->ep = e; - x->data.clos->xp = 0; if (e) ((Env*)e)->refc++; if (m == 0) x->data.clos->env = 0; @@ -1365,7 +1385,6 @@ assert(x); if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) { // parameterless anonymous closure (thunk) - if (x->data.clos->xp) return x->data.clos->xp; // memoized value pure_expr *ret; interpreter& interp = *interpreter::g_interp; void *fp = x->data.clos->fp; @@ -1417,9 +1436,32 @@ #endif // pop the function object from the shadow stack --interp.sstk_sz; + // check whether the result is again a thunk, then we have to evaluate + // that recursively + if (ret->tag == 0 && ret->data.clos && ret->data.clos->n == 0) + ret = pure_force(pure_new_internal(ret)); // memoize the result - x->data.clos->xp = pure_new_internal(ret); - return ret; + assert(x!=ret); + pure_free_clos(x); + x->tag = ret->tag; + x->data = ret->data; + switch (x->tag) { + case EXPR::APP: + pure_new_internal(x->data.x[0]); + pure_new_internal(x->data.x[1]); + case EXPR::PTR: + if (x->data.x[2]) pure_new_internal(x->data.x[2]); + break; + case EXPR::STR: + x->data.s = strdup(x->data.s); + break; + default: + if (x->tag >= 0 && x->data.clos) + x->data.clos = pure_copy_clos(x->data.clos); + break; + } + pure_freenew(ret); + return x; } else { #if DEBUG>2 if (x->tag >= 0 && x->data.clos) Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-09-01 07:00:29 UTC (rev 676) +++ pure/trunk/runtime.h 2008-09-01 13:31:10 UTC (rev 677) @@ -26,7 +26,6 @@ void *ep; // pointer to compile time environment (Env*) uint32_t n, m; // number of arguments and environment size struct _pure_expr **env; // captured environment (if m>0, 0 otherwise) - struct _pure_expr *xp; // pointer to memoized result bool local; // local function? bool thunked; // thunked closure? (kept unevaluated) } pure_closure; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 07:00:22
|
Revision: 676 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=676&view=rev Author: agraef Date: 2008-09-01 07:00:29 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Bugfixes. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-09-01 00:53:42 UTC (rev 675) +++ pure/trunk/runtime.cc 2008-09-01 07:00:29 UTC (rev 676) @@ -1344,6 +1344,20 @@ } } +static inline void resize_sstk(pure_expr**& sstk, size_t& cap, + size_t sz, size_t n) +{ + size_t newsz = sz+n; + if (newsz > cap) { + while (newsz > cap) { + assert((cap << 1) > cap); + cap = cap << 1; + } + sstk = (pure_expr**)realloc(sstk, cap*sizeof(pure_expr*)); + assert(sstk); + } +} + extern "C" pure_expr *pure_force(pure_expr *x) { @@ -1352,14 +1366,57 @@ if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) { // parameterless anonymous closure (thunk) if (x->data.clos->xp) return x->data.clos->xp; // memoized value + pure_expr *ret; + interpreter& interp = *interpreter::g_interp; void *fp = x->data.clos->fp; + size_t m = x->data.clos->m; + uint32_t env = 0; + assert(x->refc > 0); + // first push the function object on the shadow stack so that it's + // garbage-collected in case of an exception + resize_sstk(interp.sstk, interp.sstk_cap, interp.sstk_sz, m+2); + interp.sstk[interp.sstk_sz++] = x; + // construct a stack frame for the function call + if (m>0) { + size_t sz = interp.sstk_sz; + resize_sstk(interp.sstk, interp.sstk_cap, sz, m+1); + pure_expr **sstk = interp.sstk; + env = sz+1; + sstk[sz++] = 0; + for (size_t j = 0; j < m; j++) { + sstk[sz++] = x->data.clos->env[j]; + assert(x->data.clos->env[j]->refc > 0); + x->data.clos->env[j]->refc++; + } +#if SSTK_DEBUG + cerr << "++ stack: (sz = " << sz << ")\n"; + for (size_t i = 0; i < sz; i++) { + pure_expr *x = sstk[i]; + if (i == interp.sstk_sz) cerr << "** pushed:\n"; + if (x) + cerr << i << ": " << (void*)x << ": " << x << endl; + else + cerr << i << ": " << "** frame **\n"; + } +#endif + interp.sstk_sz = sz; + } #if DEBUG>1 cerr << "pure_force: calling " << x << " -> " << fp << endl; + for (size_t j = 0; j < m; j++) + cerr << "env#" << j << " = " << x->data.clos->env[j] << " -> " << (void*)x->data.clos->env[j] << ", refc = " << x->data.clos->env[j]->refc << endl; #endif - assert(x->refc > 0); // parameterless call checkall(test); - pure_expr *ret = ((pure_expr*(*)())fp)(); + if (m>0) + ret = ((pure_expr*(*)(uint32_t))fp)(env); + else + ret = ((pure_expr*(*)())fp)(); +#if DEBUG>1 + cerr << "pure_force: result " << x << " = " << ret << " -> " << (void*)ret << ", refc = " << ret->refc << endl; +#endif + // pop the function object from the shadow stack + --interp.sstk_sz; // memoize the result x->data.clos->xp = pure_new_internal(ret); return ret; @@ -1375,20 +1432,6 @@ } } -static inline void resize_sstk(pure_expr**& sstk, size_t& cap, - size_t sz, size_t n) -{ - size_t newsz = sz+n; - if (newsz > cap) { - while (newsz > cap) { - assert((cap << 1) > cap); - cap = cap << 1; - } - sstk = (pure_expr**)realloc(sstk, cap*sizeof(pure_expr*)); - assert(sstk); - } -} - extern "C" pure_expr *pure_apply(pure_expr *x, pure_expr *y) { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-09-01 00:53:38
|
Revision: 675 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=675&view=rev Author: agraef Date: 2008-09-01 00:53:42 +0000 (Mon, 01 Sep 2008) Log Message: ----------- Add basic support for suspended expressions (thunks). Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/lib/prelude.pure pure/trunk/lib/primitives.pure pure/trunk/printer.cc pure/trunk/runtime.cc pure/trunk/runtime.h pure/trunk/symtable.cc pure/trunk/symtable.hh Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/interpreter.cc 2008-09-01 00:53:42 UTC (rev 675) @@ -1707,8 +1707,13 @@ return x; // application: case EXPR::APP: - if (x.xval1().tag() == EXPR::APP && - x.xval1().xval1().tag() == symtab.catch_sym().f) { + if (x.xval1().tag() == symtab.amp_sym().f) { + if (++idx == 0) + throw err("error in expression (too many nested closures)"); + expr v = subst(vars, x.xval2(), idx); + return expr(symtab.amp_sym().x, v); + } else if (x.xval1().tag() == EXPR::APP && + x.xval1().xval1().tag() == symtab.catch_sym().f) { expr u = subst(vars, x.xval1().xval2(), idx); if (++idx == 0) throw err("error in expression (too many nested closures)"); @@ -1812,8 +1817,13 @@ return x; // application: case EXPR::APP: - if (x.xval1().tag() == EXPR::APP && - x.xval1().xval1().tag() == symtab.catch_sym().f) { + if (x.xval1().tag() == symtab.amp_sym().f) { + if (++idx == 0) + throw err("error in expression (too many nested closures)"); + expr v = fsubst(funs, x.xval2(), idx); + return expr(symtab.amp_sym().x, v); + } else if (x.xval1().tag() == EXPR::APP && + x.xval1().xval1().tag() == symtab.catch_sym().f) { expr u = fsubst(funs, x.xval1().xval2(), idx); if (++idx == 0) throw err("error in expression (too many nested closures)"); @@ -1909,8 +1919,11 @@ return x; // application: case EXPR::APP: - if (x.xval1().tag() == EXPR::APP && - x.xval1().xval1().tag() == symtab.catch_sym().f) { + if (x.xval1().tag() == symtab.amp_sym().f) { + expr v = csubst(x.xval2()); + return expr(symtab.amp_sym().x, v); + } else if (x.xval1().tag() == EXPR::APP && + x.xval1().xval1().tag() == symtab.catch_sym().f) { expr u = csubst(x.xval1().xval2()), v = csubst(x.xval2()); return expr(symtab.catch_sym().x, u, v); @@ -2203,8 +2216,13 @@ return y; // application: case EXPR::APP: - if (y.xval1().tag() == EXPR::APP && - y.xval1().xval1().tag() == symtab.catch_sym().f) { + if (y.xval1().tag() == symtab.amp_sym().f) { + if (++idx == 0) + throw err("error in expression (too many nested closures)"); + expr v = macred(x, y.xval2(), idx); + return expr(symtab.amp_sym().x, v); + } else if (y.xval1().tag() == EXPR::APP && + y.xval1().xval1().tag() == symtab.catch_sym().f) { expr u = macred(x, y.xval1().xval2(), idx); if (++idx == 0) throw err("error in expression (too many nested closures)"); @@ -3005,7 +3023,14 @@ case EXPR::APP: { expr f; uint32_t n = count_args(x, f); interpreter& interp = *interpreter::g_interp; - if (n == 2 && f.tag() == interp.symtab.catch_sym().f) { + if (n == 1 && f.tag() == interp.symtab.amp_sym().f) { + expr y = x.xval2(); + push("&"); + Env* eptr = fmap.act()[-x.hash()] = new Env(0, 0, y, true, true); + Env& e = *eptr; + e.build_map(y); e.promote_map(); + pop(); + } else if (n == 2 && f.tag() == interp.symtab.catch_sym().f) { expr h = x.xval1().xval2(), y = x.xval2(); push("catch"); Env* eptr = fmap.act()[-x.hash()] = new Env(0, 0, y, true, true); @@ -4778,6 +4803,19 @@ Value *u = codegen(x.xval1().xval2()); act_builder().CreateCall(module->getFunction("pure_freenew"), u); return codegen(x.xval2()); + } else if (n == 1 && f.tag() == symtab.amp_sym().f) { + // create a thunk (parameterless anonymous closure) + expr y = x.xval2(); + Env& act = act_env(); + assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end()); + Env& e = *act.fmap.act()[-x.hash()]; + push("&", &e); + fun_prolog("anonymous"); + e.CreateRet(codegen(y)); + fun_finish(); + pop(&e); + Value *body = fbox(e); + return body; } else if (n == 2 && f.tag() == symtab.catch_sym().f) { // catch an exception; create a little anonymous closure to be called // through pure_catch() Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/lib/prelude.pure 2008-09-01 00:53:42 UTC (rev 675) @@ -46,24 +46,25 @@ /* Operators. Note that the parser will automagically give unary minus the same precedence level as the corresponding binary operator. */ -infixl 0 $$ ; // sequence operator -infixr 0 $ ; // right-associative application -infixr 1 , ; // pair (tuple) -infix 2 => ; // mapsto constructor -infixr 2 || ; // logical or (short-circuit) -infixr 3 && ; // logical and (short-circuit) -prefix 3 not ; // logical negation -infix 4 < > <= >= == != ; // relations -infix 4 === !== ; // syntactic equality -infixr 4 : ; // list cons -infixl 5 << >> ; // bit shifts -infixl 6 + - or ; // addition, bitwise or -infixl 7 * / div mod and ; // multiplication, bitwise and -prefix 7 ~ ; // bitwise not -infixr 8 ^ ; // exponentiation -prefix 8 # ; // size operator -infixl 9 ! !! ; // indexing, slicing -infixr 9 . ; // function composition +infixl 0 $$ ; // sequence operator +infixr 0 $ ; // right-associative application +infixr 1 , ; // pair (tuple) +infix 2 => ; // mapsto constructor +infixr 2 || ; // logical or (short-circuit) +infixr 3 && ; // logical and (short-circuit) +prefix 3 not ; // logical negation +infix 4 < > <= >= == != ; // relations +infix 4 === !== ; // syntactic equality +infixr 4 : ; // list cons +infixl 5 << >> ; // bit shifts +infixl 6 + - or ; // addition, bitwise or +infixl 7 * / div mod and ; // multiplication, bitwise and +prefix 7 ~ ; // bitwise not +infixr 8 ^ ; // exponentiation +prefix 8 # ; // size operator +infixl 9 ! !! ; // indexing, slicing +infixr 9 . ; // function composition +postfix 9 & ; // thunk /* The truth values. These are just integers in Pure, but sometimes it's convenient to refer to them using these symbolic constants. */ Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/lib/primitives.pure 2008-09-01 00:53:42 UTC (rev 675) @@ -23,6 +23,11 @@ extern void pure_throw(expr*) = throw; // IMPURE! +/* Force a thunk (x&). This usually happens automagically when the value of a + thunk is needed. */ + +extern expr* pure_force(expr*) = force; + /* Syntactic equality. */ extern bool same(expr* x, expr* y); Modified: pure/trunk/printer.cc =================================================================== --- pure/trunk/printer.cc 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/printer.cc 2008-09-01 00:53:42 UTC (rev 675) @@ -758,8 +758,12 @@ return os << pure_paren(95, u) << " " << pure_paren(100, v); } default: { - if (x->tag == 0) - return os << "<<closure " << (void*)x << ">>"; + if (x->data.clos && x->data.clos->xp) + return os << x->data.clos->xp; + if (x->tag == 0) { + const char *s = (x->data.clos && x->data.clos->n==0)?"thunk":"closure"; + return os << "<<" << s << " " << (void*)x << ">>"; + } const symbol& sym = interpreter::g_interp->symtab.sym(x->tag); if (x->data.clos && x->data.clos->local) return os << "<<closure " << sym.s << ">>"; Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/runtime.cc 2008-09-01 00:53:42 UTC (rev 675) @@ -1196,6 +1196,7 @@ x->data.clos->m = m; x->data.clos->fp = f; x->data.clos->ep = e; + x->data.clos->xp = 0; if (e) ((Env*)e)->refc++; if (m == 0) x->data.clos->env = 0; @@ -1322,12 +1323,12 @@ { char test; assert(x); - if (x->tag >= 0 && x->data.clos && x->data.clos->n == 0) { + if (x->tag > 0 && x->data.clos && x->data.clos->n == 0) { void *fp = x->data.clos->fp; #if DEBUG>1 cerr << "pure_call: calling " << x << " -> " << fp << endl; #endif - assert(x->tag > 0 && x->refc > 0 && !x->data.clos->local); + assert(x->refc > 0 && !x->data.clos->local); // parameterless call checkall(test); return ((pure_expr*(*)())fp)(); @@ -1343,6 +1344,37 @@ } } +extern "C" +pure_expr *pure_force(pure_expr *x) +{ + char test; + assert(x); + if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) { + // parameterless anonymous closure (thunk) + if (x->data.clos->xp) return x->data.clos->xp; // memoized value + void *fp = x->data.clos->fp; +#if DEBUG>1 + cerr << "pure_force: calling " << x << " -> " << fp << endl; +#endif + assert(x->refc > 0); + // parameterless call + checkall(test); + pure_expr *ret = ((pure_expr*(*)())fp)(); + // memoize the result + x->data.clos->xp = pure_new_internal(ret); + return ret; + } else { +#if DEBUG>2 + if (x->tag >= 0 && x->data.clos) + cerr << "pure_force: returning " << x << " -> " << x->data.clos->fp + << " (" << x->data.clos->n << " args)" << endl; + else + cerr << "pure_force: returning " << x << endl; +#endif + return x; + } +} + static inline void resize_sstk(pure_expr**& sstk, size_t& cap, size_t sz, size_t n) { Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/runtime.h 2008-09-01 00:53:42 UTC (rev 675) @@ -26,6 +26,7 @@ void *ep; // pointer to compile time environment (Env*) uint32_t n, m; // number of arguments and environment size struct _pure_expr **env; // captured environment (if m>0, 0 otherwise) + struct _pure_expr *xp; // pointer to memoized result bool local; // local function? bool thunked; // thunked closure? (kept unevaluated) } pure_closure; @@ -353,6 +354,12 @@ pure_expr *pure_call(pure_expr *x); pure_expr *pure_apply(pure_expr *x, pure_expr *y); +/* This is like pure_call above, but only executes anonymous parameterless + closures (thunks), and returns the result in that case (which is then + memoized). */ + +pure_expr *pure_force(pure_expr *x); + /* Exception handling stuff. */ typedef struct { jmp_buf jmp; pure_expr* e; size_t sz; } pure_exception; Modified: pure/trunk/symtable.cc =================================================================== --- pure/trunk/symtable.cc 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/symtable.cc 2008-09-01 00:53:42 UTC (rev 675) @@ -40,6 +40,7 @@ failed_cond_sym(); signal_sym(); segfault_sym(); + amp_sym(); } symbol* symtable::lookup(const string& s, int32_t modno) @@ -358,3 +359,12 @@ else return sym("mod", 7, infixl); } + +symbol& symtable::amp_sym() +{ + symbol *_sym = lookup("&"); + if (_sym) + return *_sym; + else + return sym("&", 9, postfix); +} Modified: pure/trunk/symtable.hh =================================================================== --- pure/trunk/symtable.hh 2008-08-31 22:34:35 UTC (rev 674) +++ pure/trunk/symtable.hh 2008-09-01 00:53:42 UTC (rev 675) @@ -95,6 +95,7 @@ symbol& failed_cond_sym() { return sym("failed_cond"); } symbol& signal_sym() { return sym("signal"); } symbol& segfault_sym() { return sym("stack_fault"); } + symbol& amp_sym(); }; #endif // ! SYMTABLE_HH This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-08-31 22:34:28
|
Revision: 674 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=674&view=rev Author: agraef Date: 2008-08-31 22:34:35 +0000 (Sun, 31 Aug 2008) Log Message: ----------- Bugfixes in sentry code. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-08-31 00:19:52 UTC (rev 673) +++ pure/trunk/runtime.cc 2008-08-31 22:34:35 UTC (rev 674) @@ -133,19 +133,26 @@ return 0; } -static inline void free_sentry(pure_expr *x) +static inline void call_sentry(pure_expr *x) { if (x->tag == EXPR::APP || x->tag == EXPR::PTR) { pure_expr *s = x->data.x[2]; if (s) { ++x->refc; pure_freenew(pure_apply2(s, x)); - pure_free(s); --x->refc; } } } +static inline void free_sentry(pure_expr *x) +{ + if (x->tag == EXPR::APP || x->tag == EXPR::PTR) { + pure_expr *s = x->data.x[2]; + if (s) pure_free(s); + } +} + // Expression pointers are allocated in larger chunks for better performance. // NOTE: Only internal fields get initialized by new_expr(), the remaining // fields *must* be initialized as appropriate by the caller. @@ -242,7 +249,7 @@ pure_expr *xp = 0, *y; loop: if (--x->refc == 0) { - free_sentry(x); + call_sentry(x); switch (x->tag) { case EXPR::APP: y = x->data.x[0]; @@ -269,10 +276,16 @@ } } while (xp && x == xp->data.x[1]) { - if (x->refc == 0) free_expr(x); + if (x->refc == 0) { + free_sentry(x); + free_expr(x); + } x = xp; xp = x->xp; } - if (x->refc == 0) free_expr(x); + if (x->refc == 0) { + free_sentry(x); + free_expr(x); + } if (xp) { x = xp->data.x[1]; goto loop; @@ -288,7 +301,7 @@ void pure_free_internal(pure_expr *x) { if (--x->refc == 0) { - free_sentry(x); + call_sentry(x); switch (x->tag) { case EXPR::APP: pure_free_internal(x->data.x[0]); @@ -310,6 +323,7 @@ if (x->data.clos) pure_free_clos(x); break; } + free_sentry(x); free_expr(x); } } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-08-31 00:19:41
|
Revision: 673 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=673&view=rev Author: agraef Date: 2008-08-31 00:19:52 +0000 (Sun, 31 Aug 2008) Log Message: ----------- Added references (expression pointers). Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/lib/primitives.pure Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-08-31 00:16:06 UTC (rev 672) +++ pure/trunk/ChangeLog 2008-08-31 00:19:52 UTC (rev 673) @@ -1,3 +1,7 @@ +2008-08-31 Albert Graef <Dr....@t-...> + + * lib/primitives.pure: Added references (expression pointers). + 2008-08-29 Albert Graef <Dr....@t-...> * etc/gpure.lang: Added syntax highlighting for gedit. Contributed Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-08-31 00:16:06 UTC (rev 672) +++ pure/trunk/lib/primitives.pure 2008-08-31 00:19:52 UTC (rev 673) @@ -424,3 +424,38 @@ extern expr* pure_sentry(expr*,expr*) = sentry; // IMPURE! extern expr* pure_clear_sentry(expr*) = clear_sentry; // IMPURE! extern expr* pure_get_sentry(expr*) = get_sentry; + +/* Expression references. If you need these, then you're doomed. ;-) However, + they can be useful as a last resort when you need to keep track of some + local state or interface to the messy imperative world. Pure's references + are implemented as Pure expression pointers so that you can readily pass + them as pointers to a C function which expects a pure_expr** parameter. + This may even be useful at times. + + 'ref x' creates a reference pointing to x initially, 'put r x' sets a new + value (and returns it), 'get r' retrieves the current value, and 'unref r' + purges the referenced object and turns the reference into a dangling + pointer. (The latter is used as a sentry on reference objects and shouldn't + normally be called directly.) The refp predicate can be used to check for + reference values. Note that manually removing the unref sentry turns the + reference into just a normal pointer object and renders it unusable as a + reference. Doing this will also leak memory, so don't! */ + +private pure_new pure_free pure_expr_pointer; +private pointer_get_expr pointer_put_expr; +extern expr* pure_new(expr*), expr* pure_expr_pointer(); +extern void pure_free(expr*); +extern expr* pointer_get_expr(void*), void pointer_put_expr(void*, expr*); + +ref x = pointer_put_expr r (pure_new x) $$ + sentry unref r when r::pointer = pure_expr_pointer end; + +unref r::pointer = pure_free (pointer_get_expr r) $$ + clear_sentry r if refp r; + +put r::pointer x = pure_free (pointer_get_expr r) $$ + pointer_put_expr r (pure_new x) $$ x if refp r; + +get r::pointer = pointer_get_expr r if refp r; + +refp r = case r of _::pointer = get_sentry r===unref; _ = 0 end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-08-31 00:15:55
|
Revision: 672 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=672&view=rev Author: agraef Date: 2008-08-31 00:16:06 +0000 (Sun, 31 Aug 2008) Log Message: ----------- Add expression pointer operations. Modified Paths: -------------- pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-08-30 21:31:04 UTC (rev 671) +++ pure/trunk/runtime.cc 2008-08-31 00:16:06 UTC (rev 672) @@ -447,6 +447,17 @@ } extern "C" +pure_expr *pure_expr_pointer(void) +{ + pure_expr **p = (pure_expr**)malloc(sizeof(pure_expr*)); + if (p) { + *p = 0; + return pure_pointer(p); + } else + return 0; +} + +extern "C" pure_expr *pure_string_dup(const char *s) { if (!s) return pure_pointer(0); Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-08-30 21:31:04 UTC (rev 671) +++ pure/trunk/runtime.h 2008-08-31 00:16:06 UTC (rev 672) @@ -97,6 +97,12 @@ pure_expr *pure_double(double d); pure_expr *pure_pointer(void *p); +/* Expression pointers. The following routine returns a Pure pointer object + suitably allocated to hold a Pure expression (pure_expr*). The pointer is + initialized to hold a null expression. */ + +pure_expr *pure_expr_pointer(void); + /* String constructors. There are four variations of these, depending on whether the original string is already in utf-8 (_string routines) or in the system encoding (_cstring), and whether the string should be copied @@ -546,7 +552,9 @@ bool lambdap(const pure_expr *x); bool varp(const pure_expr *x); -/* Direct memory accesses. */ +/* Direct memory accesses. Use these with care. In particular, note that the + pointer_put_expr() routine doesn't do any reference counting by itself, so + you'll have to use the memory management routines above to do that. */ int32_t pointer_get_byte(void *ptr); int32_t pointer_get_int(void *ptr); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-08-30 21:30:54
|
Revision: 671 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=671&view=rev Author: agraef Date: 2008-08-30 21:31:04 +0000 (Sat, 30 Aug 2008) Log Message: ----------- Add size of long long type. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-08-30 20:58:44 UTC (rev 670) +++ pure/trunk/runtime.cc 2008-08-30 21:31:04 UTC (rev 671) @@ -3107,6 +3107,7 @@ cdf(interp, "SIZEOF_SHORT", pure_int(sizeof(short))); cdf(interp, "SIZEOF_INT", pure_int(sizeof(int))); cdf(interp, "SIZEOF_LONG", pure_int(sizeof(long))); + cdf(interp, "SIZEOF_LONG_LONG", pure_int(sizeof(long long))); cdf(interp, "SIZEOF_FLOAT", pure_int(sizeof(float))); cdf(interp, "SIZEOF_DOUBLE", pure_int(sizeof(double))); cdf(interp, "SIZEOF_COMPLEX_FLOAT", pure_int(sizeof(_Complex float))); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |