├── .exrc ├── .gitignore ├── INSTALL.adoc ├── LICENSE.adoc ├── Makefile ├── README.adoc ├── demos ├── .exrc ├── Makefile ├── README ├── environ.gd ├── http.gd ├── shuffle.gd └── time.gd ├── doc ├── .exrc ├── Makefile ├── build.adoc ├── diffs.adoc ├── gdstyle.css ├── intro.adoc ├── libdoc.gd ├── libdoc.hdr ├── libdoc.sh ├── ref.adoc └── stdlib.adoc ├── extensions ├── .exrc ├── hash.go ├── http.go └── zipr.go ├── go.mod ├── interp ├── .exrc ├── execute.go ├── interp.go ├── iutil.go ├── link.go ├── main.go ├── operator.go ├── options.go └── proc.go ├── ir ├── .exrc ├── load.go ├── prb.go ├── print.go └── structs.go ├── pre-commit.hook ├── release.sh ├── runtime ├── .exrc ├── calling.go ├── depends.go ├── envmt.go ├── exception.go ├── fchannel.go ├── ffile.go ├── flist.go ├── fmisc.go ├── fnumber.go ├── fnumlist.go ├── frecord.go ├── fset.go ├── fstring.go ├── fstrmap.go ├── ftable.go ├── import_test.go ├── interfaces.go ├── namespace.go ├── ochannel.go ├── ocore_test.go ├── oelem.go ├── ofile.go ├── olist.go ├── omisc.go ├── onumber.go ├── onumber_test.go ├── orecord.go ├── oset.go ├── ostring.go ├── ostring_test.go ├── otable.go ├── otype.go ├── run.go ├── stdlib.go ├── unicode_test.go ├── util.go ├── vchannel.go ├── vctor.go ├── vexternal.go ├── vfile.go ├── vlist.go ├── vmethval.go ├── vnil.go ├── vnumber.go ├── vproc.go ├── vrecord.go ├── vset.go ├── vstring.go ├── vtable.go ├── vtrapped.go └── vtype.go ├── tests ├── .exrc ├── Makefile ├── alltypes.gd ├── alltypes.std ├── argnames.gd ├── argnames.std ├── arith.gd ├── arith.std ├── assign.gd ├── assign.std ├── augment.gd ├── augment.std ├── catch.gd ├── catch.std ├── channel.gd ├── channel.std ├── closure1.gd ├── closure1.std ├── closure2.gd ├── closure2.std ├── control.gd ├── control.std ├── create.gd ├── create.std ├── ctor.gd ├── ctor.std ├── cxprimes.gd ├── cxprimes.std ├── dynamic.gd ├── dynamic.std ├── extends.gd ├── extends.std ├── genqueen.gd ├── genqueen.std ├── globinit.gd ├── globinit.std ├── hash32.gd ├── hash32.std ├── io.dat ├── io.gd ├── io.std ├── iorand.dat ├── iorand.gd ├── iorand.std ├── iovars.gd ├── iovars.std ├── labels.gd ├── labels.std ├── lambda.gd ├── lambda.std ├── lexcmp.gd ├── lexcmp.std ├── lists1.gd ├── lists1.std ├── lists2.gd ├── lists2.std ├── lists3.gd ├── lists3.std ├── lists4.gd ├── lists4.std ├── literals.gd ├── literals.std ├── meander.dat ├── meander.gd ├── meander.std ├── method.gd ├── method.std ├── misc.gd ├── misc.std ├── nspace.gd ├── nspace.std ├── nspack.gd ├── numforms.gd ├── numforms.std ├── numlib.gd ├── numlib.std ├── parconj.gd ├── parconj.std ├── primes.gd ├── primes.std ├── proto.gd ├── proto.std ├── queens.gd ├── queens.std ├── record.gd ├── record.std ├── regex.gd ├── regex.std ├── runerrs.gd ├── runerrs.std ├── runtest.sh ├── scoping.gd ├── scoping.std ├── select.gd ├── select.std ├── sets1.gd ├── sets1.std ├── sets2.gd ├── sets2.std ├── sieve.gd ├── sieve.std ├── simple.gd ├── simple.std ├── sort1.gd ├── sort1.std ├── sort2.gd ├── sort2.std ├── stdlib.gd ├── stdlib.std ├── string1.gd ├── string1.std ├── strlib.gd ├── strlib.std ├── structinit.gd ├── structinit.std ├── substring.gd ├── substring.std ├── tables1.gd ├── tables1.std ├── tables2.gd ├── tables2.std ├── tokenizer.dat ├── tokenizer.gd ├── tokenizer.std ├── traps.gd ├── traps.std ├── tuple.gd ├── tuple.std ├── unidents.gd ├── unidents.std ├── vars.gd ├── vars.std ├── wordcnt.dat ├── wordcnt.gd ├── wordcnt.std ├── yield.gd ├── yield.std ├── zipreader.dat ├── zipreader.gd └── zipreader.std ├── top.go └── tran ├── .exrc ├── Makefile ├── ast.gd ├── gen_json.gd ├── gengo.gd ├── gobytes.sh ├── ir.gd ├── irgen.gd ├── lex.gd ├── main.gd ├── optimize.gd ├── parse.gd └── stable-gtran /.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Files for Git to ignore 2 | .DS_Store 3 | *.tmp 4 | *.out 5 | *.err 6 | *.gia 7 | *.gir 8 | goaldi 9 | PROFILE 10 | README.html 11 | LICENSE.html 12 | INSTALL.html 13 | Goaldi-*-*.tgz 14 | tran/gtran0 15 | tran/gtran 16 | tran/gtran.go 17 | doc/stdlib.html 18 | -------------------------------------------------------------------------------- /INSTALL.adoc: -------------------------------------------------------------------------------- 1 | = Installing Goaldi 2 | 3 | A binary distribution of Goaldi consists of a single self-contained 4 | executable file named *goaldi* accompanied by a small number of text files 5 | including link:doc/intro.adoc[documentation]. 6 | 7 | To use the *goaldi* executable, 8 | just leave it in place and add its directory to your search path; 9 | or copy it to your own bin directory; 10 | or copy it somewhere else such as /usr/local. 11 | 12 | Run Goaldi with the command *goaldi sourcefile.gd*, 13 | optionally appending any arguments to be passed to the Goaldi program. 14 | 15 | To install Goaldi from source, see 16 | link:doc/build.adoc[Installation and Internals]. 17 | 18 | For further information about Goaldi, see the 19 | link:README.adoc[README] file and the 20 | link:doc/intro.adoc[documentation collection]. 21 | -------------------------------------------------------------------------------- /LICENSE.adoc: -------------------------------------------------------------------------------- 1 | = Goaldi Copyright Notice and Open-Source License 2 | 3 | Copyright 2015 Arizona Board of Regents; all rights reserved. 4 | 5 | This software is being provided by the copyright holders under the 6 | following license. By obtaining, using and/or copying this software, you 7 | agree that you have read, understood, and will comply with the following 8 | terms and conditions: 9 | 10 | Permission to use, copy, modify, and distribute this software and its 11 | documentation for any purpose and without fee or royalty is hereby granted, 12 | provided that the full text of this notice appears on all copies of the 13 | software and documentation or portions thereof, including modifications, 14 | that you make. 15 | 16 | This software is provided "as is," and copyright holders make no 17 | representations or warranties, express or implied. By way of example, but 18 | not limitation, copyright holders make no representations or warranties of 19 | merchantability or fitness for any particular purpose or that the use of the 20 | software or documentation will not infringe any third party patents, 21 | copyrights, trademarks or other rights. Copyright holders will bear no 22 | liability for any use of this software or documentation. 23 | 24 | The name and trademarks of copyright holders may not be used in advertising 25 | or publicity pertaining to the software without specific, written prior 26 | permission. Title to copyright in this software and any associated 27 | documentation will at all times remain with copyright holders. 28 | -------------------------------------------------------------------------------- /README.adoc: -------------------------------------------------------------------------------- 1 | = Goaldi: A Goal-Directed Programming Language 2 | 3 | Todd Proebsting and Gregg Townsend + 4 | Department of Computer Science + 5 | The University of Arizona 6 | 7 | Goaldi is a new general-purpose programming language that combines 8 | the goal-directed evaluation model of the 9 | http://www.cs.arizona.edu/icon[Icon] language 10 | with modern features such as concurrency, objects, closures, 11 | and Unicode support. 12 | While Goaldi will look familiar to Icon programmers, 13 | it is not upwards compatible. 14 | 15 | We're pleased with how Goaldi has turned out. 16 | At this time the implementation is reasonably stable and robust, 17 | and we're not actively developing it further. 18 | 19 | 20 | == Download 21 | The source code for Goaldi is maintained in a public repository on 22 | https://github.com/proebsting/goaldi[GitHub]. 23 | Goaldi should run on any Unix-based platform that supports 24 | http://golang.org/[Go]. 25 | 26 | We develop on Macintosh and Linux; pre-built binaries can be downloaded from the 27 | https://github.com/proebsting/goaldi/releases[releases page]. 28 | Just unpack the appropriate *.tgz* file and run the *goaldi* executable. 29 | 30 | 31 | == Documentation 32 | 33 | * link:doc/intro.adoc[Introduction] 34 | * link:doc/ref.adoc[Language Reference] 35 | * link:doc/stdlib.adoc[Library Reference] 36 | * link:doc/diffs.adoc[Goaldi for Icon Programmers] 37 | * link:doc/build.adoc[Installation and Internals] 38 | 39 | 40 | == Contact Us Directly 41 | Reach us by e-mail at goaldi@cs.arizona.edu. 42 | -------------------------------------------------------------------------------- /demos/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /demos/Makefile: -------------------------------------------------------------------------------- 1 | # demos/Makefile -- demo area Makefile 2 | # 3 | # The default action runs all the demos, 4 | # but inspecting and running them individually may be more useful. 5 | 6 | GOALDI = ../goaldi 7 | 8 | default: run 9 | 10 | # build and link without running (useful as an automated test) 11 | link: 12 | for F in *.gd; do (set -x; $(GOALDI) -l $$F); done 13 | 14 | # run all the demos (output is nondeterministic) 15 | run: 16 | for F in *.gd; do (set -x; $(GOALDI) $$F); done 17 | 18 | # clean up 19 | clean: 20 | # nothing to do 21 | -------------------------------------------------------------------------------- /demos/README: -------------------------------------------------------------------------------- 1 | goaldi/demos README 2 | 3 | This directory is for examples, especially those not suitable for 4 | joining the automated test suite. 5 | -------------------------------------------------------------------------------- /demos/environ.gd: -------------------------------------------------------------------------------- 1 | # A demo of external array usage. 2 | # Get the environment from Go, clobber a few random entries, and print it. 3 | 4 | procedure main() { 5 | local e := environ() 6 | write("Unix environment (", *e, " entries):") 7 | every local i := 11 to 100 by 13 do 8 | e[i] := "===============[REDACTED]===============" 9 | every !5 do 10 | ?e := "===============[STOMPED]===============" 11 | every i := 1 to *e do 12 | write(i, ". ", e[i]) 13 | } 14 | -------------------------------------------------------------------------------- /demos/http.gd: -------------------------------------------------------------------------------- 1 | # http.gd -- demonstrate HTTP extension 2 | 3 | procedure main(url1, url2) { 4 | /url1 := "http://www.cs.arizona.edu" 5 | /url2 := "http://httpbin.org/post" 6 | 7 | # url1 using htfile 8 | showfile(url1, htfile(url1)) 9 | 10 | # url1 using htget 11 | local r := htget(url1) 12 | if showfile(url1, *\r) then { 13 | write(repl("-", 72)) 14 | write("response: ", image(r)) 15 | local resp := r.Resp 16 | local hmap := resp.Header 17 | write(" status: ", resp.Status, " (", resp.StatusCode, ")") 18 | write(" proto: ", resp.Proto, 19 | " (",resp.ProtoMajor,".",resp.ProtoMinor,")") 20 | write(" ctlen: ", resp.ContentLength) 21 | write(" close: ", resp.Close) 22 | write(" encoding: ", image(resp.TransferEncoding)) 23 | write("headers:") 24 | every write(" ", !r) 25 | write("via lookup:") 26 | every local k := "Date" | "Content-Type" | "Credibility" do 27 | write(" ", k, ": ", hmap[k]) 28 | write("sorted:") 29 | every local kv := !hmap.sort() do 30 | write(" ", hmap.member(kv.key) | "?!?!", ": ", kv.value) 31 | write("cookies: ", image(resp.Cookies())) 32 | write("location: ", image(resp.Location())) 33 | every local m := 0 | 1 | 2 do 34 | write("protocol 1.", m, "? ", resp.ProtoAtLeast(1, m)) 35 | } else { 36 | showfile(url1, nil) 37 | } 38 | 39 | # url2 using htpost 40 | local p := htpost( 41 | url2, "crust", "thin", "top", "pepperoni", "top", "onions") 42 | showfile(url2, *\p | nil) 43 | } 44 | 45 | procedure showfile(u, f) { #: show contents of file (first n lines) 46 | write(repl("=",72), "\nURL: ", u) 47 | write("file: ", image(f)) 48 | if /f then return fail 49 | write(repl("-", 72)) 50 | every write(("" ~== !f) \ 10) 51 | write(" ...") 52 | f.close() 53 | return 54 | } 55 | -------------------------------------------------------------------------------- /demos/shuffle.gd: -------------------------------------------------------------------------------- 1 | # Randomness demo and test 2 | # 3 | # Repeatedly shuffles lists and counts the resulting permutations. 4 | # For each permutation, prints the actual count and the "variance" 5 | # (from the expected count) as a percentage. 6 | # 7 | # usage: shuffle maxlen avgcount 8 | # default: shuffle 4 2500 9 | # 10 | # The variance decreases with more iterations (the avgcount parameter). 11 | # (Try uncommenting the "badshuffle" call to see variance increase.) 12 | 13 | procedure main(maxlen, avgcount) { 14 | 15 | maxlen := number(maxlen) | 4 # maximum list size 16 | avgcount := number(avgcount) | 2500 # expected counts per permutation 17 | write("seed = ", randomize()) # use different sequence every run 18 | 19 | every ^size := !maxlen do { # repeat up to maximum length: 20 | 21 | ^nbins := factorial(size) # compute the number of permutations 22 | ^ntimes := nbins * avgcount # calculate necessary iterations 23 | ^t := table() 24 | every !ntimes do { # for every iteration: 25 | ^a := [: char(96+!size) :] # make a list of one-char strings 26 | a := a.shuffle() # shuffle it 27 | # a := badshuffle(a) 28 | ^s := "" 29 | every s ||:= !a # turn the list into a string 30 | /t[s] := 0 31 | t[s] +:= 1 # and count it in the table 32 | } 33 | write() 34 | every ^kv := !t.sort() do { # print results in sorted order 35 | ^var := 100 * abs(kv.value / avgcount - 1) 36 | printf("%6.0f %s %2.0f%%\n", kv.value, kv.key, var) 37 | } 38 | } 39 | } 40 | 41 | procedure factorial(n) { #: compute n factorial (n!) 42 | ^f := 1 43 | every f *:= !n # n.b. !n means "1 to n" not "n factorial" ! 44 | return f 45 | } 46 | 47 | procedure badshuffle(a) { #: a simple, biased shuffle; don't use this! 48 | a := copy(a) 49 | every !a :=: ?a 50 | return a 51 | } 52 | -------------------------------------------------------------------------------- /demos/time.gd: -------------------------------------------------------------------------------- 1 | # demonstrate process environment and time interfaces 2 | 3 | procedure main() { 4 | 5 | write() 6 | write("host: ", hostname()) 7 | write("getwd: ", getwd()) 8 | write("pid: ", getpid()) 9 | write("ppid: ", getppid()) 10 | 11 | write() 12 | write("date: ", date()) 13 | write("time: ", time()) 14 | local t := now() 15 | write("now: ", t) 16 | write("fmt: ", t.Format("Mon 2006-01-02 03:04:05 pm MST")) 17 | write("or: ", t.Format("Monday, January 2, 2006 at 03:04:05 pm")) 18 | write("or: ", image(t.Date()), " ", image(t.Clock())) 19 | 20 | local dt := 100000 21 | local du := duration(dt) 22 | write(dt, " seconds from now, it will be:") 23 | t := t.Add(du) 24 | write(t.Format("Monday, January 2, 2006 at 03:04:05 pm MST")) 25 | 26 | write() 27 | local tmid := 0.03 28 | local tmax := 2 29 | while tmid < tmax do { 30 | tmid *:= %phi 31 | while cputime() < tmid & cputime() < tmax do 32 | {} 33 | write("CPU: ", cputime()) 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /doc/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for Goaldi stdlib documentation 2 | 3 | GOALDI = ../goaldi 4 | 5 | default: stdlib.adoc 6 | 7 | show: stdlib.html 8 | open stdlib.html 9 | 10 | 11 | # extract stdlib procedure documentation. 12 | stdlib.adoc: libdoc.sh libdoc.hdr libdoc.gd .FORCE 13 | GOALDI=$(GOALDI) ./libdoc.sh >stdlib.tmp 14 | mv stdlib.tmp stdlib.adoc 15 | 16 | 17 | # make HTML documentation. 18 | stdlib.html: stdlib.adoc gdstyle.css 19 | asciidoctor -a stylesheet=gdstyle.css stdlib.adoc 20 | 21 | 22 | # clean up 23 | # 24 | # The build product libdoc.adoc is not removed because it gets checked in. 25 | clean: 26 | rm -f stdlib.tmp stdlib.html 27 | 28 | 29 | .FORCE: 30 | -------------------------------------------------------------------------------- /doc/gdstyle.css: -------------------------------------------------------------------------------- 1 | /* libdoc.css -- simple style sheet for stdlib documentation */ 2 | 3 | BODY { color: black; background: white; } 4 | BODY { margin-left: 50px; margin-right: 25px; } 5 | 6 | BODY, TH, TD { font-family: Helvetica, Arial, sans-serif; } 7 | EM,VAR,CITE,DFN { font-style: italic; } 8 | STRONG { font-weight: bold; } 9 | CODE { font-family: Helvetica, Arial, sans-serif; font-weight: bold;} 10 | PRE, TT { font-family: "Lucida Sans Typewriter", Monaco, monospace; } 11 | 12 | H1,H2,H3,H4,H5,H6 { font-family:Helvetica,Arial,sans-serif; font-weight:bold; } 13 | H1 { font-size: 150%; margin-top: 2.0em; margin-bottom: 0.4em; } 14 | H2 { font-size: 125%; margin-top: 2.0em; margin-bottom: 0.4em; } 15 | H3, H4, H5, H6 { font-size: 100%; margin-top: 1.5em; margin-bottom: 0.2em; } 16 | HR { margin-top: 2em; margin-bottom: 1em; } 17 | 18 | P { margin-top: 0.6em; margin-bottom: 0.0em; 19 | line-height: 120%; max-width: 50em; } 20 | BLOCKQUOTE { margin-top: 0.4em; margin-bottom: 0.4em; } 21 | UL, OL { margin-top: 0.4em; margin-bottom: 0.4em; } 22 | UL + UL { margin-top: 0.8em; } 23 | LI { margin-top: 0.2em; } 24 | 25 | TH, TD { padding-left: 0.4em; padding-right: 0.4em; } 26 | TH, TD { vertical-align: top; text-align: left; } 27 | TH { font-weight: normal; font-style: italic; } 28 | 29 | A:link { background: white; color: #06C; } 30 | A:visited { background: white; color: #036; } 31 | 32 | DT { font-weight:bold; margin-top: 2em; } 33 | DIV.content { font-size: 90%; background: #F2F9FF; padding: 4px 3em; } 34 | SPAN.small { font-size: 80%; } 35 | 36 | DIV#footer { display: none; } 37 | -------------------------------------------------------------------------------- /doc/libdoc.hdr: -------------------------------------------------------------------------------- 1 | Goaldi Standard Library 2 | ======================= 3 | 4 | Gregg Townsend and Todd Proebsting + 5 | Department of Computer Science + 6 | The University of Arizona + 7 | goaldi@cs.arizona.edu 8 | 9 | This is part of the documentation for 10 | https://github.com/proebsting/goaldi#goaldi-a-goal-directed-programming-language[The Goaldi Programming Language]. 11 | 12 | ''' 13 | 14 | This document lists the procedures and methods present in the 15 | Goaldi standard library. 16 | It was produced mechanically by extracting source code comments. 17 | 18 | For each entry, the header line gives the procedure and argument names 19 | followed by a one-line synopsis. 20 | A procedure with a suffix of *[]* in its argument list accepts 21 | an arbitrary number of arguments. 22 | A more detailed procedure description follows the header line. 23 | 24 | Some library procedures such as *printf*, *remove*, and *regex* 25 | are just springboards to underlying Go functions. 26 | These are indicated by a link on the header line to the Go function. 27 | Additional documentation of associated types and methods 28 | can be found by following the link. 29 | 30 | Extracted descriptions may refer to the Go function and parameter names 31 | rather than those of the intermediate Goaldi procedure. 32 | In general, if any of these Go functions returns an error, 33 | an exception is thrown. 34 | 35 | Methods are distinguished from procedures by an inital character and period, 36 | as in *L.put*(...). 37 | The initial character indicates the type of value 38 | to which the method applies: 39 | ==== 40 | *x* {nbsp} any value + 41 | *t* {nbsp} type value + 42 | *f* {nbsp} file value + 43 | *c* {nbsp} channel value + 44 | *L* {nbsp} list value + 45 | *S* {nbsp} set value + 46 | *T* {nbsp} table value + 47 | ==== 48 | 49 | -------------------------------------------------------------------------------- /doc/libdoc.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # libdoc.sh -- extract Goaldi library documentation 4 | # 5 | # This script uses "goaldi -l -E" to list the standard library contents, 6 | # runs "go doc" on each referenced package, then runs a Goaldi program 7 | # to produce the final output. 8 | # 9 | # Note that libdoc.gd has an "exclusion list" to suppress certain procedures 10 | # such as sample extensions. This list may need manual updating. 11 | 12 | GOALDI=${GOALDI-goaldi} 13 | 14 | TMP1=/tmp/libdoc.$$a 15 | TMP2=/tmp/libdoc.$$b 16 | trap 'rm -f $TMP1 $TMP2; exit' 0 1 2 15 17 | 18 | set -e # quit on error 19 | 20 | # get the Goaldi procedure listing 21 | $GOALDI -l -E /dev/null >$TMP1 22 | 23 | # extract a list of referenced packages 24 | PKGS=`$GOALDI -l -E /dev/null 2>/dev/null | 25 | sed -n '/ -- /s/.* \([a-zA-Z0-9/]*\)\.[^.]*$/\1/p' | 26 | sort | 27 | uniq` 28 | 29 | # get the documetation for those packages 30 | for P in goaldi/runtime $PKGS; do 31 | go doc -all $P >>$TMP2 32 | done 33 | 34 | # now process everything 35 | cat libdoc.hdr 36 | echo "'''" # hrule 37 | $GOALDI libdoc.gd $TMP1 $TMP2 38 | echo "" 39 | echo "'''" # hrule 40 | -------------------------------------------------------------------------------- /extensions/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /extensions/hash.go: -------------------------------------------------------------------------------- 1 | // hash.go -- hashing interface extension to Goaldi 2 | // 3 | // This straightforward extension adds 32-bit hashing functions to Goaldi. 4 | // 5 | // adler32(), crc32(), fnv32(), and fnv32a() each create a new hashing engine. 6 | // The returned value is a file, and data written to the file updates the 7 | // running checksum. 8 | // 9 | // Given one of these special files, 10 | // hashvalue(f) returns a numeric hash value of the data written so far. 11 | 12 | package extensions 13 | 14 | import ( 15 | g "github.com/proebsting/goaldi/runtime" 16 | "hash" 17 | "hash/adler32" 18 | "hash/crc32" 19 | "hash/fnv" 20 | ) 21 | 22 | // declare new procedures for use from Goaldi 23 | func init() { 24 | g.GoLib(adler32.New, "adler32", "", "create Adler-32 checksum engine") 25 | g.GoLib(crc32.NewIEEE, "crc32", "", "create IEEE CRC-32 checksum engine") 26 | g.GoLib(fnv.New32, "fnv32", "", "create 32-bit FNV-1 checksum engine") 27 | g.GoLib(fnv.New32a, "fnv32a", "", "create 32-bit FNV-1a checksum engine") 28 | g.GoLib(hashvalue, "hashvalue", "", "return accumulated checksum value") 29 | } 30 | 31 | // hashvalue(f) returns the current value of the hash engine f. 32 | func hashvalue(f hash.Hash32) uint32 { 33 | return f.Sum32() 34 | } 35 | -------------------------------------------------------------------------------- /extensions/zipr.go: -------------------------------------------------------------------------------- 1 | // zipr.go -- Zip file reader extension for Goaldi 2 | 3 | package extensions 4 | 5 | import ( 6 | "archive/zip" 7 | "github.com/proebsting/goaldi/runtime" 8 | ) 9 | 10 | func init() { 11 | runtime.GoLib(zip.OpenReader, "zipreader", "name", "open a Zip file") 12 | } 13 | -------------------------------------------------------------------------------- /go.mod: -------------------------------------------------------------------------------- 1 | module github.com/proebsting/goaldi 2 | 3 | go 1.16 4 | -------------------------------------------------------------------------------- /interp/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /interp/iutil.go: -------------------------------------------------------------------------------- 1 | // iutil.go -- interpreter utility routines 2 | 3 | package main 4 | 5 | import ( 6 | "fmt" 7 | "os" 8 | "runtime/pprof" 9 | "syscall" 10 | "time" 11 | ) 12 | 13 | // checkError aborts if error value e is not nil. 14 | func checkError(e error) { 15 | if e != nil { 16 | abort(e) 17 | } 18 | } 19 | 20 | // abort issues an error message and aborts. 21 | func abort(e interface{}) { 22 | fmt.Fprintln(os.Stderr, e) 23 | quit(1) 24 | } 25 | 26 | // quit exits with a given code after stopping profiling. 27 | func quit(xc int) { 28 | pprof.StopCPUProfile() 29 | os.Exit(xc) 30 | } 31 | 32 | // showInterval prints timing for the latest interval if opt_timings is set. 33 | func showInterval(label string) { 34 | dt := cpuInterval().Seconds() 35 | if label != "" && opt_timings { 36 | fmt.Fprintf(os.Stderr, "%7.3f %s\n", dt, label) 37 | } 38 | } 39 | 40 | // cpuInterval returns the CPU time (user + system) since the preceding call. 41 | func cpuInterval() time.Duration { 42 | total := cpuTime() 43 | delta := total - prevCPU 44 | prevCPU = total 45 | return delta 46 | } 47 | 48 | var prevCPU time.Duration // total time at list check 49 | 50 | // cpuTime returns the current CPU usage (user time + system time). 51 | func cpuTime() time.Duration { 52 | var ustruct syscall.Rusage 53 | checkError(syscall.Getrusage(0, &ustruct)) 54 | user := time.Duration(syscall.TimevalToNsec(ustruct.Utime)) 55 | sys := time.Duration(syscall.TimevalToNsec(ustruct.Stime)) 56 | return user + sys 57 | } 58 | -------------------------------------------------------------------------------- /interp/options.go: -------------------------------------------------------------------------------- 1 | // options.go -- declaration and processing of command line arguments 2 | // 3 | // NOTE: If the first command line argument is not "-x", then 4 | // no argument processing is done under the assumption that all 5 | // options and arguments will be passed to the embedded app. 6 | 7 | package main 8 | 9 | import ( 10 | "flag" 11 | "fmt" 12 | "os" 13 | "strings" 14 | ) 15 | 16 | // command-line options 17 | var opt_noexec bool // -l: load and link only; don't execute 18 | var opt_timings bool // -t: show CPU timings 19 | var opt_adump bool // -A: dump assembly-style IR code 20 | var opt_debug bool // -D: set debug flag (dump Go stack on panic) 21 | var opt_init bool // -I: trace initialization ordering 22 | var opt_envmt bool // -E: show initial environment before loading 23 | var opt_profile bool // -P: produce CPU profile on ./PROFILE 24 | var opt_trace bool // -T: trace IR instruction execution 25 | var opt_delete bool // -#: delete IR files after loading 26 | 27 | // usage prints a usage message (with option descriptions) and aborts. 28 | func usage() { 29 | fmt.Fprintf(os.Stderr, 30 | "Usage: %s -x [options] file.gir... [--] [arg...]]\n", os.Args[0]) 31 | flag.PrintDefaults() 32 | os.Exit(1) 33 | } 34 | 35 | // options sets global flags and returns file names and execution arguments. 36 | func options() (files []string, args []string) { 37 | 38 | // check for enabling magic flag 39 | // (if not set, return files=nil as an indicator) 40 | if len(os.Args) < 2 || os.Args[1] != "-x" { 41 | return nil, os.Args[1:] 42 | } 43 | 44 | flag.Bool("x", false, "process command line as described here") 45 | flag.BoolVar(&opt_noexec, "l", false, "load and link only") 46 | flag.BoolVar(&opt_timings, "t", false, "show CPU timings") 47 | flag.BoolVar(&opt_adump, "A", false, "dump assembly-style IR code") 48 | flag.BoolVar(&opt_debug, "D", false, "dump Go stack on panic") 49 | flag.BoolVar(&opt_init, "I", false, "trace initialization ordering") 50 | flag.BoolVar(&opt_envmt, "E", false, "show initial environment") 51 | flag.BoolVar(&opt_profile, "P", false, "produce ./PROFILE file (Linux)") 52 | flag.BoolVar(&opt_trace, "T", false, "trace IR instruction execution") 53 | flag.BoolVar(&opt_delete, "#", false, "delete IR files after loading") 54 | flag.Usage = usage 55 | flag.Parse() 56 | 57 | // get remaining (positional) command arguments 58 | args = flag.Args() 59 | if len(args) == 0 { // must have at least one 60 | usage() 61 | } 62 | files = append(files, args[0]) // first argument is always a file 63 | args = args[1:] 64 | 65 | // any immediately following args that end in ".gir" are also files to load 66 | for len(args) > 0 && strings.HasSuffix(args[0], ".gir") { 67 | files = append(files, args[0]) 68 | args = args[1:] 69 | } 70 | 71 | // a "--" argument is a separator to be removed 72 | if len(args) > 0 && args[0] == "--" { 73 | args = args[1:] 74 | } 75 | return files, args 76 | } 77 | -------------------------------------------------------------------------------- /ir/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /ir/print.go: -------------------------------------------------------------------------------- 1 | // print.go -- print human-readable dump of intermediate code 2 | 3 | package ir 4 | 5 | import ( 6 | "fmt" 7 | "strings" 8 | ) 9 | 10 | const indentBy = " " // increment for additional indentation labels 11 | 12 | // Print(label, tree) -- print a tree of IR structs on stdout 13 | func Print(label string, tree interface{}) { 14 | fmt.Printf("\n========== %s ==========\n", label) 15 | subprint("", tree) 16 | fmt.Println() 17 | } 18 | 19 | // subprint(indent, tree) -- print part of the IR tree 20 | func subprint(indent string, tree interface{}) { 21 | switch t := tree.(type) { 22 | case nil: 23 | return 24 | case []interface{}: 25 | for _, v := range t { 26 | subprint(indent, v) 27 | } 28 | case []Ir_chunk: 29 | for _, v := range t { 30 | subprint(indent, v) 31 | } 32 | case Ir_Function: 33 | iplus := indent + indentBy 34 | fmt.Printf("\n%sproc %s {%v} parent:%s start:%v\n", 35 | indent, t.Name, t.Coord, t.Parent, t.CodeStart) 36 | fmt.Printf("%sparam %v", iplus, t.ParamList) 37 | if t.Accumulate != "" { 38 | fmt.Printf(" [accumulate]") 39 | } 40 | fmt.Printf("\n%slocal %v\n", iplus, t.LocalList) 41 | fmt.Printf("%sstatic %v\n", iplus, t.StaticList) 42 | fmt.Printf("%sunbound %v\n", iplus, t.UnboundList) 43 | subprint(indent, t.CodeList) 44 | case Ir_chunk: 45 | fmt.Printf("%s%s:\n", indent, t.Label) 46 | subprint(indent+indentBy, t.InsnList) 47 | default: 48 | s := fmt.Sprintf("%T %v", tree, tree) 49 | if strings.HasPrefix(s, "ir.Ir_") { 50 | s = s[6:] 51 | } 52 | fmt.Printf("%s%s\n", indent, s) 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /pre-commit.hook: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # Copyright 2012 The Go Authors. All rights reserved. 3 | # Use of this source code is governed by a BSD-style 4 | # license that can be found in the LICENSE file. 5 | 6 | # git gofmt pre-commit hook 7 | # 8 | # To use, store as .git/hooks/pre-commit inside your repository and make sure 9 | # it has execute permissions. 10 | # 11 | # This script does not handle file names that contain spaces. 12 | 13 | gofiles=$(git diff --cached --name-only --diff-filter=ACM | grep '.go$') 14 | [ -z "$gofiles" ] && exit 0 15 | 16 | unformatted=$(gofmt -l $gofiles) 17 | [ -z "$unformatted" ] && exit 0 18 | 19 | # Some files are not gofmt'd. Print message and fail. 20 | 21 | echo >&2 "Go files must be formatted with gofmt. Please run:" 22 | for fn in $unformatted; do 23 | echo >&2 " gofmt -w $PWD/$fn" 24 | done 25 | 26 | exit 1 27 | -------------------------------------------------------------------------------- /release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Usage: release.sh version-label (e.g. release.sh v47) 4 | # 5 | # Makes a release package containing the currently built executable. 6 | # Before running this, run "make self" and "make accept". 7 | 8 | VERSION=${1?"Version number required"} 9 | 10 | U=`uname` 11 | case $U in 12 | Darwin) UNAME=Mac;; 13 | *) UNAME=$U;; 14 | esac 15 | VNAME="Goaldi-$UNAME-$VERSION" 16 | 17 | set -e 18 | rm -rf $VNAME $VNAME.tgz 19 | mkdir $VNAME 20 | cp README.adoc $VNAME 21 | cp LICENSE.adoc $VNAME 22 | cp INSTALL.adoc $VNAME 23 | mkdir $VNAME/doc 24 | cp doc/*.adoc $VNAME/doc/ 25 | cp goaldi $VNAME/goaldi 26 | ( 27 | file $VNAME/goaldi 28 | echo `date` /`whoami` 29 | uname -n -s -m 30 | ) >$VNAME/MANIFEST 31 | chmod 755 $VNAME $VNAME/[a-z]* 32 | chmod 644 $VNAME/[A-Z]* $VNAME/doc/* 33 | echo 34 | echo MANIFEST: 35 | cat $VNAME/MANIFEST 36 | tar cfz $VNAME.tgz $VNAME 37 | echo 38 | tar tvfz $VNAME.tgz 39 | rm -rf $VNAME 40 | echo 41 | chmod 644 $VNAME.tgz 42 | ls -l $VNAME.tgz 43 | -------------------------------------------------------------------------------- /runtime/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /runtime/envmt.go: -------------------------------------------------------------------------------- 1 | // envmt.go -- dynamic variables and procedure environment 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | "io" 8 | "os" 9 | ) 10 | 11 | // execution environment 12 | type Env struct { 13 | Parent *Env // parent environment 14 | ThreadID int // thread ID 15 | VarMap map[string]Value // dynamic variable table 16 | } 17 | 18 | // NewEnv(e) returns a new environment with parent e. 19 | func NewEnv(e *Env) *Env { 20 | enew := &Env{} 21 | enew.Parent = e 22 | if e == nil { 23 | enew.ThreadID = <-TID 24 | enew.VarMap = StdEnv 25 | } else { 26 | enew.ThreadID = e.ThreadID 27 | enew.VarMap = make(map[string]Value) 28 | } 29 | return enew 30 | } 31 | 32 | // Env.Lookup(s, rval) -- look up dynamic variable s in environment tree 33 | func (e *Env) Lookup(s string, rval bool) Value { 34 | for ; e != nil; e = e.Parent { 35 | if v := e.VarMap[s]; v != nil { 36 | d := Deref(v) // get underlying value 37 | if d == nil { // if not yet initialized 38 | if rval { 39 | panic(Malfunction("Uninitialized: %" + s)) 40 | } else { 41 | return v // return trapped variable for initial assignment 42 | } 43 | } 44 | return d // return value -- cannot be used as variable 45 | } 46 | } 47 | panic(NewExn("Undefined dynamic variable", "%"+s)) 48 | } 49 | 50 | // ThreadID production 51 | var TID = make(chan int) 52 | 53 | func init() { 54 | go func() { 55 | tid := 0 56 | for { 57 | tid++ 58 | TID <- tid 59 | } 60 | }() 61 | } 62 | 63 | // StdEnv is the initial environment 64 | var StdEnv = make(map[string]Value) 65 | 66 | // EnvInit registers a standard environment value or variable at init time. 67 | // (Variables should be registered as trapped values). 68 | func EnvInit(name string, v Value) { 69 | StdEnv[name] = v 70 | } 71 | 72 | // Initial dynamic variables 73 | func init() { 74 | 75 | // math constants 76 | EnvInit("e", E) 77 | EnvInit("phi", PHI) 78 | EnvInit("pi", PI) 79 | 80 | // standard files 81 | EnvInit("stdin", STDIN) 82 | EnvInit("stdout", STDOUT) 83 | EnvInit("stderr", STDERR) 84 | 85 | // execution environment 86 | EnvInit("current", NilValue) // output channel of current co-expr 87 | 88 | // internal flags 89 | EnvInit("gostack", NilValue) // if non-nil, dump Go stack on panic 90 | EnvInit("gpath", NewString(os.Args[0])) // argv[0] for use by translator 91 | } 92 | 93 | // ShowEnvironment(f) -- list standard environment on file f 94 | func ShowEnvironment(f io.Writer) { 95 | fmt.Fprintln(f) 96 | fmt.Fprintln(f, "Standard Environment") 97 | fmt.Fprintln(f, "------------------------------") 98 | for k := range SortedKeys(StdEnv) { 99 | cv := "c" 100 | v := StdEnv[k] 101 | if t, ok := v.(*VTrapped); ok { 102 | cv = "v" 103 | v = t.Deref() 104 | } 105 | fmt.Fprintf(f, "%%%-8s %s %#v\n", k, cv, v) 106 | } 107 | } 108 | -------------------------------------------------------------------------------- /runtime/frecord.go: -------------------------------------------------------------------------------- 1 | // frecord.go -- library routines for record types 2 | 3 | package runtime 4 | 5 | import ( 6 | "bytes" 7 | "fmt" 8 | ) 9 | 10 | var _ = fmt.Printf // enable debugging 11 | 12 | // Declare library procedures 13 | func init() { 14 | GoLib(Tuple, "tuple", "id:e...", "create anonymous record") 15 | StdLib["tuple"].(*VProcedure).RawCall = true // add magic bit 16 | } 17 | 18 | // tuple(id:e, ...) creates an anonymous record value. 19 | // Each argument must be named. 20 | // Each distinct identifier list defines a new type, 21 | // all of which have the name "tuple". 22 | func Tuple(env *Env, args []Value, names []string) (Value, *Closure) { 23 | // Note the special RawCall argument list (and special registration above). 24 | defer Traceback("tuple", args) 25 | if len(names) < len(args) { 26 | panic(NewExn("Unnamed tuple arguments not allowed")) 27 | } 28 | t := TupleType(names) 29 | return Return(t.New(args)) 30 | } 31 | 32 | // Table of known tuples, indexed by stringified list of fields 33 | var KnownTuples = make(map[string]*VCtor) 34 | 35 | // TupleType(names) finds or makes a type for constructing a tuple 36 | func TupleType(names []string) *VCtor { 37 | // make a string of the field names e.g. "a,b,c," 38 | var b bytes.Buffer 39 | for _, s := range names { 40 | b.WriteString(s) 41 | b.WriteByte(',') 42 | } 43 | s := b.String() 44 | // check for already known type 45 | t := KnownTuples[s] 46 | if t == nil { 47 | t = NewCtor("tuple", nil, names) 48 | KnownTuples[s] = t 49 | } 50 | return t 51 | } 52 | -------------------------------------------------------------------------------- /runtime/fset.go: -------------------------------------------------------------------------------- 1 | // fset.go -- set functions and methods 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | ) 8 | 9 | var _ = fmt.Printf // enable debugging 10 | 11 | // Declare methods 12 | var SetMethods = MethodTable([]*VProcedure{ 13 | DefMeth((*VSet).Put, "put", "x[]", "add members"), 14 | DefMeth((*VSet).Delete, "delete", "x[]", "remove members"), 15 | DefMeth((*VSet).Member, "member", "x", "test membership"), 16 | DefMeth((*VSet).Sort, "sort", "i", "produce sorted list"), 17 | }) 18 | 19 | // set(L) creates a set initialized by the values of list L. 20 | func Set(env *Env, args ...Value) (Value, *Closure) { 21 | defer Traceback("set", args) 22 | L := ProcArg(args, 0, EMPTYLIST).(*VList) 23 | return Return(NewSet(L)) 24 | } 25 | 26 | var EMPTYLIST = NewList(0, nil) 27 | 28 | // S.member(x) returns x if x is a member of set S; 29 | // otherwise it fails. 30 | func (S *VSet) Member(args ...Value) (Value, *Closure) { 31 | defer Traceback("S.member", args) 32 | x := ProcArg(args, 0, NilValue) 33 | if (*S)[GoKey(x)] { 34 | return Return(x) 35 | } else { 36 | return Fail() 37 | } 38 | } 39 | 40 | // S.put(x...) adds all its arguments to set S. 41 | // It returns the set S. 42 | func (S *VSet) Put(args ...Value) (Value, *Closure) { 43 | defer Traceback("S.put", args) 44 | for _, x := range args { 45 | (*S)[GoKey(x)] = true 46 | } 47 | return Return(S) 48 | } 49 | 50 | // S.delete(x...) removes all of its arguments from set S. 51 | // It returns S. 52 | func (S *VSet) Delete(args ...Value) (Value, *Closure) { 53 | defer Traceback("S.delete", args) 54 | for _, x := range args { 55 | delete(*S, GoKey(x)) 56 | } 57 | return Return(S) 58 | } 59 | 60 | // S.sort(i) returns a sorted list of the members of set S. 61 | // This is equivalent to [:!S:].sort(i). 62 | func (S *VSet) Sort(args ...Value) (Value, *Closure) { 63 | defer Traceback("S.sort", args) 64 | i := ProcArg(args, 0, ONE).(Numerable).ToNumber() 65 | members := make([]Value, 0, len(*S)) 66 | for k := range *S { 67 | members = append(members, Import(k)) // convert back from GoKey form 68 | } 69 | return InitList(members).Sort(i) 70 | } 71 | -------------------------------------------------------------------------------- /runtime/fstrmap.go: -------------------------------------------------------------------------------- 1 | // fstrmap.go -- string mapping function 2 | 3 | // This is naive, with no caching and many opportunities for optimization. 4 | 5 | package runtime 6 | 7 | import () 8 | 9 | func init() { 10 | DefLib(Map, "map", "s,from,into", "map characters") 11 | } 12 | 13 | const MAPSIZE = 128 // initial mapping table size 14 | const MMARGIN = 128 // extra margin to allow when growing the mapping table 15 | 16 | // map(s,from,into) produces a new string that result from mapping the 17 | // individual characters of a source string. 18 | // Each character of s that appears in the "from" string is replaced by 19 | // the corresponding character of the "into" string. If there is no 20 | // corresponding character, because "into" is shorter, then the character 21 | // from s is discarded. 22 | func Map(env *Env, args ...Value) (Value, *Closure) { 23 | defer Traceback("map", args) 24 | 25 | // get arguments as rune arrays 26 | s := ToString(ProcArg(args, 0, NilValue)).ToRunes() 27 | from := ToString(ProcArg(args, 1, UCASE)).ToRunes() 28 | into := ToString(ProcArg(args, 2, LCASE)).ToRunes() 29 | if len(into) > len(from) { 30 | panic(NewExn("Map: *into > *from", RuneString(into))) 31 | } 32 | 33 | // build a mapping table ctable 34 | // an entry value of -1 means delete 35 | // the default entry value of 0 means no mapping 36 | // store result+1 in entries that are to be mapped 37 | // start with size 128 and grow as needed 38 | ctable := make([]rune, MAPSIZE) 39 | for i := 0; i < len(from); i++ { 40 | f := from[i] 41 | if int(f) >= len(ctable) { 42 | cnew := make([]rune, f+MMARGIN) 43 | copy(cnew, ctable) 44 | ctable = cnew 45 | } 46 | if i < len(into) { 47 | ctable[f] = into[i] + 1 48 | } else { 49 | ctable[f] = -1 50 | } 51 | } 52 | 53 | // compute the result 54 | j := 0 // j is the output index 55 | for i := 0; i < len(s); i++ { 56 | c := s[i] 57 | if int(c) < len(ctable) { // if entry is in table 58 | t := ctable[c] // get entry value 59 | if t < 0 { 60 | continue // discard input character 61 | } else if t > 0 { 62 | c = t - 1 // map to new character 63 | } // else leave alone 64 | } 65 | s[j] = c // save result character 66 | j++ // bump store index 67 | } 68 | return Return(RuneString(s[:j])) 69 | } 70 | -------------------------------------------------------------------------------- /runtime/import_test.go: -------------------------------------------------------------------------------- 1 | // import_test.go -- test importing Go values into Goaldi 2 | 3 | package runtime 4 | 5 | import ( 6 | "bufio" 7 | "fmt" 8 | "os" 9 | "testing" 10 | ) 11 | 12 | type extl struct{ i int } 13 | 14 | func (*extl) GoaldiExternal() {} 15 | 16 | type impr struct{ i int } 17 | 18 | func (*impr) Import() Value { return NewNumber(4.713) } 19 | 20 | func TestImport(t *testing.T) { 21 | 22 | // test Goaldi types 23 | testImp(t, NilValue, NilValue) 24 | testImp(t, ONE, ONE) 25 | testImp(t, EMPTY, EMPTY) 26 | testImp(t, "abc", NewString("abc")) 27 | testImp(t, STDIN, STDIN) 28 | 29 | // test nil flavors 30 | testImp(t, nil, NilValue) 31 | testImp(t, (*float64)(nil), NilValue) 32 | testImp(t, (*os.File)(nil), NilValue) 33 | 34 | // test simple types 35 | testImp(t, false, ZERO) 36 | testImp(t, true, ONE) 37 | testImp(t, 0, ZERO) 38 | testImp(t, 1, ONE) 39 | testImp(t, 0.0, ZERO) 40 | testImp(t, 1.0, ONE) 41 | testImp(t, uint16(1), ONE) 42 | testImp(t, "7.8", NewString("7.8")) 43 | 44 | // test file import 45 | i := fmt.Sprintf("%#v", Import(bufio.NewReader(os.Stdin))) 46 | o := fmt.Sprintf("%#v", Import(bufio.NewWriter(os.Stdout))) 47 | expect(t, "stdin", "file(*bufio.Reader,r)", i) 48 | expect(t, "stdout", "file(*bufio.Writer,w)", o) 49 | 50 | // test external imports 51 | testImp(t, &impr{1}, NewNumber(4.713)) 52 | x := &extl{2} 53 | testImp(t, x, x) 54 | expect(t, "external", "&runtime.extl{i:2}", fmt.Sprintf("%#v", Import(x))) 55 | m := make(map[int]string) 56 | f := Import(&m) 57 | expect(t, "external", &m, f) 58 | } 59 | 60 | func testImp(t *testing.T, goval interface{}, expected Value) { 61 | imported := Import(goval) 62 | if Identical(imported, expected) != expected { 63 | t.Errorf("import(%T:%v) expected %v got %T:%v\n", 64 | goval, goval, expected, imported, imported) 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /runtime/namespace.go: -------------------------------------------------------------------------------- 1 | // namespace.go -- named and unnamed global variable collections 2 | 3 | package runtime 4 | 5 | import () 6 | 7 | type Namespace struct { 8 | Name string // actual name, possibly empty 9 | Qname string // identifier:: or empty 10 | Entries map[string]Value // mapping of names to variables 11 | } 12 | 13 | var allSpaces = make(map[string]*Namespace) 14 | 15 | // GetSpace(name) -- get or create a global namespace 16 | // The name may be blank to specify the default unnamed space 17 | func GetSpace(name string) *Namespace { 18 | ns := allSpaces[name] 19 | if ns == nil { 20 | ns = &Namespace{} 21 | ns.Name = name 22 | ns.Entries = make(map[string]Value) 23 | if name != "" { 24 | ns.Qname = name + "::" 25 | } 26 | allSpaces[name] = ns 27 | } 28 | return ns 29 | } 30 | 31 | // Namespace.Declare(name, contents) -- initialize a namespace entry 32 | func (ns *Namespace) Declare(name string, contents Value) { 33 | if ns.Entries[name] != nil { 34 | panic(Malfunction("Duplicate entry " + ns.Qname + name)) 35 | } 36 | ns.Entries[name] = contents 37 | } 38 | 39 | // Namespace.GetQual() -- return "" if default space else name + "::" 40 | func (ns *Namespace) GetQual() string { 41 | return ns.Qname 42 | } 43 | 44 | // Namespace.Get(name) -- retrieve namespace entry (or nil) 45 | func (ns *Namespace) Get(name string) Value { 46 | return ns.Entries[name] 47 | } 48 | 49 | // Namespace.All() -- generate all names over a channel. 50 | // usage: for k := range ns.All() {...} 51 | func (ns *Namespace) All() chan string { 52 | return SortedKeys(ns.Entries) 53 | } 54 | 55 | // AllSpaces() -- generate names of all namespaces, in sorted order 56 | // usage: for k := range AllSpaces() {...} 57 | func AllSpaces() chan string { 58 | return SortedKeys(allSpaces) 59 | } 60 | -------------------------------------------------------------------------------- /runtime/ocore_test.go: -------------------------------------------------------------------------------- 1 | // ocore_test.go -- test core functions Identical and NotIdentical 2 | 3 | package runtime 4 | 5 | import ( 6 | "testing" 7 | ) 8 | 9 | func TestCore(t *testing.T) { 10 | ab := NewString("ab") 11 | cd := NewString("cd") 12 | abcd1 := NewString("abcd") 13 | abcd2 := ab.Concat(cd) 14 | expect(t, "1s=", abcd1, Identical(abcd1, abcd1)) 15 | expect(t, "2s=", abcd2, Identical(abcd1, abcd2)) 16 | expect(t, "3s=", abcd1, Identical(abcd2, abcd1)) 17 | expect(t, "4s=", nil, Identical(ab, cd)) 18 | expect(t, "5s~", cd, NotIdentical(ab, cd)) 19 | expect(t, "6s~", nil, NotIdentical(ab, ab)) 20 | expect(t, "7s~", nil, NotIdentical(abcd1, abcd2)) 21 | 22 | n2 := NewNumber(2) 23 | n3 := NewNumber(3) 24 | n6a := NewNumber(6) 25 | n6b := n2.Mul(n3) 26 | expect(t, "1n=", n6a, Identical(n6a, n6a)) 27 | expect(t, "2n=", n6b, Identical(n6a, n6b)) 28 | expect(t, "3n=", n6a, Identical(n6b, n6a)) 29 | expect(t, "4n=", nil, Identical(n6b, n3)) 30 | expect(t, "5n~", n3, NotIdentical(n2, n3)) 31 | expect(t, "6n~", nil, NotIdentical(n3, n3)) 32 | expect(t, "7n~", nil, NotIdentical(n6a, n6b)) 33 | 34 | expect(t, "1x=", nil, Identical(ab, n2)) 35 | expect(t, "2x=", nil, Identical(n3, cd)) 36 | expect(t, "3x~", n3, NotIdentical(ab, n3)) 37 | expect(t, "4x~", cd, NotIdentical(n2, cd)) 38 | 39 | expect(t, "1z=", NilValue, Identical(NilValue, NilValue)) 40 | expect(t, "2z~", ab, NotIdentical(NilValue, ab)) 41 | expect(t, "3z~", n3, NotIdentical(NilValue, n3)) 42 | } 43 | 44 | // expect -- check result against expected value 45 | // n.b. uses Go comparison not Goaldi (does not look inside String or Number) 46 | func expect(t *testing.T, label string, expected, actual interface{}) { 47 | if expected != actual { 48 | t.Errorf("%s: expected %v, found %v\n", label, expected, actual) 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /runtime/ofile.go: -------------------------------------------------------------------------------- 1 | // ofile.go -- operators applied to files 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | ) 8 | 9 | // VFile.Dispense() implements the !f operator 10 | func (f *VFile) Dispense(unused Value) (Value, *Closure) { 11 | var c *Closure 12 | c = &Closure{func() (Value, *Closure) { 13 | s := f.ReadLine() 14 | if s != nil { 15 | return s, c 16 | } else { 17 | return Fail() 18 | } 19 | }} 20 | return c.Resume() 21 | } 22 | 23 | // VFile.Take(lval) implements the @f operator 24 | func (f *VFile) Take(lval Value) Value { 25 | s := f.ReadLine() 26 | if s != nil { 27 | return s 28 | } else { 29 | return nil 30 | } 31 | } 32 | 33 | // VFile.Send(lval, x) implements f @: x 34 | func (f *VFile) Send(lval Value, x Value) Value { 35 | s := fmt.Sprint(x) 36 | Wrt(f, nil, nlByte, []Value{s}) 37 | return s 38 | } 39 | -------------------------------------------------------------------------------- /runtime/omisc.go: -------------------------------------------------------------------------------- 1 | // omisc.go -- miscellaneous runtime operations 2 | 3 | package runtime 4 | 5 | import ( 6 | "reflect" 7 | ) 8 | 9 | // Identical(a,b) implements the === operator. 10 | // NotIdentical(a,b) implements the ~=== operator. 11 | // Both call a.Identical(b) if implemented (interface IIdentical). 12 | func Identical(a, b Value) Value { 13 | if aa, ok := a.(IIdentical); ok { 14 | return aa.Identical(b) 15 | } 16 | av := reflect.ValueOf(a) 17 | bv := reflect.ValueOf(b) 18 | if av.Type() != bv.Type() { 19 | return nil 20 | } 21 | same := false 22 | switch av.Kind() { 23 | default: 24 | same = (a == b) 25 | case reflect.Chan, reflect.Func, reflect.Map, reflect.Ptr, reflect.Slice: 26 | same = (av.Pointer() == bv.Pointer()) 27 | } 28 | if same { 29 | return b 30 | } else { 31 | return nil 32 | } 33 | } 34 | 35 | func NotIdentical(a, b Value) Value { 36 | if Identical(b, a) != nil { 37 | return nil 38 | } else { 39 | return b 40 | } 41 | } 42 | 43 | // Size(x) calls x.Size() or falls back to calling len(). 44 | // It panics on an inappropriate argument type. 45 | func Size(x Value) Value { 46 | if t, ok := x.(ISize); ok { 47 | return t.Size() 48 | } else { 49 | return NewNumber(float64(reflect.ValueOf(x).Len())) 50 | } 51 | } 52 | 53 | // VNumber.Call -- implement i(e1, e2, e3...) 54 | func (v *VNumber) Call(env *Env, args []Value, names []string) (Value, *Closure) { 55 | if len(names) > 0 { 56 | panic(NewExn("Named arguments not allowed", v)) 57 | } 58 | i := GoIndex(int(v.Val()), len(args)) 59 | if i < len(args) { 60 | return Return(args[i]) 61 | } else { 62 | return Fail() 63 | } 64 | } 65 | 66 | // ToBy -- implement "e1 to e2 by e3" 67 | func ToBy(e1 Value, e2 Value, e3 Value) (Value, *Closure) { 68 | v1 := FloatVal(e1) 69 | v2 := FloatVal(e2) 70 | v3 := FloatVal(e3) 71 | if v3 == 0 { 72 | panic(NewExn("ToBy: bad increment", e3)) 73 | } 74 | v1 -= v3 75 | var f *Closure 76 | f = &Closure{func() (Value, *Closure) { 77 | v1 += v3 78 | if (v3 > 0 && v1 <= v2) || (v3 < 0 && v1 >= v2) { 79 | return NewNumber(float64(v1)), f 80 | } else { 81 | return Fail() 82 | } 83 | }} 84 | return f.Resume() 85 | } 86 | -------------------------------------------------------------------------------- /runtime/onumber_test.go: -------------------------------------------------------------------------------- 1 | // onumber_test.go -- test numeric conversions and onumber.go operations 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | "testing" 8 | ) 9 | 10 | func TestMath(t *testing.T) { 11 | i6, s6 := nspair(t, 6) 12 | i7, s7 := nspair(t, 7) 13 | i8, s8 := nspair(t, 8) 14 | i11, s11 := nspair(t, 11) 15 | i12, s12 := nspair(t, 12) 16 | i30, s30 := nspair(t, 30) 17 | f25, s25 := nspair(t, 2.5) 18 | ck4n(t, "Numerate", 7, 19 | i7.Numerate(), i7.Numerate(), s7.Numerate(), s7.Numerate()) 20 | ck4n(t, "Negate", -11, 21 | i11.Negate(), i11.Negate(), s11.Negate(), s11.Negate()) 22 | ck4n(t, "Add", 18, 23 | i7.Add(i11), i7.Add(s11), s7.Add(i11), s7.Add(s11)) 24 | ck4n(t, "Sub", -4, 25 | i7.Sub(i11), i7.Sub(s11), s7.Sub(i11), s7.Sub(s11)) 26 | ck4n(t, "Mul", 77, 27 | i7.Mul(i11), i7.Mul(s11), s7.Mul(i11), s7.Mul(s11)) 28 | ck4n(t, "Div1", 5, 29 | i30.Div(i6), i30.Div(s6), s30.Div(i6), s30.Div(s6)) 30 | ck4n(t, "Div2", 2.5, 31 | i30.Div(i12), i30.Div(s12), s30.Div(i12), s30.Div(s12)) 32 | ck4n(t, "Divt", 2, 33 | i30.Divt(i11), i30.Divt(s11), s30.Divt(i11), s30.Divt(s11)) 34 | ck4n(t, "Mod1", 8, 35 | i30.Mod(i11), i30.Mod(s11), s30.Mod(i11), s30.Mod(s11)) 36 | ck4n(t, "Mod2", 2, 37 | i12.Mod(f25), i12.Mod(s25), s12.Mod(f25), s12.Mod(s25)) 38 | ck4n(t, "Mod3", 0.5, 39 | i8.Mod(f25), i8.Mod(s25), s8.Mod(f25), s8.Mod(s25)) 40 | ck4n(t, "Power", 117649, 41 | i7.Power(i6), i7.Power(s6), s7.Power(i6), s7.Power(s6)) 42 | } 43 | 44 | // nspair -- return number as a pair (number, string), checking conversions 45 | func nspair(t *testing.T, v float64) (*VNumber, *VString) { 46 | n1 := NewNumber(v) 47 | s1 := NewString(fmt.Sprintf("%g", v)) 48 | n2 := s1.ToNumber() 49 | s2 := n2.ToString() 50 | if n1.Val() != n2.Val() { 51 | t.Errorf("numbers %v != %v", n1, n2) 52 | } 53 | if s1.String() != s2.String() { 54 | t.Errorf("strings %v != %v", s1, s2) 55 | } 56 | return n1, s1 57 | } 58 | 59 | // ck4n -- check four numeric values for equality with expected value 60 | func ck4n(t *testing.T, label string, n0 float64, v1, v2, v3, v4 Value) { 61 | t.Log("testing", label) 62 | n1 := v1.(*VNumber).Val() 63 | n2 := v2.(*VNumber).Val() 64 | n3 := v3.(*VNumber).Val() 65 | n4 := v4.(*VNumber).Val() 66 | if n0 != n1 || n1 != n2 || n2 != n3 || n3 != n4 { 67 | t.Errorf("Expected %g, got %g %g %g %g", n0, n1, n2, n3, n4) 68 | } 69 | } 70 | -------------------------------------------------------------------------------- /runtime/orecord.go: -------------------------------------------------------------------------------- 1 | // orecord.go -- operations on user-defined Goaldi record structures 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | "math/rand" 8 | ) 9 | 10 | var _ = fmt.Printf // enable debugging 11 | 12 | // VRecord.Field() implements a field reference R.k 13 | func (v *VRecord) Field(f string) Value { 14 | d := v.Ctor 15 | i := d.Fmap[f] 16 | if i > 0 { 17 | return Trapped(&v.Data[i-1]) 18 | } 19 | for d != nil { 20 | m := d.Methods[f] 21 | if m != nil { 22 | return MethodVal(m, v) 23 | } 24 | d = d.Parent 25 | } 26 | // check for standard method 27 | if mv := UniMethod(v, f); mv != nil { 28 | return mv 29 | } 30 | // nothing found 31 | panic(NewExn("Field not found: "+f, v)) 32 | } 33 | 34 | // VRecord.Index(lval, x) implements an indexed reference R[x] 35 | func (v *VRecord) Index(lval Value, x Value) Value { 36 | i, _ := v.Ctor.Lookup(x) 37 | if i < 0 { 38 | return nil // fail: not found 39 | } else if lval == nil { 40 | return v.Data[i] // return value 41 | } else { 42 | return Trapped(&v.Data[i]) // return trapped lvalue 43 | } 44 | } 45 | 46 | // VRecord.Size() implements *R, returning the number of fields 47 | func (v *VRecord) Size() Value { 48 | return NewNumber(float64(len(v.Data))) 49 | } 50 | 51 | // VRecord.Choose() implements ?R 52 | func (v *VRecord) Choose(lval Value) Value { 53 | n := len(v.Data) 54 | if n == 0 { 55 | return nil 56 | } else if lval == nil { 57 | return v.Data[rand.Intn(n)] 58 | } else { 59 | return Trapped(&v.Data[rand.Intn(n)]) 60 | } 61 | } 62 | 63 | // VRecord.Dispense() implements !R to generate the field values 64 | func (v *VRecord) Dispense(lval Value) (Value, *Closure) { 65 | var c *Closure 66 | i := -1 67 | c = &Closure{func() (Value, *Closure) { 68 | i++ 69 | if i >= len(v.Data) { 70 | return Fail() 71 | } else if lval == nil { 72 | return v.Data[i], c 73 | } else { 74 | return Trapped(&v.Data[i]), c 75 | } 76 | }} 77 | return c.Resume() 78 | } 79 | -------------------------------------------------------------------------------- /runtime/oset.go: -------------------------------------------------------------------------------- 1 | // oset.go -- set operations 2 | 3 | package runtime 4 | 5 | import ( 6 | "math/rand" 7 | "reflect" 8 | ) 9 | 10 | //------------------------------------ Size: *S 11 | 12 | func (S *VSet) Size() Value { 13 | return NewNumber(float64(len(*S))) 14 | } 15 | 16 | //------------------------------------ Choose: ?S 17 | 18 | func (S *VSet) Choose(lval Value) Value { 19 | n := len(*S) 20 | if n == 0 { 21 | return nil // fail 22 | } 23 | vlist := reflect.ValueOf(*S).MapKeys() 24 | x := vlist[rand.Intn(n)].Interface() 25 | return Import(x) // convert back from GoKey 26 | } 27 | 28 | //------------------------------------ Take: @S 29 | 30 | func (S *VSet) Take(lval Value) Value { 31 | for v := range *S { // for just one 32 | delete(*S, v) 33 | return Import(v) // convert back from GoKey 34 | } 35 | return nil // must have been empty: fail 36 | } 37 | 38 | //------------------------------------ Dispense: !S 39 | 40 | func (S *VSet) Dispense(lval Value) (Value, *Closure) { 41 | vlist := reflect.ValueOf(*S).MapKeys() 42 | i := -1 43 | var c *Closure 44 | c = &Closure{func() (Value, *Closure) { 45 | i++ 46 | if i >= len(vlist) { 47 | return nil, nil 48 | } else { 49 | return Import(vlist[i].Interface()), c 50 | } 51 | }} 52 | return c.Resume() 53 | } 54 | 55 | //------------------------------------ Send: S @: x 56 | 57 | func (S *VSet) Send(lval Value, x Value) Value { 58 | (*S)[GoKey(x)] = true 59 | return x 60 | } 61 | 62 | //------------------------------------ Index: S[x] 63 | 64 | func (S *VSet) Index(lval Value, x Value) Value { 65 | if (*S)[GoKey(x)] { 66 | return x // found x in set 67 | } else { 68 | return nil // fail 69 | } 70 | } 71 | 72 | //------------------------------------ Union: S1 ++ S2 73 | 74 | type IUnion interface { 75 | Union(Value) Value // S ++ S 76 | } 77 | 78 | func (S1 *VSet) Union(x Value) Value { 79 | S2 := SetVal(x) 80 | S3 := NewSet(EMPTYLIST) 81 | for k := range *S1 { 82 | (*S3)[k] = true 83 | } 84 | for k := range *S2 { 85 | (*S3)[k] = true 86 | } 87 | return S3 88 | } 89 | 90 | //------------------------------------ SetDiff: S1 -- S2 91 | 92 | type ISetDiff interface { 93 | SetDiff(Value) Value // S -- S 94 | } 95 | 96 | func (S1 *VSet) SetDiff(x Value) Value { 97 | S2 := SetVal(x) 98 | S3 := NewSet(EMPTYLIST) 99 | for k := range *S1 { 100 | if !(*S2)[k] { 101 | (*S3)[k] = true 102 | } 103 | } 104 | return S3 105 | } 106 | 107 | //------------------------------------ Intersect: S1 ** S2 108 | 109 | type IIntersect interface { 110 | Intersect(Value) Value // S ** S 111 | } 112 | 113 | func (S1 *VSet) Intersect(x Value) Value { 114 | S2 := SetVal(x) 115 | S3 := NewSet(EMPTYLIST) 116 | for k := range *S1 { 117 | if (*S2)[k] { 118 | (*S3)[k] = true 119 | } 120 | } 121 | return S3 122 | } 123 | -------------------------------------------------------------------------------- /runtime/ostring_test.go: -------------------------------------------------------------------------------- 1 | // ostring_test.go -- test string conversions and ostring.go operations 2 | 3 | package runtime 4 | 5 | import ( 6 | "testing" 7 | ) 8 | 9 | func TestStringOps(t *testing.T) { 10 | i123, s123 := nspair(t, 123) 11 | i456, s456 := nspair(t, 456) 12 | t.Log("values:", i123, s123, i456, s456) 13 | ck4s(t, "Concat", "123456", i123.Concat(i456), i123.Concat(s456), 14 | s123.Concat(i456), s123.Concat(s456)) 15 | sh := NewString("♡") // heart 16 | sd := NewString("♢") // diamond 17 | sc := NewString("♣") // club 18 | ss := NewString("♠") // spade 19 | hd := sh.Concat(sd) 20 | cs := sc.Concat(ss) 21 | hdcs := hd.(*VString).Concat(cs) 22 | ck4s(t, "Concat", "♡♢♣♠", hdcs, hdcs, hdcs, hdcs) 23 | sz := hdcs.(ISize).Size().(*VNumber).Val() 24 | if sz != 4.0 { 25 | t.Errorf("String %s length %v, expected 4", hdcs, sz) 26 | } 27 | } 28 | 29 | // ck4s -- check four string values for equality with expected value 30 | func ck4s(t *testing.T, label string, s0 string, v1, v2, v3, v4 Value) { 31 | t.Log("testing", label) 32 | s1 := v1.(*VString).String() 33 | s2 := v2.(*VString).String() 34 | s3 := v3.(*VString).String() 35 | s4 := v4.(*VString).String() 36 | if s0 != s1 || s1 != s2 || s2 != s3 || s3 != s4 { 37 | t.Errorf("Expected %s: %s %s %s %s", s0, s1, s2, s3, s4) 38 | } 39 | } 40 | 41 | // for nspair() see onumber_test.go 42 | -------------------------------------------------------------------------------- /runtime/otype.go: -------------------------------------------------------------------------------- 1 | // otype.go -- operations on system-defined Goaldi types 2 | 3 | package runtime 4 | 5 | // VType.Size() implements *t, returning 0 for a non-record type. 6 | func (v *VType) Size() Value { 7 | return ZERO 8 | } 9 | 10 | // VType.Index(lval, x) fails immediately for a non-record type. 11 | func (v *VType) Index(lval Value, x Value) Value { 12 | return nil 13 | } 14 | 15 | // VType.Dispense() fails immediately for a non-record type. 16 | func (v *VType) Dispense(lval Value) (Value, *Closure) { 17 | return Fail() 18 | } 19 | -------------------------------------------------------------------------------- /runtime/run.go: -------------------------------------------------------------------------------- 1 | // run.go -- overall control of execution 2 | 3 | package runtime 4 | 5 | import ( 6 | "os" 7 | "runtime/pprof" 8 | ) 9 | 10 | // Run wraps a Goaldi procedure in an environment and an exception catcher, 11 | // and calls it from Go. 12 | // This is used first for any initialization blocks and then for main(). 13 | func Run(p Value, arglist []Value) { 14 | env := NewEnv(nil) 15 | defer Catcher(env) 16 | p.(ICall).Call(env, arglist, []string{}) 17 | } 18 | 19 | // Shutdown terminates execution with the given exit code. 20 | func Shutdown(e int) { 21 | STDOUT.(*VFile).Flush() 22 | STDERR.(*VFile).Flush() 23 | pprof.StopCPUProfile() 24 | os.Exit(e) 25 | } 26 | -------------------------------------------------------------------------------- /runtime/util.go: -------------------------------------------------------------------------------- 1 | // utils.go -- general-purpose utility routines 2 | 3 | package runtime 4 | 5 | import ( 6 | "reflect" 7 | "sort" 8 | ) 9 | 10 | // AllKeys generates (over a channel) the keys of a map[string]. 11 | // usage: for k := range AllKeys(mymap) { ... } 12 | func AllKeys(m interface{}) chan string { 13 | return genKeys(m, false) 14 | } 15 | 16 | // SortedKeys generates in order (over a channel) the keys of a map[string]. 17 | // usage: for k := range SortedKeys(mymap) { ... } 18 | func SortedKeys(m interface{}) chan string { 19 | return genKeys(m, true) 20 | } 21 | 22 | // genKeys does the actual work for AllKeys and SortedKeys. 23 | func genKeys(m interface{}, doSort bool) chan string { 24 | vlist := reflect.ValueOf(m).MapKeys() 25 | n := len(vlist) 26 | slist := make([]string, n) 27 | for i, k := range vlist { 28 | slist[i] = k.String() 29 | } 30 | if doSort { 31 | sort.Strings(slist) 32 | } 33 | ch := make(chan string, n) 34 | go func() { 35 | for _, k := range slist { 36 | ch <- k 37 | } 38 | close(ch) 39 | }() 40 | return ch 41 | } 42 | -------------------------------------------------------------------------------- /runtime/vchannel.go: -------------------------------------------------------------------------------- 1 | // vchannel.go -- VChannel, the Goaldi type "channel" 2 | 3 | package runtime 4 | 5 | import ( 6 | "fmt" 7 | "strings" 8 | ) 9 | 10 | // VChannel implements a Goaldi channel, which just wraps a Go channel. 11 | type VChannel chan Value 12 | 13 | // NewChannel -- construct a new Goaldi channel 14 | func NewChannel(i int) VChannel { 15 | return VChannel(make(chan Value, i)) 16 | } 17 | 18 | const rChannel = 35 // declare sort ranking 19 | var _ ICore = NewChannel(0) // validate implementation 20 | 21 | // ChannelType is the channel instance of type type. 22 | var ChannelType = NewType("channel", "c", rChannel, Channel, ChannelMethods, 23 | "channel", "size", "create channel") 24 | 25 | // VChannel.String -- default conversion to Go string returns "c:size" 26 | func (c VChannel) String() string { 27 | return fmt.Sprintf("c:%d", cap(c)) 28 | } 29 | 30 | // VChannel.GoString -- convert to Go string for image() and printf("%#v") 31 | func (c VChannel) GoString() string { 32 | return fmt.Sprintf("channel(%d)", cap(c)) 33 | } 34 | 35 | // VChannel.Type -- return the channel type 36 | func (c VChannel) Type() IRank { 37 | return ChannelType 38 | } 39 | 40 | // VChannel.Copy returns itself 41 | func (c VChannel) Copy() Value { 42 | return c 43 | } 44 | 45 | // VChannel.Before compares two channels for sorting 46 | func (a VChannel) Before(b Value, i int) bool { 47 | return false // no ordering defined 48 | } 49 | 50 | // VChannel.Import returns itself 51 | func (v VChannel) Import() Value { 52 | return v 53 | } 54 | 55 | // VChannel.Export returns itself. 56 | func (v VChannel) Export() interface{} { 57 | return v 58 | } 59 | 60 | // CoSend(chan, value) sends a co-expression result to a channel. 61 | // Returns chan if successful, nil if channel had been closed. 62 | // Panics on any other error. 63 | func CoSend(ch VChannel, v Value) VChannel { 64 | result := ch 65 | defer func() { 66 | r := recover() 67 | if r != nil { 68 | result = nil 69 | if !strings.HasSuffix(fmt.Sprint(r), "send on closed channel") { 70 | panic(r) // not what we expected 71 | } 72 | } 73 | }() 74 | ch <- v 75 | return result 76 | } 77 | -------------------------------------------------------------------------------- /runtime/vnil.go: -------------------------------------------------------------------------------- 1 | // vnil.go -- vnil, the Goaldi type "nil" 2 | 3 | package runtime 4 | 5 | import () 6 | 7 | // The constructor named "nil" is not a global because "nil" is reserved. 8 | var NilType = NewType("nil", "z", rNil, Nil, nil, 9 | "niltype", "", "return nil value") 10 | 11 | // The vnil struct contains no data and is not exported. 12 | type vnil struct { 13 | } 14 | 15 | const rNil = 1 // declare sort ranking 16 | var _ ICore = NilValue.(*vnil) // validate implementation 17 | 18 | // NilValue is the one and only nil value. 19 | // For convenience, its type is Value, not vnil. 20 | var NilValue Value = &vnil{} 21 | 22 | // niltype() always returns the sole instance of the nil value. 23 | // niltype is the name of the result of nil.type(). 24 | func Nil(env *Env, args ...Value) (Value, *Closure) { 25 | defer Traceback("nil", args) 26 | return Return(NilValue) 27 | } 28 | 29 | // vnil.String -- default conversion to Go string returns "~" 30 | func (v *vnil) String() string { 31 | return "~" 32 | } 33 | 34 | // vnil.GoString -- convert to string "nil" for image() and printf("%#v") 35 | func (v *vnil) GoString() string { 36 | return "nil" 37 | } 38 | 39 | // vnil.Type returns the nil type 40 | func (v *vnil) Type() IRank { 41 | return NilType 42 | } 43 | 44 | // vnil.Copy returns itself 45 | func (v *vnil) Copy() Value { 46 | return v 47 | } 48 | 49 | // vnil.Before compares two nils for sorting 50 | func (a *vnil) Before(b Value, i int) bool { 51 | return false 52 | } 53 | 54 | // vnil.Import returns itself 55 | func (v *vnil) Import() Value { 56 | return v 57 | } 58 | 59 | // vnil.Export returns a Go nil 60 | func (v *vnil) Export() interface{} { 61 | return nil 62 | } 63 | -------------------------------------------------------------------------------- /runtime/vrecord.go: -------------------------------------------------------------------------------- 1 | // vrecord.go -- a user-defined (usually) Goaldi record structure 2 | 3 | package runtime 4 | 5 | import ( 6 | "bytes" 7 | "fmt" 8 | ) 9 | 10 | type VRecord struct { 11 | Ctor *VCtor // underlying type definition 12 | Data []Value // current data values 13 | } 14 | 15 | const rRecord = 80 // declare sort ranking 16 | var _ ICore = &VRecord{} // validate implementation 17 | 18 | // VRecord.String -- conversion to Go string returns "name{}" 19 | func (v *VRecord) String() string { 20 | return v.Ctor.TypeName + "{}" 21 | } 22 | 23 | // VRecord.GoString -- returns string for image() and printf("%#v") 24 | func (v *VRecord) GoString() string { 25 | if len(v.Data) == 0 { 26 | return v.Ctor.TypeName + "{}" 27 | } 28 | var b bytes.Buffer 29 | fmt.Fprintf(&b, "%s{", v.Ctor.TypeName) 30 | for i, x := range v.Data { 31 | fmt.Fprintf(&b, "%v:%v,", v.Ctor.Flist[i], x) 32 | } 33 | s := b.Bytes() 34 | s[len(s)-1] = '}' 35 | return string(s) 36 | } 37 | 38 | // VRecord.Type returns the underlying constructor 39 | func (v *VRecord) Type() IRank { 40 | return v.Ctor 41 | } 42 | 43 | // VRecord.Copy returns a distinct copy of itself 44 | func (v *VRecord) Copy() Value { 45 | r := &VRecord{v.Ctor, make([]Value, len(v.Data))} 46 | copy(r.Data, v.Data) 47 | return r 48 | } 49 | 50 | // VRecord.Before compares two records for sorting on field i 51 | func (a *VRecord) Before(x Value, i int) bool { 52 | b := x.(*VRecord) 53 | if a.Ctor != b.Ctor { 54 | // different record types; order by type name 55 | return a.Ctor.TypeName < b.Ctor.TypeName 56 | } 57 | if i >= 0 && len(a.Data) > i && len(b.Data) > i { 58 | // both sides have an item i 59 | return LT(a.Data[i], b.Data[i], -1) 60 | } else { 61 | // put missing one first; otherwise we don't care (order is undefined) 62 | return len(a.Data) < len(b.Data) 63 | } 64 | } 65 | 66 | // VRecord.Import returns itself 67 | func (v *VRecord) Import() Value { 68 | return v 69 | } 70 | 71 | // VRecord.Export returns itself 72 | func (v *VRecord) Export() interface{} { 73 | return v 74 | } 75 | -------------------------------------------------------------------------------- /runtime/vtable.go: -------------------------------------------------------------------------------- 1 | // vtable.go -- VTable, the Goaldi type "table" 2 | 3 | package runtime 4 | 5 | import ( 6 | "bytes" 7 | "fmt" 8 | ) 9 | 10 | // A Goaldi table combines a default value with a Go map[Value]Value under 11 | // the name of VTable. Goaldi string and number indexes are converted to Go 12 | // Go string and float64 values by the GoKey() function (also used for sets). 13 | type VTable struct { 14 | data map[Value]Value // underlying Go map 15 | dfval Value // default value 16 | } 17 | 18 | const rTable = 70 // declare sort ranking 19 | var _ ICore = &VTable{} // validate implementation 20 | 21 | // NewTable -- construct a new Goaldi table 22 | func NewTable(dfval Value) *VTable { 23 | return &VTable{make(map[Value]Value), dfval} 24 | } 25 | 26 | // TableType is the table instance of type type. 27 | var TableType = NewType("table", "T", rTable, Table, TableMethods, 28 | "table", "x", "create a table with default value x") 29 | 30 | // VTable.String -- default conversion to Go string returns "T:size" 31 | func (T *VTable) String() string { 32 | return fmt.Sprintf("T:%d", len(T.data)) 33 | } 34 | 35 | // VTable.GoString -- convert to Go string for image() and printf("%#v") 36 | // 37 | // For utility and reproducibility, we pay the cost to sort into key order. 38 | func (T *VTable) GoString() string { 39 | if len(T.data) == 0 { 40 | return "table{}" 41 | } 42 | l, _ := T.Sort(ONE) // sort on key values 43 | var b bytes.Buffer 44 | fmt.Fprintf(&b, "table{") 45 | for _, e := range l.(*VList).data { 46 | r := e.(*VRecord) 47 | fmt.Fprintf(&b, "%v:%v,", r.Data[0], r.Data[1]) 48 | } 49 | s := b.Bytes() 50 | s[len(s)-1] = '}' 51 | return string(s) 52 | } 53 | 54 | // VTable.Type -- return the table type 55 | func (T *VTable) Type() IRank { 56 | return TableType 57 | } 58 | 59 | // VTable.Copy returns a duplicate of itself 60 | func (T *VTable) Copy() Value { 61 | r := NewTable(T.dfval) 62 | for k, v := range T.data { 63 | r.data[k] = v 64 | } 65 | return r 66 | } 67 | 68 | // VTable.Before compares two tables for sorting 69 | func (T *VTable) Before(b Value, i int) bool { 70 | return false // no ordering defined 71 | } 72 | 73 | // VTable.Import returns itself 74 | func (T *VTable) Import() Value { 75 | return T 76 | } 77 | 78 | // VTable.Export returns its underlying Go map. The table default is lost. 79 | // Go extensions may wish to use GoKey() for proper conversion of keys. 80 | func (T *VTable) Export() interface{} { 81 | return T.data 82 | } 83 | -------------------------------------------------------------------------------- /tests/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | # tests/Makefile -- Goaldi test files 2 | 3 | GOALDI = ../goaldi 4 | 5 | default: runall 6 | 7 | # run all tests 8 | runall: 9 | GOALDI=$(GOALDI) ./runtest.sh 10 | 11 | # run a quick sanity check: 12 | quick: 13 | GOALDI=$(GOALDI) ./runtest.sh alltypes 14 | 15 | 16 | gir: ; +make F=c X=gir derivatives # make .gir for every .gd file 17 | gia: ; +make F=a X=gia derivatives # make .gia for every .gd file 18 | 19 | F=c 20 | X=gir 21 | derivatives: # run goaldi -$F on every *.gd to make *.$X 22 | for SRC in *.gd; do B=$${SRC%.gd}; \ 23 | (set -x; $(GOALDI) -$F $$B.gd 2>$$B.err || rm -f FAILED: $$B.$X); \ 24 | done 25 | rm -f `find * -name '*.err' -size 0` 26 | ls *.$X 27 | 28 | clean: 29 | rm -f *.tmp *.out *.err *.gir *.gia *.dot 30 | -------------------------------------------------------------------------------- /tests/argnames.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # test named arguments in procedure and method calls 4 | 5 | record r() 6 | 7 | procedure main() { 8 | 9 | try(show) # Goaldi procedure 10 | try(r().show) # Goaldi method 11 | write() 12 | showlist(4,5,6) 13 | showlist(args:[1,2,3]) 14 | 15 | # library methods 16 | write() 17 | write(image(channel(3).buffer(size:5))) 18 | write(image([].sort(i:1))) 19 | printf(x:[%phi, %e, %pi], fmt:"%.4f %.4f %.4f\n") 20 | %stdout.writeb(s:"stdout writeb\n") 21 | } 22 | 23 | procedure try(p) { 24 | write() 25 | write(image(p)) 26 | write() 27 | p() 28 | p(10,20,30,40) 29 | p(a:11, b:21, c:31, d:41) 30 | p(d:42, c:32, b:22, a:12) 31 | p(c:33, a:13, d:43, b:23) 32 | write() 33 | p(14, c:34) 34 | p(b:25) 35 | p(d:46, a:16) 36 | p(17, d:47, b:27) 37 | } 38 | 39 | procedure show(a,b,c,d) { 40 | write("a=", a, " b=", b, " c=", c, " d=", d) 41 | } 42 | 43 | procedure r.show(a,b,c,d) { 44 | write("a=", a, " b=", b, " c=", c, " d=", d) 45 | } 46 | 47 | procedure showlist(args[]) { 48 | writes("args:") 49 | every writes(" ", !args) 50 | write() 51 | } 52 | -------------------------------------------------------------------------------- /tests/argnames.std: -------------------------------------------------------------------------------- 1 | 2 | procedure show(a,b,c,d) 3 | 4 | a=~ b=~ c=~ d=~ 5 | a=10 b=20 c=30 d=40 6 | a=11 b=21 c=31 d=41 7 | a=12 b=22 c=32 d=42 8 | a=13 b=23 c=33 d=43 9 | 10 | a=14 b=~ c=34 d=~ 11 | a=~ b=25 c=~ d=~ 12 | a=16 b=~ c=~ d=46 13 | a=17 b=27 c=~ d=47 14 | 15 | methodvalue (r{}).show 16 | 17 | a=~ b=~ c=~ d=~ 18 | a=10 b=20 c=30 d=40 19 | a=11 b=21 c=31 d=41 20 | a=12 b=22 c=32 d=42 21 | a=13 b=23 c=33 d=43 22 | 23 | a=14 b=~ c=34 d=~ 24 | a=~ b=25 c=~ d=~ 25 | a=16 b=~ c=~ d=46 26 | a=17 b=27 c=~ d=47 27 | 28 | args: 4 5 6 29 | args: 1 2 3 30 | 31 | channel(5) 32 | [] 33 | 1.6180 2.7183 3.1416 34 | stdout writeb 35 | -------------------------------------------------------------------------------- /tests/arith.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/arith.icn 2 | # test arithmetic operators and numeric coercion 3 | 4 | procedure main() { 5 | 6 | numtest(0, 0) 7 | numtest(0, 1) 8 | numtest(0, -1) 9 | numtest(1, 0) 10 | numtest(1, 1) 11 | numtest(1, 2) 12 | numtest(7, 3) 13 | numtest(3, 8) 14 | numtest(6.2, 4) 15 | numtest(8, 2.5) 16 | numtest(5.4, 1.2) 17 | numtest("1", 2.5) 18 | numtest("3.4", 1.7) 19 | numtest("5", " 5") 20 | numtest(0., 0.) 21 | numtest(0., 1.) 22 | numtest(0., -1.) 23 | numtest(1, -2) 24 | numtest(1., -2.) 25 | numtest(-3, 2) 26 | numtest(-3., "2.") 27 | numtest(-6, -3) 28 | numtest(-6., -3.) 29 | write() 30 | 31 | every (^i := -9 | 0 | 5 | 191) & (^j := -23 | 0 | 9 | 61) do 32 | bitcombo(i, j) 33 | write() 34 | 35 | shifttest() 36 | write() 37 | 38 | every pow(-3 to 3, -3 to 3) 39 | every pow(.5 | 1 | 1.5, (-3 to 3) / 2.0) 40 | every pow(-1.5 | -1.0 | -.5 | 0.0, -3 to 3) 41 | } 42 | 43 | procedure numtest(a, b) { 44 | wr4(+a) 45 | wr4(b) 46 | wr4(abs(a)) 47 | wr5(-b) 48 | wr5(a + b) 49 | wr5(a - b) 50 | wr5(a * b) 51 | wr5(if b ~= 0 then a // b else "-/-") 52 | wr5(if b ~= 0 then a / b else "-/-") 53 | wr5(if b ~= 0 then a % b else "-%-") 54 | wr5(-b) 55 | wr5(a < b | "---") 56 | wr4(a <= b | "---") 57 | wr4(a = b | "---") 58 | wr4(a ~= b | "---") 59 | wr4(a >= b | "---") 60 | wr4(a > b | "---") 61 | write() 62 | return 63 | } 64 | 65 | procedure bitcombo(i, j) { 66 | every wr5(i | j | icom(i) | icom(j) | 67 | iand(i,j) | ior(i,j) | ixor(i,j) | iclear(i,j)) 68 | write() 69 | return 70 | } 71 | 72 | procedure wr4(n) { # write in 4 chars 73 | return printf(" %3s", string(n)) 74 | } 75 | 76 | procedure wr5(n) { # write in 5 chars 77 | return printf(" %4s", string(n)) 78 | } 79 | 80 | procedure pow(m, n) { 81 | if m = 0 & n <= 0 then 82 | return fail 83 | local v := m ^ n 84 | printf("%f ^ %f = %f\n", m, n, v) 85 | return 86 | } 87 | 88 | procedure shifttest() { 89 | every local n := 10 to -10 by -1 do 90 | printf("shift %-2.0f %5.0f %8.0f %8.0f\n", 91 | n, ishift(1, n), ishift(1703, n), ishift(-251, n)) 92 | } 93 | -------------------------------------------------------------------------------- /tests/assign.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # tests swapping and reversible assignment 3 | procedure main() { 4 | 5 | write() 6 | local a := " algebra " 7 | local b := " botany " 8 | local c := " civics " 9 | write(1, a, b, c) 10 | a :=: b 11 | write(2, a, b, c) 12 | a :=: b :=: c 13 | write(3, a, b, c) 14 | a <- b <- c & write(4, a, b, c) & (1 < 0) 15 | write(5, a, b, c) 16 | a <-> b <-> c & write(6, a, b, c) & (1 < 0) 17 | write(7, a, b, c) 18 | } 19 | -------------------------------------------------------------------------------- /tests/assign.std: -------------------------------------------------------------------------------- 1 | 2 | 1 algebra botany civics 3 | 2 botany algebra civics 4 | 3 civics botany algebra 5 | 4 algebra algebra algebra 6 | 5 civics botany algebra 7 | 6 algebra civics botany 8 | 7 civics botany algebra 9 | -------------------------------------------------------------------------------- /tests/augment.std: -------------------------------------------------------------------------------- 1 | i := 10 ----> 10 2 | i =:= 9 ----> none 3 | i ----> 10 4 | i := 10 ----> 10 5 | i =:= 10 ----> 10 6 | i ----> 10 7 | i := 10 ----> 10 8 | i =:= 11 ----> none 9 | i ----> 10 10 | i := 10 ----> 10 11 | i >=:= 9 ----> 9 12 | i ----> 9 13 | i := 10 ----> 10 14 | i >=:= 10 ----> 10 15 | i ----> 10 16 | i := 10 ----> 10 17 | i >=:= 11 ----> none 18 | i ----> 10 19 | i := 10 ----> 10 20 | i >:= 9 ----> 9 21 | i ----> 9 22 | i := 10 ----> 10 23 | i >:= 10 ----> none 24 | i ----> 10 25 | i := 10 ----> 10 26 | i >:= 11 ----> none 27 | i ----> 10 28 | i := 10 ----> 10 29 | i <=:= 9 ----> none 30 | i ----> 10 31 | i := 10 ----> 10 32 | i <=:= 10 ----> 10 33 | i ----> 10 34 | i := 10 ----> 10 35 | i <=:= 11 ----> 11 36 | i ----> 11 37 | i := 10 ----> 10 38 | i <:= 9 ----> none 39 | i ----> 10 40 | i := 10 ----> 10 41 | i <:= 10 ----> none 42 | i ----> 10 43 | i := 10 ----> 10 44 | i <:= 11 ----> 11 45 | i ----> 11 46 | i := 10 ----> 10 47 | i ~=:= 9 ----> 9 48 | i ----> 9 49 | i := 10 ----> 10 50 | i ~=:= 10 ----> none 51 | i ----> 10 52 | i := 10 ----> 10 53 | i ~=:= 11 ----> 11 54 | i ----> 11 55 | i := 10 ----> 10 56 | i +:= 9 ----> 19 57 | i ----> 19 58 | i := 10 ----> 10 59 | i +:= 10 ----> 20 60 | i ----> 20 61 | i := 10 ----> 10 62 | i +:= 11 ----> 21 63 | i ----> 21 64 | i := 10 ----> 10 65 | i -:= 9 ----> 1 66 | i ----> 1 67 | i := 10 ----> 10 68 | i -:= 10 ----> 0 69 | i ----> 0 70 | i := 10 ----> 10 71 | i -:= 11 ----> -1 72 | i ----> -1 73 | i := 10 ----> 10 74 | i *:= 9 ----> 90 75 | i ----> 90 76 | i := 10 ----> 10 77 | i *:= 10 ----> 100 78 | i ----> 100 79 | i := 10 ----> 10 80 | i *:= 11 ----> 110 81 | i ----> 110 82 | i := 10 ----> 10 83 | i /:= 9 ----> 1.1111111111111112 84 | i ----> 1.1111111111111112 85 | i := 10 ----> 10 86 | i /:= 10 ----> 1 87 | i ----> 1 88 | i := 10 ----> 10 89 | i /:= 11 ----> 0.9090909090909091 90 | i ----> 0.9090909090909091 91 | i := 10 ----> 10 92 | i %:= 9 ----> 1 93 | i ----> 1 94 | i := 10 ----> 10 95 | i %:= 10 ----> 0 96 | i ----> 0 97 | i := 10 ----> 10 98 | i %:= 11 ----> 10 99 | i ----> 10 100 | i := 10 ----> 10 101 | i ^:= 9 ----> 1000000000 102 | i ----> 1000000000 103 | i := 10 ----> 10 104 | s := "x" ----> "x" 105 | s <<:= "x" ----> none 106 | s ----> "x" 107 | s := "x" ----> "x" 108 | s <<:= "xx" ----> "xx" 109 | s ----> "xx" 110 | s := "x" ----> "x" 111 | s <<:= "X" ----> none 112 | s ----> "x" 113 | s := "x" ----> "x" 114 | s <<:= "abc" ----> none 115 | s ----> "x" 116 | s := "x" ----> "x" 117 | s ~==:= "x" ----> none 118 | s ----> "x" 119 | s := "x" ----> "x" 120 | s ~==:= "xx" ----> "xx" 121 | s ----> "xx" 122 | s := "x" ----> "x" 123 | s ~==:= "X" ----> "X" 124 | s ----> "X" 125 | s := "x" ----> "x" 126 | s ~==:= "abc" ----> "abc" 127 | s ----> "abc" 128 | -------------------------------------------------------------------------------- /tests/catch.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # test panic recovery ("catch p") 4 | 5 | procedure main () { 6 | catch lambda(e) write("main caught ", e, "; exiting") 7 | 8 | try("failure", noresult) 9 | try("nil", nilresult) 10 | try("panic value", errresult) 11 | try("raspberry", myrasp) 12 | try("catch message", mycatch) 13 | try("rethrow", rethrow) 14 | try("custom panic", altpanic) 15 | try("type conversion error", 5) 16 | try("17", suspender) 17 | 18 | write() 19 | write("dp1. ", image(doubleplay(errresult))) # print exception 20 | write("dp2. ", image(doubleplay(noresult))) # fail 21 | write("dp3. ", image(doubleplay(nilresult))) # print nil 22 | write("dp4. ", image(doubleplay(nil))) # abort (caught by main) 23 | write("dp5. (oops)") # not reached 24 | } 25 | 26 | # set exception handler twice, then raise exception 27 | procedure doubleplay(handler) { 28 | catch nilresult # will be overridden 29 | catch handler # this one counts -- from our argument 30 | 3 to 5 by 0 # provoke exception 31 | } 32 | 33 | # try(label, proc) -- with tracing, force error and report result of catch 34 | procedure try(label, rproc) { 35 | catch tryfailed 36 | write("expect ", label, ":") 37 | local v := boom(rproc) | "[FAILED]" 38 | write(" got ", v) 39 | } 40 | 41 | # report try failure (panic not caught, or rethrown) 42 | procedure tryfailed(e) { 43 | write(" UNCAUGHT PANIC: ", e) 44 | } 45 | 46 | # register rproc, force error 47 | procedure boom(rproc) { 48 | catch errresult # superseded unless rproc is invalid 49 | write(" catch ", image(catch rproc)) 50 | 2 to 1 by 0 51 | } 52 | 53 | # return raspberry 54 | procedure myrasp(e) { 55 | return "pbpbpbpbpttttt" 56 | } 57 | 58 | # return catch message showing exception 59 | procedure mycatch(e) { 60 | return "caught: " || string(e) 61 | } 62 | 63 | # re-throw panic 64 | procedure rethrow(e) { 65 | write(" caught panic; now reissuing") 66 | throw(e) 67 | } 68 | 69 | # throw a different exception instead 70 | procedure altpanic(e) { 71 | write(" caught panic; throwing another") 72 | throw("CUSTOM PANIC") 73 | } 74 | 75 | # try suspending (shoudn't resume) 76 | procedure suspender(e) { 77 | suspend 17 to 23 do 78 | write("RESUMED?!") 79 | } 80 | -------------------------------------------------------------------------------- /tests/catch.std: -------------------------------------------------------------------------------- 1 | expect failure: 2 | catch procedure noresult(e) 3 | got [FAILED] 4 | expect nil: 5 | catch procedure nilresult(e) 6 | got ~ 7 | expect panic value: 8 | catch procedure errresult(e) 9 | got Exception("ToBy: bad increment",0) 10 | expect raspberry: 11 | catch procedure myrasp(e) 12 | got pbpbpbpbpttttt 13 | expect catch message: 14 | catch procedure mycatch(e) 15 | got caught: Exception("ToBy: bad increment",0) 16 | expect rethrow: 17 | catch procedure rethrow(e) 18 | caught panic; now reissuing 19 | UNCAUGHT PANIC: Exception("ToBy: bad increment",0) 20 | expect custom panic: 21 | catch procedure altpanic(e) 22 | caught panic; throwing another 23 | UNCAUGHT PANIC: Exception("CUSTOM PANIC") 24 | expect type conversion error: 25 | got TypeError("Number is not Procedure") 26 | expect 17: 27 | catch procedure suspender(e) 28 | got 17 29 | 30 | dp1. Exception("ToBy: bad increment",0) 31 | dp3. nil 32 | main caught Exception("ToBy: bad increment",0); exiting 33 | -------------------------------------------------------------------------------- /tests/channel.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # channel test 3 | 4 | procedure main() { 5 | local ch 6 | write("[new1]") 7 | ch := channel(5) 8 | try(ch) # should fail, nothing sent yet 9 | ch.put("algebub") 10 | ch @: "biolozy" 11 | ch.put("chemixtry") 12 | try(ch) 13 | try(ch) 14 | ch.close() 15 | write("[closed]") 16 | try(ch) # should get pending value 17 | try(ch) # should fail 18 | try(ch) # should fail 19 | 20 | write("[new2]") 21 | ch := channel() 22 | ch := ch.buffer(3) 23 | ch @: "one" 24 | ch.put("two").put("three") 25 | # ch.put("four") would deadlock 26 | try(ch) 27 | try(ch) 28 | try(ch) 29 | 30 | write("[new3]") 31 | ch := buffer(4, create(!6)) 32 | drain(ch) 33 | 34 | write("===") 35 | write("ch1 === ch1: ", if ch === ch then "identical" else "distinct") 36 | write("ch1 === ch2: ", if ch === create(1) then "identical" else "distinct") 37 | } 38 | 39 | # try reading one value from channel, showing size 40 | procedure try(ch) { 41 | write(image(ch), " size=", *ch, " => ", image(ch.get()) | "[failed]") 42 | } 43 | 44 | # drain channel and print, without showing size (more deterministic) 45 | procedure drain(ch) { 46 | while write(image(ch), " => ", image(@ch)) 47 | write(image(ch), " => [failed]") 48 | } 49 | -------------------------------------------------------------------------------- /tests/channel.std: -------------------------------------------------------------------------------- 1 | [new1] 2 | channel(5) size=0 => [failed] 3 | channel(5) size=3 => "algebub" 4 | channel(5) size=2 => "biolozy" 5 | [closed] 6 | channel(5) size=1 => "chemixtry" 7 | channel(5) size=0 => [failed] 8 | channel(5) size=0 => [failed] 9 | [new2] 10 | channel(3) size=3 => "one" 11 | channel(3) size=2 => "two" 12 | channel(3) size=1 => "three" 13 | [new3] 14 | channel(4) => 1 15 | channel(4) => 2 16 | channel(4) => 3 17 | channel(4) => 4 18 | channel(4) => 5 19 | channel(4) => 6 20 | channel(4) => [failed] 21 | === 22 | ch1 === ch1: identical 23 | ch1 === ch2: distinct 24 | -------------------------------------------------------------------------------- /tests/closure1.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # simple test of closures 4 | 5 | procedure main() { 6 | local p 7 | local q 8 | local r 9 | 10 | local mkproc := procedure(name) { 11 | /static pcount := 0 12 | local pnum := (pcount +:= 1) 13 | local n := 0 14 | return procedure(arg) { 15 | static t 16 | /t := 0 17 | n +:= 1 18 | t +:= 1 19 | write("p#", pnum, ": ", name, "(", arg, ")", 20 | " call #", n, ", total=", t) 21 | } 22 | } 23 | 24 | p := mkproc("p") 25 | q := mkproc("q") 26 | q("00") 27 | p(11) 28 | p(22) 29 | q(33) 30 | q(44) 31 | r := mkproc("r") 32 | q(55) 33 | p(66) 34 | r(77) 35 | r(88) 36 | } 37 | -------------------------------------------------------------------------------- /tests/closure1.std: -------------------------------------------------------------------------------- 1 | p#2: q(00) call #1, total=1 2 | p#1: p(11) call #1, total=2 3 | p#1: p(22) call #2, total=3 4 | p#2: q(33) call #2, total=4 5 | p#2: q(44) call #3, total=5 6 | p#2: q(55) call #4, total=6 7 | p#1: p(66) call #3, total=7 8 | p#3: r(77) call #1, total=8 9 | p#3: r(88) call #2, total=9 10 | -------------------------------------------------------------------------------- /tests/closure2.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # closures with lots of variables of various kinds 4 | 5 | global g 6 | global r 7 | 8 | procedure main() { 9 | static s 10 | 11 | local a := 100 12 | local b := 200 13 | local c := 300 14 | g := 1000 15 | s := 2000 16 | 17 | local p := procedure(x) { 18 | static t 19 | local b 20 | println("P0.", g, s, a, b, c, x, t, b) 21 | /t := 400 22 | g +:= 100 23 | s +:= 200 24 | a +:= 10 25 | b := 7389 26 | t +:= 1 27 | println("P1.", g, s, a, b, c, x, t, b) 28 | } 29 | 30 | println("M0.", g, s, a, b, c) 31 | p(1000) 32 | println("M1.", g, s, a, b, c) 33 | 34 | local q := procedure(y) { 35 | static u 36 | local d 37 | println("Q1.", g, s, a, b, c, y, u, d) 38 | /u := 400 39 | g +:= 10 40 | s +:= 20 41 | d := 700 42 | b +:= 10 43 | r := procedure(z) { 44 | static v 45 | println("R1.", g, s, a, b, c, y, u, d, z, v) 46 | /v := 0 47 | g +:= 1 48 | s +:= 2 49 | c +:= 10 50 | d +:= 1 51 | v +:= 1 52 | println("R1.", g, s, a, b, c, y, u, d, z, v) 53 | } 54 | u +:= 12 55 | println("Q1.", g, s, a, b, c, y, u, d) 56 | } 57 | 58 | println("M2.", g, s, a, b, c) 59 | p(3000) 60 | println("M3.", g, s, a, b, c) 61 | q(4000) 62 | println("M4.", g, s, a, b, c) 63 | r(5000) 64 | println("M5.", g, s, a, b, c) 65 | 66 | println("M6.", g, s, a, b, c) 67 | p(7000) 68 | println("M7.", g, s, a, b, c) 69 | q(9000) 70 | println("M8.", g, s, a, b, c) 71 | r(9000) 72 | println("M9.", g, s, a, b, c) 73 | } 74 | -------------------------------------------------------------------------------- /tests/closure2.std: -------------------------------------------------------------------------------- 1 | M0. 1000 2000 100 200 300 2 | P0. 1000 2000 100 ~ 300 1000 ~ ~ 3 | P1. 1100 2200 110 7389 300 1000 401 7389 4 | M1. 1100 2200 110 200 300 5 | M2. 1100 2200 110 200 300 6 | P0. 1100 2200 110 ~ 300 3000 401 ~ 7 | P1. 1200 2400 120 7389 300 3000 402 7389 8 | M3. 1200 2400 120 200 300 9 | Q1. 1200 2400 120 200 300 4000 ~ ~ 10 | Q1. 1210 2420 120 210 300 4000 412 700 11 | M4. 1210 2420 120 210 300 12 | R1. 1210 2420 120 210 300 4000 412 700 5000 ~ 13 | R1. 1211 2422 120 210 310 4000 412 701 5000 1 14 | M5. 1211 2422 120 210 310 15 | M6. 1211 2422 120 210 310 16 | P0. 1211 2422 120 ~ 310 7000 402 ~ 17 | P1. 1311 2622 130 7389 310 7000 403 7389 18 | M7. 1311 2622 130 210 310 19 | Q1. 1311 2622 130 210 310 9000 412 ~ 20 | Q1. 1321 2642 130 220 310 9000 424 700 21 | M8. 1321 2642 130 220 310 22 | R1. 1321 2642 130 220 310 9000 424 700 9000 1 23 | R1. 1322 2644 130 220 320 9000 424 701 9000 2 24 | M9. 1322 2644 130 220 320 25 | -------------------------------------------------------------------------------- /tests/control.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/case.icn 2 | # 3 | # test control structures 4 | 5 | record rec(a) 6 | 7 | procedure main() { 8 | 9 | if 1 < 92 then write("okay1") 10 | write(if 2 < 17 then "okay2" else "oops3") 11 | 12 | local i := 3 13 | while i <= 5 do 14 | write("i=", i+:= 1, " [while/do]") 15 | repeat { 16 | write("i=", i+:= 1, " [repeat/until]") 17 | } until i > 7 18 | 19 | while i <= 5 do 20 | write("i=", i+:= 1, " [while/do OOPS]") 21 | repeat { 22 | write("i=", i+:= 1, " [repeat/until #2]") 23 | } until i > 7 24 | 25 | repeat { 26 | write("i=", i+:= 1, " [repeat #3a]") 27 | if i > 18 then break 28 | write("i=", i+:= 1, " [repeat #3b]") 29 | if i < 14 then continue 30 | write("i=", i+:= 1, " [repeat #3c]") 31 | } 32 | 33 | every writes(!"abcde") do writes(" ") 34 | every writes(!"fghij\n") 35 | 36 | local cx := create !"pqrst\n" 37 | while writes(@cx) # while without do 38 | 39 | local r := rec(45) 40 | local c := create 1 | 2 41 | local t := table() 42 | t["a"] := "aaa" 43 | t["x"] := "xyz" 44 | local L := [nil, 0, 1.0, 2, %e, %pi, "", "0", "1", "2", 45 | rec, %stdin, main, write, rec(), r, c, cx, t, []] 46 | L.put(L.pop) # append the "pop" method 47 | L.put(L) # and L itself 48 | 49 | write() 50 | every local x := !L do { 51 | local s := case x of { 52 | "": "\"\"" 53 | 0.0: "0.0" 54 | 1.0: "1.0" 55 | 2: "2" 56 | %pi: "%pi" 57 | "1": "\"1\"" 58 | nil: "nil" 59 | main: "main" 60 | write: "write" 61 | %stdin: "%stdin" 62 | rec: "rec" 63 | rec(): "rec()" # shouldn't ever match 64 | r: "r" 65 | c: "c" 66 | t: "t" 67 | cx: "cx" 68 | L: "L" 69 | L.pop: "L.pop" # won't match, distinct methodvalue 70 | default: "default" 71 | } 72 | printf("%-10s : %-10s : %s\n", s, string(x), image(x)) 73 | } 74 | } 75 | -------------------------------------------------------------------------------- /tests/control.std: -------------------------------------------------------------------------------- 1 | okay1 2 | okay2 3 | i=4 [while/do] 4 | i=5 [while/do] 5 | i=6 [while/do] 6 | i=7 [repeat/until] 7 | i=8 [repeat/until] 8 | i=9 [repeat/until #2] 9 | i=10 [repeat #3a] 10 | i=11 [repeat #3b] 11 | i=12 [repeat #3a] 12 | i=13 [repeat #3b] 13 | i=14 [repeat #3a] 14 | i=15 [repeat #3b] 15 | i=16 [repeat #3c] 16 | i=17 [repeat #3a] 17 | i=18 [repeat #3b] 18 | i=19 [repeat #3c] 19 | i=20 [repeat #3a] 20 | a b c d e fghij 21 | pqrst 22 | 23 | nil : ~ : nil 24 | 0.0 : 0 : 0 25 | 1.0 : 1 : 1 26 | 2 : 2 : 2 27 | default : 2.718 : 2.718281828459045 28 | %pi : 3.142 : 3.141592653589793 29 | "" : : "" 30 | default : 0 : "0" 31 | "1" : 1 : "1" 32 | default : 2 : "2" 33 | rec : t:rec : constructor rec(a) 34 | %stdin : f:%stdin : file(%stdin,r) 35 | main : p:main : procedure main() 36 | write : p:write : procedure write(x[]) 37 | default : rec{} : rec{a:~} 38 | r : rec{} : rec{a:45} 39 | c : c:0 : channel(0) 40 | cx : c:0 : channel(0) 41 | t : T:2 : table{a:aaa,x:xyz} 42 | default : L:0 : [] 43 | L.pop : m:pop : methodvalue (L:22).pop 44 | L : L:22 : [~,0,1,2,2.718,3.142,,0,1,2,t:rec,f:%stdin,p:main,p:write,rec{},rec{},c:0,c:0,T:2,L:0,m:pop,L:22] 45 | -------------------------------------------------------------------------------- /tests/create.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # simple test of create (and channels) 3 | 4 | procedure main() { 5 | local x := create !10 6 | local y := create !"abcdefg" 7 | local e := create evens() 8 | local o := create odds() 9 | local c := create %current | image(%current) | (lambda() %current)() 10 | while write(@x, ". ", @y) # n.b. consumes 8 before failing 11 | while write("+ ", @x | @y) 12 | while write("e ", @e) 13 | while write("o ", @o) 14 | while write("c ", @c) #%#% SHOULD write three channels (no nils) 15 | create unused() # test create result not used 16 | sleep(0.001) # don't exit before cx runs 17 | } 18 | 19 | procedure evens() { 20 | suspend seq(0,2) \ 10 21 | } 22 | 23 | procedure odds() { 24 | every %current @: seq(1,2) \ 10 25 | } 26 | 27 | procedure unused() { 28 | write("unused here") 29 | } 30 | -------------------------------------------------------------------------------- /tests/create.std: -------------------------------------------------------------------------------- 1 | 1. a 2 | 2. b 3 | 3. c 4 | 4. d 5 | 5. e 6 | 6. f 7 | 7. g 8 | + 9 9 | + 10 10 | e 0 11 | e 2 12 | e 4 13 | e 6 14 | e 8 15 | e 10 16 | e 12 17 | e 14 18 | e 16 19 | e 18 20 | o 1 21 | o 3 22 | o 5 23 | o 7 24 | o 9 25 | o 11 26 | o 13 27 | o 15 28 | o 17 29 | o 19 30 | c ~ 31 | c nil 32 | c c:0 33 | unused here 34 | -------------------------------------------------------------------------------- /tests/ctor.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # constructor test 4 | 5 | global L 6 | global V 7 | 8 | procedure main() { 9 | L := [] 10 | V := [] 11 | local c 12 | c := constructor("empty") 13 | show(c, c()) 14 | c := constructor("point", "xpos", "ypos") 15 | show(c, c(3, 5)) 16 | show(c, c(2, 3)) 17 | show(c, c(ypos:8, xpos:4)) 18 | c := constructor("rect", "x", "y", "w", "h") 19 | show(c, c(4,3,2,1)) 20 | show(c, c(w:6, h:4, x:1, y:3)) 21 | every write("L: ", image(!L.sort())) 22 | every write("V: ", image(!V.sort())) 23 | } 24 | 25 | procedure show(c, v) { 26 | L.put(c) 27 | V.put(v) 28 | write(image(c), " : ", *c, " : ", image(v)) 29 | every ^i := 1 to *c do { 30 | ^s := c[i] | "[missing]" 31 | write(" c[", i, "] == ", image(s), 32 | " c[", image(s), "] = ", c[s] | "[failed]", 33 | " v[", i, "] = ", image(v[i]) | "[failed]", 34 | " v[", image(s), "] = ", image(v[s]) | "[failed]") 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /tests/ctor.std: -------------------------------------------------------------------------------- 1 | constructor empty() : 0 : empty{} 2 | constructor point(xpos,ypos) : 2 : point{xpos:3,ypos:5} 3 | c[1] == "xpos" c["xpos"] = 1 v[1] = 3 v["xpos"] = 3 4 | c[2] == "ypos" c["ypos"] = 2 v[2] = 5 v["ypos"] = 5 5 | constructor point(xpos,ypos) : 2 : point{xpos:2,ypos:3} 6 | c[1] == "xpos" c["xpos"] = 1 v[1] = 2 v["xpos"] = 2 7 | c[2] == "ypos" c["ypos"] = 2 v[2] = 3 v["ypos"] = 3 8 | constructor point(xpos,ypos) : 2 : point{xpos:4,ypos:8} 9 | c[1] == "xpos" c["xpos"] = 1 v[1] = 4 v["xpos"] = 4 10 | c[2] == "ypos" c["ypos"] = 2 v[2] = 8 v["ypos"] = 8 11 | constructor rect(x,y,w,h) : 4 : rect{x:4,y:3,w:2,h:1} 12 | c[1] == "x" c["x"] = 1 v[1] = 4 v["x"] = 4 13 | c[2] == "y" c["y"] = 2 v[2] = 3 v["y"] = 3 14 | c[3] == "w" c["w"] = 3 v[3] = 2 v["w"] = 2 15 | c[4] == "h" c["h"] = 4 v[4] = 1 v["h"] = 1 16 | constructor rect(x,y,w,h) : 4 : rect{x:1,y:3,w:6,h:4} 17 | c[1] == "x" c["x"] = 1 v[1] = 1 v["x"] = 1 18 | c[2] == "y" c["y"] = 2 v[2] = 3 v["y"] = 3 19 | c[3] == "w" c["w"] = 3 v[3] = 6 v["w"] = 6 20 | c[4] == "h" c["h"] = 4 v[4] = 4 v["h"] = 4 21 | L: constructor empty() 22 | L: constructor point(xpos,ypos) 23 | L: constructor point(xpos,ypos) 24 | L: constructor point(xpos,ypos) 25 | L: constructor rect(x,y,w,h) 26 | L: constructor rect(x,y,w,h) 27 | V: empty{} 28 | V: point{xpos:2,ypos:3} 29 | V: point{xpos:3,ypos:5} 30 | V: point{xpos:4,ypos:8} 31 | V: rect{x:1,y:3,w:6,h:4} 32 | V: rect{x:4,y:3,w:2,h:1} 33 | -------------------------------------------------------------------------------- /tests/cxprimes.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/cxprimes.icn 2 | # prime number generation using co-expressions 3 | 4 | procedure main(limit) { 5 | local n := number(limit) | 100 6 | local s := create (2 to n) 7 | while (^x := @s) do { 8 | write(x) 9 | s := create sieve(x, s) 10 | } 11 | } 12 | 13 | procedure sieve(x, s) { 14 | local t 15 | 16 | while t := @s do { 17 | if t % x ~= 0 then suspend t 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /tests/cxprimes.std: -------------------------------------------------------------------------------- 1 | 2 2 | 3 3 | 5 4 | 7 5 | 11 6 | 13 7 | 17 8 | 19 9 | 23 10 | 29 11 | 31 12 | 37 13 | 41 14 | 43 15 | 47 16 | 53 17 | 59 18 | 61 19 | 67 20 | 71 21 | 73 22 | 79 23 | 83 24 | 89 25 | 97 26 | -------------------------------------------------------------------------------- /tests/dynamic.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # test dynamic variables 4 | 5 | procedure main() { 6 | show("a") 7 | with %x := 12 do { 8 | show("b") 9 | with %y := 23 do { 10 | show("c") 11 | showxyz("C", %x, %y, "--") 12 | with %x := 15 do { 13 | show("d") 14 | with %z := 35 do { 15 | show("e") 16 | showxyz("E", %x, %y, %z) 17 | } 18 | with %z := 37 do { 19 | show("f") 20 | } 21 | } 22 | with %x := 17, %y := 25 do { 23 | show("g") 24 | } 25 | with %x := 19, %z := 39 do { 26 | show("h") 27 | } 28 | } 29 | show("v") 30 | } 31 | show("w") 32 | with %x := 555, %y := 666, %z := 777 do { 33 | show ("x") 34 | showxyz("X", %x, %y, %z) 35 | } 36 | show("z") 37 | 38 | write(with %foo := 1 do { 2 }) 39 | # what should the following do? 40 | # every write(with %foo := 3 | 4 do { 5 | 6 }) 41 | } 42 | 43 | procedure show(label) { 44 | showxyz(label, xval(), yval(), zval()) 45 | } 46 | 47 | procedure showxyz(label, x, y, z) { 48 | write(label, ": %x=", x, " %y=", y, " %z=", z) 49 | } 50 | 51 | procedure xval() { 52 | catch nope 53 | return %x 54 | } 55 | 56 | procedure yval() { 57 | catch nope 58 | return %y 59 | } 60 | 61 | procedure zval() { 62 | catch nope 63 | return %z 64 | } 65 | 66 | procedure nope(e) { 67 | # extract variable name from exception message 68 | return "(" || string(e)[-4:-2] || ")" 69 | } 70 | -------------------------------------------------------------------------------- /tests/dynamic.std: -------------------------------------------------------------------------------- 1 | a: %x=(%x) %y=(%y) %z=(%z) 2 | b: %x=12 %y=(%y) %z=(%z) 3 | c: %x=12 %y=23 %z=(%z) 4 | C: %x=12 %y=23 %z=-- 5 | d: %x=15 %y=23 %z=(%z) 6 | e: %x=15 %y=23 %z=35 7 | E: %x=15 %y=23 %z=35 8 | f: %x=15 %y=23 %z=37 9 | g: %x=17 %y=25 %z=(%z) 10 | h: %x=19 %y=23 %z=39 11 | v: %x=12 %y=(%y) %z=(%z) 12 | w: %x=(%x) %y=(%y) %z=(%z) 13 | x: %x=555 %y=666 %z=777 14 | X: %x=555 %y=666 %z=777 15 | z: %x=(%x) %y=(%y) %z=(%z) 16 | 2 17 | -------------------------------------------------------------------------------- /tests/extends.gd: -------------------------------------------------------------------------------- 1 | record inner extends outer (c) 2 | record outer (a,b) 3 | record innie extends outer (e, f, g) 4 | 5 | record point(x,y) 6 | record circle extends point(r) 7 | record square extends point(w) 8 | record rect extends square(h) 9 | 10 | 11 | procedure main() { 12 | every w(outer | inner | innie) 13 | every w(point | circle | square | rect) 14 | w(outer(1,2)) 15 | w(inner(3,4,5)) 16 | w(innie(6,7,8,9,0)) 17 | w(^p := point(0,0)) 18 | w(^c := circle(2,1,3)) 19 | w(^s := square(1,2,3)) 20 | w(^r := rect(5,3,4,3)) 21 | every (p|c|s|r).exhibit() 22 | } 23 | 24 | procedure circle.exhibit() { # overrides point.exhibit 25 | write("CIRCLE(", self.x, ",", self.y, ",", self.r, ") ", 26 | type(self), " ", image(self)) 27 | } 28 | 29 | procedure point.exhibit() { 30 | write("at ", self.x, ",", self.y, ": ", self.type(), " ",self.image()) 31 | case self.type() of { 32 | point: nil 33 | circle: write(" r=", self.r) 34 | square: write(" w=", self.w) 35 | rect: write(" size=(", self.w, ",", self.h, ")") 36 | } 37 | } 38 | 39 | procedure w(x) { 40 | write(image(x)) 41 | } 42 | -------------------------------------------------------------------------------- /tests/extends.std: -------------------------------------------------------------------------------- 1 | constructor outer(a,b) 2 | constructor inner(a,b,c) 3 | constructor innie(a,b,e,f,g) 4 | constructor point(x,y) 5 | constructor circle(x,y,r) 6 | constructor square(x,y,w) 7 | constructor rect(x,y,w,h) 8 | outer{a:1,b:2} 9 | inner{a:3,b:4,c:5} 10 | innie{a:6,b:7,e:8,f:9,g:0} 11 | point{x:0,y:0} 12 | circle{x:2,y:1,r:3} 13 | square{x:1,y:2,w:3} 14 | rect{x:5,y:3,w:4,h:3} 15 | at 0,0: t:point point{x:0,y:0} 16 | CIRCLE(2,1,3) t:circle circle{x:2,y:1,r:3} 17 | at 1,2: t:square square{x:1,y:2,w:3} 18 | w=3 19 | at 5,3: t:rect rect{x:5,y:3,w:4,h:3} 20 | size=(4,3) 21 | -------------------------------------------------------------------------------- /tests/genqueen.std: -------------------------------------------------------------------------------- 1 | ------------- 2 | | | | |Q| | | 3 | ------------- 4 | |Q| | | | | | 5 | ------------- 6 | | | | | |Q| | 7 | ------------- 8 | | |Q| | | | | 9 | ------------- 10 | | | | | | |Q| 11 | ------------- 12 | | | |Q| | | | 13 | ------------- 14 | 15 | ------------- 16 | | | | | |Q| | 17 | ------------- 18 | | | |Q| | | | 19 | ------------- 20 | |Q| | | | | | 21 | ------------- 22 | | | | | | |Q| 23 | ------------- 24 | | | | |Q| | | 25 | ------------- 26 | | |Q| | | | | 27 | ------------- 28 | 29 | ------------- 30 | | |Q| | | | | 31 | ------------- 32 | | | | |Q| | | 33 | ------------- 34 | | | | | | |Q| 35 | ------------- 36 | |Q| | | | | | 37 | ------------- 38 | | | |Q| | | | 39 | ------------- 40 | | | | | |Q| | 41 | ------------- 42 | 43 | ------------- 44 | | | |Q| | | | 45 | ------------- 46 | | | | | | |Q| 47 | ------------- 48 | | |Q| | | | | 49 | ------------- 50 | | | | | |Q| | 51 | ------------- 52 | |Q| | | | | | 53 | ------------- 54 | | | | |Q| | | 55 | ------------- 56 | 57 | -------------------------------------------------------------------------------- /tests/globinit.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # global initialization test -- checks proper sequencing 4 | # 5 | # execution should be ordered so that a through m form a Fibonacci sequence 6 | 7 | initial { printall("init1") } 8 | 9 | global d := b + c 10 | global j := h + i 11 | global t := a + d + g + j + l + m 12 | global l := j + k 13 | global c := a + b 14 | global x := 0 15 | global y := v + t + u 16 | global h := f + g 17 | global i := g + h 18 | 19 | initial { t +:= 1; u -:= 5; printall("init2") } 20 | 21 | global e := c + d 22 | global z := a + b + c + d + e + f + g + h + i + j + k + l + m 23 | global g := e + f 24 | global y 25 | global a := 1 26 | global u := b + d + f + h + k + m 27 | global k := i + j 28 | global w := 77 29 | global f := d + e 30 | global b := 1 31 | global v := c + i + e 32 | global m := k + l 33 | 34 | initial { v -:= 1; w +:= 3; printall("init3") } 35 | 36 | procedure main() { 37 | printall("main") 38 | write("aa=", aa, " bb=", bb, " cc=", cc, " dd=", dd) 39 | write("xx=", xx, " yy=", yy) 40 | println("done") 41 | } 42 | 43 | initial { x := 407; y := reverse(y); printall("init4") } 44 | 45 | procedure printall(label) { 46 | println(label) 47 | println(" a-m:", a, b, c, d, e, f, g, h, i, j, k, l, m) 48 | println(" t-z:", t, u, v, w, x, y, z) 49 | } 50 | 51 | initial { z := 6789; printall("init5") } 52 | 53 | # test dependency involving a procedure call 54 | # (from the Go language reference page) 55 | 56 | global aa := show("aa", cc + bb) 57 | global bb := show("bb", ff()) 58 | global cc := show("cc", ff()) 59 | global dd := show("dd", 3) 60 | 61 | procedure ff() { 62 | dd +:= 1 63 | write("ff returning ", dd) 64 | return dd 65 | } 66 | 67 | procedure show(label, value) { 68 | write(label, " := ", value) 69 | return value 70 | } 71 | 72 | # test dependency on mutually recursive procedures 73 | 74 | global rr := show("rr", r1(5)) 75 | 76 | procedure r1(n) { 77 | if n > 100 then return n 78 | return r2(2 * n) 79 | } 80 | 81 | procedure r2(n) { 82 | return r1(3 * n) 83 | } 84 | 85 | # test tricky dependency involving nested procedure 86 | 87 | global yy := tricky()() 88 | global xx := 443 89 | 90 | procedure tricky() { 91 | return lambda() xx + 124 92 | } 93 | -------------------------------------------------------------------------------- /tests/globinit.std: -------------------------------------------------------------------------------- 1 | dd := 3 2 | ff returning 4 3 | bb := 4 4 | ff returning 5 5 | cc := 5 6 | aa := 9 7 | rr := 180 8 | init1 9 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 10 | t-z: 449 355 41 77 0 845 609 11 | init2 12 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 13 | t-z: 450 350 41 77 0 845 609 14 | init3 15 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 16 | t-z: 450 350 40 80 0 845 609 17 | init4 18 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 19 | t-z: 450 350 40 80 407 548 609 20 | init5 21 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 22 | t-z: 450 350 40 80 407 548 6789 23 | main 24 | a-m: 1 1 2 3 5 8 13 21 34 55 89 144 233 25 | t-z: 450 350 40 80 407 548 6789 26 | aa=9 bb=4 cc=5 dd=5 27 | xx=443 yy=567 28 | done 29 | -------------------------------------------------------------------------------- /tests/hash32.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # demo of 32-bit hash functions 3 | 4 | procedure main() { 5 | # local files, lines, s 6 | local files 7 | local lines 8 | local s 9 | 10 | files := [adler32(), crc32(), fnv32(), fnv32a()] 11 | lines := ["", "tyger", "tyger", "burning", "bright", ""] 12 | report("[init]", files) 13 | every s := !lines do { 14 | every (!files).writes(s) 15 | report(s, files) 16 | } 17 | } 18 | 19 | procedure report(s, files) { 20 | printf("%-8s", s) 21 | every printf(" %10.0f", hashvalue(!files)) 22 | printf("\n") 23 | } 24 | -------------------------------------------------------------------------------- /tests/hash32.std: -------------------------------------------------------------------------------- 1 | [init] 1 0 2166136261 2166136261 2 | 1 0 2166136261 2166136261 3 | tyger 111018540 928910419 4170359018 133160808 4 | tyger 403899479 4095649150 2299202379 791580199 5 | burning 1112541004 3468553242 2492834988 3785874162 6 | bright 1991969228 3176573909 2721545552 3109543314 7 | 1991969228 3176573909 2721545552 3109543314 8 | -------------------------------------------------------------------------------- /tests/io.dat: -------------------------------------------------------------------------------- 1 | line 1 2 | line 2 3 | line 3 4 | line 4 5 | line 5 6 | line 6 7 | line 7 8 | line 8 9 | line 9 10 | line 10 11 | line 11 12 | line 12 13 | line 13 14 | line 14 15 | line 15 16 | line 16 17 | line 17 18 | line 18 19 | line 19 20 | line 20 21 | line 21 22 | line 22 23 | line 23 24 | line 24 25 | line 25 26 | -------------------------------------------------------------------------------- /tests/io.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # i/o test 3 | 4 | procedure main() { 5 | # local f, s 6 | local f 7 | local s 8 | 9 | # simple reading 10 | write("a. ", read()) 11 | write("b. ", @%stdin) 12 | write("c. ", !%stdin) 13 | every write("d. ", !%stdin \ 3) 14 | 15 | # open and read, including binary 16 | f := file("io.dat") 17 | write("e. ", @f) 18 | write("f. ", !f) 19 | write("g. ", f.read()) 20 | write("h. ", f.get()) 21 | write("i. ", image(f.readb(3))) 22 | write("j. ", image(f.readb(4))) 23 | write("k. ", image(f.readb(5))) 24 | write("l. ", image(f.get())) 25 | %stdout.put(f.get(), f.get(), f.get(), f.get()) 26 | write("m.") 27 | every 1 to 3 do 28 | %stdout @: @f 29 | f.close() 30 | 31 | # open and write, including binary writes to make CRLF and raw CR 32 | write() 33 | f := file("io1.tmp", "w") 34 | f.write("first line normal") 35 | f.write("raw\r CR embedded in this line") 36 | f.writes("line ending in CRLF\r\n") 37 | f.write("another normal line") 38 | f.print(12, 34, 5) # spaces, no newline 39 | f.println(6, 78, 90) # adjoins previous, spaces, newline 40 | f.flush() 41 | # extended character sets 42 | f.write("Latin1: naïve Häagen-Dazs Frusen Glädjé") 43 | f.write("Latin1: na\xEFve H\xE4agen-Dazs Frusen Gl\xE4dj\xE9") 44 | f.writeb("Latin1: na\xC3\xAFve H\xC3\xA4agen-Dazs Frusen Gl\xC3\xA4dj\xC3\xA9\n") 45 | f.write("Unicode: ✔§⌘±∮π€♻★☯♖☂☮♫¶") 46 | f.write("Unicode: ♠ A K Q ♥ A K Q ♦ A K Q J ♣ K J 9") 47 | f.write("Unicode: \u2660 A K Q \u2665 A K Q \U2666 A K Q J \u2663 K J 9") 48 | f.writeb("Unicode: \xE2\x99\xA0 A K Q \xE2\x99\xA5 A K Q \xE2\x99\xA6 A K Q J \xE2\x99\xA3 K J 9\n") 49 | f.write("another normal line") 50 | f.writes("unterminated line") 51 | f.close() 52 | 53 | # read back that file as normal text 54 | f := file("io1.tmp") 55 | while show(@f) 56 | f.close() 57 | 58 | # read back that file in binary 59 | # (non-ASCII chars look strange because UTF-8 is not decoded) 60 | write() 61 | f := file("io1.tmp") 62 | show(f.readb(1000)) 63 | f.close() 64 | 65 | # test failure to open 66 | file("/no/such/file/exists", "f") | write("[open failed as expected]") 67 | 68 | # test bidirectional appending I/O 69 | write() 70 | file("io2.tmp", "w").write("abcde\nfghij").close() 71 | f := file("io2.tmp", "rwa") 72 | write("skip: ", @f) 73 | write("skip: ", @f) 74 | f.write("klmno") 75 | f.write("pqrst") 76 | f.close() 77 | f := file("io2.tmp") 78 | every write("reread: ", !f) 79 | f.close() 80 | 81 | } 82 | 83 | procedure show(s) { 84 | write(*s, ": ", image(s)) 85 | return 86 | } 87 | -------------------------------------------------------------------------------- /tests/io.std: -------------------------------------------------------------------------------- 1 | a. line 1 2 | b. line 2 3 | c. line 3 4 | d. line 4 5 | d. line 5 6 | d. line 6 7 | e. line 1 8 | f. line 2 9 | g. line 3 10 | h. line 4 11 | i. "lin" 12 | j. "e 5\n" 13 | k. "line " 14 | l. "6" 15 | line 7 16 | line 8 17 | line 9 18 | line 10 19 | m. 20 | line 11 21 | line 12 22 | line 13 23 | 24 | 17: "first line normal" 25 | 32: "raw\r CR embedded in this line" 26 | 19: "line ending in CRLF" 27 | 19: "another normal line" 28 | 14: "12 34 56 78 90" 29 | 39: "Latin1: naïve Häagen-Dazs Frusen Glädjé" 30 | 39: "Latin1: naïve Häagen-Dazs Frusen Glädjé" 31 | 39: "Latin1: naïve Häagen-Dazs Frusen Glädjé" 32 | 24: "Unicode: ✔§⌘±∮π€♻★☯♖☂☮♫¶" 33 | 46: "Unicode: ♠ A K Q ♥ A K Q ♦ A K Q J ♣ K J 9" 34 | 46: "Unicode: ♠ A K Q ♥ A K Q ♦ A K Q J ♣ K J 9" 35 | 46: "Unicode: ♠ A K Q ♥ A K Q ♦ A K Q J ♣ K J 9" 36 | 19: "another normal line" 37 | 17: "unterminated line" 38 | 39 | 492: "first line normal\nraw\r CR embedded in this line\nline ending in CRLF\r\nanother normal line\n12 34 56 78 90\nLatin1: naïve Häagen-Dazs Frusen Glädjé\nLatin1: naïve Häagen-Dazs Frusen Glädjé\nLatin1: naïve Häagen-Dazs Frusen Glädjé\nUnicode: â\u009c\u0094§â\u008c\u0098±â\u0088®Ï\u0080â\u0082¬â\u0099»â\u0098\u0085â\u0098¯â\u0099\u0096â\u0098\u0082â\u0098®â\u0099«Â¶\nUnicode: â\u0099\u00a0 A K Q â\u0099¥ A K Q â\u0099¦ A K Q J â\u0099£ K J 9\nUnicode: â\u0099\u00a0 A K Q â\u0099¥ A K Q â\u0099¦ A K Q J â\u0099£ K J 9\nUnicode: â\u0099\u00a0 A K Q â\u0099¥ A K Q â\u0099¦ A K Q J â\u0099£ K J 9\nanother normal line\nunterminated line" 40 | [open failed as expected] 41 | 42 | skip: abcde 43 | skip: fghij 44 | reread: abcde 45 | reread: fghij 46 | reread: klmno 47 | reread: pqrst 48 | -------------------------------------------------------------------------------- /tests/iorand.dat: -------------------------------------------------------------------------------- 1 | Once upon a midnight dreary, while I pondered, weak and weary, 2 | Over many a quaint and curious volume of forgotten lore -- 3 | While I nodded, nearly napping, suddenly there came a tapping, 4 | As of some one gently rapping, rapping at my chamber door. 5 | "'Tis some visitor," I muttered, "tapping at my chamber door -- 6 | Only this and nothing more." 7 | -------------------------------------------------------------------------------- /tests/iorand.gd: -------------------------------------------------------------------------------- 1 | procedure main() { 2 | ^L := list() 3 | ^f := file("iorand.tmp", "crw") 4 | while ^line := read() do { 5 | L.push(^n := f.where()) 6 | show(n, line) 7 | f.write(line) 8 | } 9 | ^eof := f.where() 10 | show(eof, "[EOF]") 11 | write() 12 | every ^n := !L do { 13 | f.seek(n) 14 | show(n, f.read()) 15 | } 16 | write() 17 | f.seek() 18 | show(1, !f) 19 | write() 20 | every ^i := eof to 1 by -20 do { 21 | f.seek(i) 22 | show(i, f.read()) 23 | } 24 | write() 25 | every i := 0 to -eof by -20 do { 26 | f.seek(i) 27 | show(i, f.read()) 28 | } 29 | } 30 | 31 | procedure show(n, s) { 32 | return write(right(n,5), ". ", s) 33 | } 34 | -------------------------------------------------------------------------------- /tests/iorand.std: -------------------------------------------------------------------------------- 1 | 1. Once upon a midnight dreary, while I pondered, weak and weary, 2 | 64. Over many a quaint and curious volume of forgotten lore -- 3 | 123. While I nodded, nearly napping, suddenly there came a tapping, 4 | 186. As of some one gently rapping, rapping at my chamber door. 5 | 245. "'Tis some visitor," I muttered, "tapping at my chamber door -- 6 | 309. Only this and nothing more." 7 | 338. [EOF] 8 | 9 | 309. Only this and nothing more." 10 | 245. "'Tis some visitor," I muttered, "tapping at my chamber door -- 11 | 186. As of some one gently rapping, rapping at my chamber door. 12 | 123. While I nodded, nearly napping, suddenly there came a tapping, 13 | 64. Over many a quaint and curious volume of forgotten lore -- 14 | 1. Once upon a midnight dreary, while I pondered, weak and weary, 15 | 16 | 1. Once upon a midnight dreary, while I pondered, weak and weary, 17 | 18 | 318. and nothing more." 19 | 298. er door -- 20 | 278. "tapping at my chamber door -- 21 | 258. sitor," I muttered, "tapping at my chamber door -- 22 | 238. door. 23 | 218. apping at my chamber door. 24 | 198. ne gently rapping, rapping at my chamber door. 25 | 178. apping, 26 | 158. denly there came a tapping, 27 | 138. nearly napping, suddenly there came a tapping, 28 | 118. e -- 29 | 98. ume of forgotten lore -- 30 | 78. aint and curious volume of forgotten lore -- 31 | 58. eary, 32 | 38. pondered, weak and weary, 33 | 18. ght dreary, while I pondered, weak and weary, 34 | 35 | -20. and nothing more." 36 | -40. er door -- 37 | -60. "tapping at my chamber door -- 38 | -80. sitor," I muttered, "tapping at my chamber door -- 39 | -100. door. 40 | -120. apping at my chamber door. 41 | -140. ne gently rapping, rapping at my chamber door. 42 | -160. apping, 43 | -180. denly there came a tapping, 44 | -200. nearly napping, suddenly there came a tapping, 45 | -220. e -- 46 | -240. ume of forgotten lore -- 47 | -260. aint and curious volume of forgotten lore -- 48 | -280. eary, 49 | -300. pondered, weak and weary, 50 | -320. ght dreary, while I pondered, weak and weary, 51 | -------------------------------------------------------------------------------- /tests/iovars.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # test effectiveness of setting dynamic variables %stdin and %stdout 3 | 4 | procedure main() { 5 | 6 | genout("0") 7 | 8 | with %stdout := file("iovars1.tmp", "w") do { 9 | write("writing iovars1.tmp") 10 | genout("1") 11 | %stdout.close() 12 | } 13 | with %stdout := file("iovars2.tmp", "w") do { 14 | write("writing iovars2.tmp") 15 | genout("2") 16 | %stdout.close() 17 | } 18 | 19 | genout("3") 20 | 21 | with %stdin := file("iovars1.tmp") do { 22 | readall() 23 | %stdin.close() 24 | } 25 | 26 | with %stdin := file("iovars2.tmp") do { 27 | readall() 28 | %stdin.close() 29 | } 30 | 31 | remove("iovars1.tmp") 32 | remove("iovars2.tmp") 33 | } 34 | 35 | procedure genout(label) { 36 | ^g := "g" || label || ": " 37 | write(g) 38 | write(g, "genout:") 39 | write(g, "%stdout = ", image(%stdout)) 40 | writes(g, "part of line") 41 | write(" ... and the rest") 42 | print(g, "print", "a", "b", "c", "\n") 43 | println(g, "println", "a", "b", "c") 44 | %stdout.write(g, "explicit %stdout write") 45 | write(g) 46 | %stdout.flush() 47 | } 48 | 49 | procedure readall() { 50 | write() 51 | write("%stdin = ", image(%stdin)) 52 | while write("> ", read()) 53 | write() 54 | } 55 | -------------------------------------------------------------------------------- /tests/iovars.std: -------------------------------------------------------------------------------- 1 | g0: 2 | g0: genout: 3 | g0: %stdout = file(%stdout,w) 4 | g0: part of line ... and the rest 5 | g0: print a b c 6 | g0: println a b c 7 | g0: explicit %stdout write 8 | g0: 9 | g3: 10 | g3: genout: 11 | g3: %stdout = file(%stdout,w) 12 | g3: part of line ... and the rest 13 | g3: print a b c 14 | g3: println a b c 15 | g3: explicit %stdout write 16 | g3: 17 | 18 | %stdin = file(iovars1.tmp,r) 19 | > writing iovars1.tmp 20 | > g1: 21 | > g1: genout: 22 | > g1: %stdout = file(iovars1.tmp,w) 23 | > g1: part of line ... and the rest 24 | > g1: print a b c 25 | > g1: println a b c 26 | > g1: explicit %stdout write 27 | > g1: 28 | 29 | 30 | %stdin = file(iovars2.tmp,r) 31 | > writing iovars2.tmp 32 | > g2: 33 | > g2: genout: 34 | > g2: %stdout = file(iovars2.tmp,w) 35 | > g2: part of line ... and the rest 36 | > g2: print a b c 37 | > g2: println a b c 38 | > g2: explicit %stdout write 39 | > g2: 40 | 41 | -------------------------------------------------------------------------------- /tests/labels.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # label test 4 | 5 | procedure main() { 6 | 7 | every:outer local i := 10 to 90 by 10 do { 8 | every:inner local j := i + 1 to i + 9 do { 9 | if j = 14 then continue:inner 10 | if j = 24 then continue 11 | if j = 34 then continue:outer 12 | writes(" ", j) 13 | if j = 16 then break:inner 14 | if j = 26 then break 15 | if j = 46 then break:outer 16 | } 17 | } 18 | write() 19 | 20 | local ii := 10 21 | repeat:outer { 22 | local j := ii + 1 23 | repeat:inner { 24 | if j = 14 then continue:inner 25 | if j = 24 then continue 26 | if j = 34 then continue:outer 27 | writes(" ", j) 28 | if j = 16 then break:inner 29 | if j = 26 then break 30 | if j = 46 then break:outer 31 | } until (j +:= 1) > ii + 9 32 | } until (ii +:= 10) > 90 33 | write() 34 | 35 | ii := 0 36 | while:outer (ii +:= 10) < 90 do { 37 | local j := ii 38 | while:inner (j +:= 1) < ii + 10 do { 39 | if j = 14 then continue:inner 40 | if j = 24 then continue 41 | if j = 34 then continue:outer 42 | writes(" ", j) 43 | if j = 16 then break:inner 44 | if j = 26 then break 45 | if j = 46 then break:outer 46 | } 47 | } 48 | write() 49 | } 50 | -------------------------------------------------------------------------------- /tests/labels.std: -------------------------------------------------------------------------------- 1 | 11 12 13 15 16 21 22 23 25 26 31 32 33 41 42 43 44 45 46 2 | 11 12 13 15 16 21 22 23 25 26 31 32 33 41 42 43 44 45 46 3 | 11 12 13 15 16 21 22 23 25 26 31 32 33 41 42 43 44 45 46 4 | -------------------------------------------------------------------------------- /tests/lambda.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # lambda test 4 | # also procedure type test 5 | 6 | procedure main() { 7 | 8 | write(" main: ", image(main), " : ", image(type(main)), 9 | " : ", image(type(main)(main) | "[procedure constructor failed]")) 10 | 11 | local a := 7 12 | write(" a = ", a) 13 | 14 | local by3 := lambda(i, j) { a := i to j by 3 } 15 | write(" by3 = ", image(by3), " : ", type(main) === type(by3) | "[FAILED]") 16 | every writes(" ", by3(1, 20) | "\n") 17 | write(" a = ", a) 18 | 19 | local by7 := lambda(i, j) local a := i to j by 7 20 | write(" by7 = ", image(by7), " : ", type(main) === type(by7) | "[FAILED]") 21 | every writes(" ", by7(21, 50) | "\n") 22 | write(" a = ", a) 23 | 24 | write(type(main)("OOPS") | "done") 25 | } 26 | -------------------------------------------------------------------------------- /tests/lambda.std: -------------------------------------------------------------------------------- 1 | main: procedure main() : type procedure : procedure main() 2 | a = 7 3 | by3 = procedure 1$main$nested$1(i,j) : t:procedure 4 | 1 4 7 10 13 16 19 5 | a = 19 6 | by7 = procedure 1$main$nested$2(i,j) : t:procedure 7 | 21 28 35 42 49 8 | a = 19 9 | done 10 | -------------------------------------------------------------------------------- /tests/lexcmp.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/lexcmp.icn 2 | 3 | # lexical comparison test 4 | 5 | procedure main() { 6 | write(" s1 s2 << <<= == ~== >>= >>") 7 | every (local s := "" | "a" | "b" | "c" | "x" | 2 | "") & 8 | (local t := "" | "a" | "c" | "x" | "2") do { 9 | wr(s) 10 | wr(t) 11 | wr(s << t | nil) 12 | wr(s <<= t | nil) 13 | wr(s == t | nil) 14 | wr(s ~== t | nil) 15 | wr(s >>= t | nil) 16 | wr(s >> t | nil) 17 | write() 18 | } 19 | } 20 | 21 | procedure wr(s) { 22 | printf("%6v", \s | "---") 23 | return 24 | } 25 | -------------------------------------------------------------------------------- /tests/lexcmp.std: -------------------------------------------------------------------------------- 1 | s1 s2 << <<= == ~== >>= >> 2 | --- --- --- 3 | a a a --- a --- --- 4 | c c c --- c --- --- 5 | x x x --- x --- --- 6 | 2 2 2 --- 2 --- --- 7 | a --- --- --- 8 | a a --- a a --- a --- 9 | a c c c --- c --- --- 10 | a x x x --- x --- --- 11 | a 2 --- --- --- 2 2 2 12 | b --- --- --- 13 | b a --- --- --- a a a 14 | b c c c --- c --- --- 15 | b x x x --- x --- --- 16 | b 2 --- --- --- 2 2 2 17 | c --- --- --- 18 | c a --- --- --- a a a 19 | c c --- c c --- c --- 20 | c x x x --- x --- --- 21 | c 2 --- --- --- 2 2 2 22 | x --- --- --- 23 | x a --- --- --- a a a 24 | x c --- --- --- c c c 25 | x x --- x x --- x --- 26 | x 2 --- --- --- 2 2 2 27 | 2 --- --- --- 28 | 2 a a a --- a --- --- 29 | 2 c c c --- c --- --- 30 | 2 x x x --- x --- --- 31 | 2 2 --- 2 2 --- 2 --- 32 | --- --- --- 33 | a a a --- a --- --- 34 | c c c --- c --- --- 35 | x x x --- x --- --- 36 | 2 2 2 --- 2 --- --- 37 | -------------------------------------------------------------------------------- /tests/lists1.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # Tests most list operations and methods except random selection. 4 | 5 | procedure main() { 6 | # local a, b, c, i, j, l, l2 7 | local a 8 | local b 9 | local c 10 | local i 11 | local j 12 | local l 13 | local l2 14 | 15 | write("A:") 16 | show(list()) 17 | show(list(3)) 18 | show(list(5, 9)) 19 | show(list(, "X")) 20 | 21 | write("B:") 22 | l := ["a","b","3"] 23 | write("\ttype:", type(l), " size:", *l, " print:", l, " image:", image(l)) 24 | show(l) 25 | 26 | write("C:") 27 | l := list() 28 | show(l) 29 | every l.put(!"def") do show(l) 30 | every l.push(!"cba") do show(l) 31 | every writes((l.get | l.pull | l.pop)(), " : ") do show(l) 32 | every l.put(!"ghi") do show(l) 33 | every writes((l.get | l.pull | l.pop)(), " : ") do show(l) 34 | show(l) 35 | l.push(3, 2, 1) & show(l) 36 | l.put(7, 8, 9) & show(l) 37 | 38 | write("D:") 39 | every (l := []).put(!"1yly5pmno") 40 | show(l) 41 | 42 | write("E:") 43 | while writes(@l & l.pull() & l.pop(), " : ") do 44 | l.push(*l) & l.put(*l) & show(l) 45 | show(l) 46 | 47 | write("F:") 48 | show([]) 49 | show([7]) 50 | show(l := [3, 1, 4, 1, 5, 9]) 51 | show(l[2+:4]) 52 | show(l[2:6].put(1).put(6)) 53 | show(l) # should be unchanged 54 | 55 | write("G:") 56 | every (l := []).push(!"fedcba") 57 | show(l) 58 | every i := -2 to 2 do 59 | every j := 3 to 5 do 60 | writes(i,":",j) & show(l[i:j]) 61 | 62 | write("H:") 63 | l := [2,3,4] 64 | l2 := [7,8,9] 65 | show(l ||| l2) 66 | show(l.push(1) ||| l2) 67 | show(l ||| l2.push(5)) 68 | show(l.put(5) ||| l2) 69 | 70 | write("I:") 71 | show(l2 := copy(l)) 72 | show(l2.get() & l2.pull() & @l2 & l2) 73 | show(l) # should be unchanged 74 | 75 | write("J:") 76 | show([:!"wxyz":]) 77 | show([: 3 * !7 % 10 :]) 78 | 79 | write("K:") 80 | a := [3,1,4,1,5,9,2,6,5,] 81 | write(image(a)) 82 | write(image(a.sort())) 83 | every (b := []).put(!"cowabunga!") 84 | write(image(b)) 85 | write(image(b.sort())) 86 | c := [3, "x", nil, 5.5, a, "q", 7, %stdin, "t", main, 9, ] 87 | write(image(c)) 88 | write(image(c.sort())) 89 | 90 | write("L:") 91 | a := [2,7,1,8] 92 | b := list(3,a) # should be 3 distinct lists in Goaldi 93 | b[1].put(3) 94 | b[2].put(2,8) 95 | b[3].put(0,9) 96 | every write(image(b | !b)) 97 | 98 | write("M:") 99 | write([0][1] := 7) # test asgmt to rvalue L[1] derived from lvalue [9] 100 | write(?[2,3,4] := 8) 101 | write(![5,6,7] := 9) 102 | 103 | write("N:") 104 | a := [5,3,0,9] 105 | a @: "E" 106 | a @: "A" 107 | a @: "9" 108 | write(image(a)) 109 | 110 | write ! ["all ", "done", "!"] 111 | } 112 | 113 | procedure show(l) { 114 | local i 115 | writes("\t", *l, ": ") 116 | every i := -9 to 9 do 117 | writes(l[i] | "-", " ") 118 | writes(" : ") 119 | every writes(" ", !l | "\n") 120 | } 121 | -------------------------------------------------------------------------------- /tests/lists2.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/lists.icn 2 | # 3 | # List test from Icon 4 | 5 | procedure main() { 6 | # local i, x, y, z 7 | local i 8 | local x 9 | local y 10 | local z 11 | 12 | limage("a", list()) 13 | limage("b", list(2)) 14 | limage("c", list(,3)) 15 | limage("d", list(4,5)) 16 | limage("d", list(6,7)) 17 | limage("e", []) 18 | limage("f", [nil]) 19 | limage("g", [1]) 20 | limage("h", [2,3,4,5]) 21 | limage("i", [1,2,3] ||| [4,5,6,7,8]) 22 | 23 | x := [1,2,3] 24 | x.push(); limage("-", x) 25 | x.put(); limage("-", x) 26 | x.push(nil); limage("A", x) 27 | x.put(nil); limage("B", x) 28 | write("\t", image(x.pop())); limage("C", x) 29 | write("\t", image(x.get())); limage("D", x) 30 | write("\t", image(x.pull())); limage("E", x) 31 | x.push(4); limage("F", x) 32 | x.push(5,6,7); limage("G", x) 33 | x.push(8,9).push(10,11); limage("H", x) 34 | x.put(12); limage("I", x) 35 | x.put(13,14,15); limage("J", x) 36 | x.put(16,17).put(18,19); limage("K", x) 37 | x.push(20,21).put(22,23); limage("L", x) 38 | every !x := 7; limage("M", x) 39 | 40 | x := [1,2,3,4,5] 41 | 42 | every i := 0 to *x+3 do 43 | x[i] := i; 44 | limage("N", x) 45 | 46 | every i := -*x-3 to 0 do 47 | x[i] := i; 48 | limage("O", x) 49 | 50 | x := [1] 51 | write("\t", ?x) 52 | ?x := 2 53 | limage("P", x) 54 | write(x[0] | "ok failure 0") 55 | write(x[2] | "ok failure 2") 56 | write(x[-2] | "ok failure -2") 57 | x.get() 58 | write(x.get() | "ok failure on get") 59 | write(x.pop() | "ok failure on pop") 60 | write(x.pull() | "ok failure on pull") 61 | 62 | x := [1,2,3,4,5,6,7,8,9] 63 | limage("p", x) 64 | limage("q", x[1:0]) 65 | limage("r", x[2:5]) 66 | limage("s", x[-3:5]) 67 | limage("t", x[-5:-1]) 68 | limage("u", x[-3+:6]) | write("u. ok wraparound failed") 69 | limage("v", x[3-:6]) | write("v. ok wraparound failed") 70 | 71 | write() 72 | y := copy(x) # ensure that copies are distinct 73 | every !x +:= 10 74 | every !y +:= 20 75 | limage("x", x) 76 | limage("y", y) 77 | 78 | z := x ||| y 79 | limage("z", z) 80 | every !x +:= 10 81 | every !y +:= 20 82 | every !z +:= 50 83 | limage("x", x) 84 | limage("y", y) 85 | limage("z", z) 86 | 87 | } 88 | 89 | procedure limage(label, lst) { 90 | writes(label, ". [", *lst, "]") 91 | every writes(" ", image(!lst)) 92 | write() 93 | return 94 | } 95 | -------------------------------------------------------------------------------- /tests/lists2.std: -------------------------------------------------------------------------------- 1 | a. [0] 2 | b. [2] nil nil 3 | c. [0] 4 | d. [4] 5 5 5 5 5 | d. [6] 7 7 7 7 7 7 6 | e. [0] 7 | f. [1] nil 8 | g. [1] 1 9 | h. [4] 2 3 4 5 10 | i. [8] 1 2 3 4 5 6 7 8 11 | -. [3] 1 2 3 12 | -. [3] 1 2 3 13 | A. [4] nil 1 2 3 14 | B. [5] nil 1 2 3 nil 15 | nil 16 | C. [4] 1 2 3 nil 17 | 1 18 | D. [3] 2 3 nil 19 | nil 20 | E. [2] 2 3 21 | F. [3] 4 2 3 22 | G. [6] 7 6 5 4 2 3 23 | H. [10] 11 10 9 8 7 6 5 4 2 3 24 | I. [11] 11 10 9 8 7 6 5 4 2 3 12 25 | J. [14] 11 10 9 8 7 6 5 4 2 3 12 13 14 15 26 | K. [18] 11 10 9 8 7 6 5 4 2 3 12 13 14 15 16 17 18 19 27 | L. [22] 21 20 11 10 9 8 7 6 5 4 2 3 12 13 14 15 16 17 18 19 22 23 28 | M. [22] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 29 | N. [5] 1 2 3 4 5 30 | O. [5] -5 -4 -3 -2 -1 31 | 1 32 | P. [1] 2 33 | ok failure 0 34 | ok failure 2 35 | ok failure -2 36 | ok failure on get 37 | ok failure on pop 38 | ok failure on pull 39 | p. [9] 1 2 3 4 5 6 7 8 9 40 | q. [9] 1 2 3 4 5 6 7 8 9 41 | r. [3] 2 3 4 42 | s. [2] 5 6 43 | t. [4] 5 6 7 8 44 | u. ok wraparound failed 45 | v. ok wraparound failed 46 | 47 | x. [9] 11 12 13 14 15 16 17 18 19 48 | y. [9] 21 22 23 24 25 26 27 28 29 49 | z. [18] 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 27 28 29 50 | x. [9] 21 22 23 24 25 26 27 28 29 51 | y. [9] 41 42 43 44 45 46 47 48 49 52 | z. [18] 61 62 63 64 65 66 67 68 69 71 72 73 74 75 76 77 78 79 53 | -------------------------------------------------------------------------------- /tests/lists3.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # Tests random list selection and assignment. 4 | # Sensitive to randomness implementation. 5 | 6 | procedure main() { 7 | # local l, c 8 | local l 9 | local c 10 | 11 | l := [] 12 | show(l) 13 | every l.put(!"abcdefghijklmn") do 14 | show(l) 15 | every c := !"pqrstuvwxyz" do 16 | ?l := c & show(l) 17 | } 18 | 19 | # show random samples and then whole list 20 | procedure show(l) { 21 | every 1 to 12 do 22 | writes(?l | "-") 23 | every writes(" " | !l | "\n") 24 | } 25 | -------------------------------------------------------------------------------- /tests/lists3.std: -------------------------------------------------------------------------------- 1 | ------------ 2 | aaaaaaaaaaaa a 3 | abaabbbabaaa ab 4 | abbbaabaccac abc 5 | bdbcbccdbdca abcd 6 | edcbeeaaddda abcde 7 | fadaecfcfcba abcdef 8 | bcdeaagfabad abcdefg 9 | bdbddcgacdeh abcdefgh 10 | dahcdedifcbe abcdefghi 11 | acidbcehhhbe abcdefghij 12 | dchjfiaibfhc abcdefghijk 13 | bcdbicadalee abcdefghijkl 14 | iakaeekjlikj abcdefghijklm 15 | dacadhiainai abcdefghijklmn 16 | kikfamcbbbfm abcdefgpijklmn 17 | gpepceqabcdc abcdefgpijkqmn 18 | kqmgrqaqfarj abrdefgpijkqmn 19 | fmrddeemfjpg sbrdefgpijkqmn 20 | ftfdfergekee sbrdefgtijkqmn 21 | qirfkgsbfjrr sbruefgtijkqmn 22 | jvvmbqjjmrkk sbrvefgtijkqmn 23 | itjjqewfkikk wbrvefgtijkqmn 24 | netrjrrxxrff wbrvefgtijxqmn 25 | viqibntntnbe wbrveygtijxqmn 26 | vewenexywmqm wbrveygzijxqmn 27 | -------------------------------------------------------------------------------- /tests/lists4.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # Tests some problems seen in accessing reversed lists 4 | # when used in rvalue contexts. 5 | 6 | procedure main() { 7 | ^L := [1,2,3] # initially a "normal" list 8 | show(L) # show it 9 | show(copy(L)) # show a copy 10 | write() 11 | L.push(0) # now it's "reversed" internally 12 | show(L) # and you SHOULDN'T be able to tell that 13 | show(copy(L)) # nor on a copy 14 | } 15 | 16 | procedure show(L) { 17 | local i 18 | write(image(L)) 19 | every writes(" ", !L | "\n") # takes rvalue path 20 | every writes(" ", (!L + 0) | "\n") # takes lvalue path 21 | every i := 1 to *L do writes(" ", L[i]) 22 | write() 23 | every i := 1 to *L do writes(" ", L[i] + 0) 24 | write() 25 | } 26 | -------------------------------------------------------------------------------- /tests/lists4.std: -------------------------------------------------------------------------------- 1 | [1,2,3] 2 | 1 2 3 3 | 1 2 3 4 | 1 2 3 5 | 1 2 3 6 | [1,2,3] 7 | 1 2 3 8 | 1 2 3 9 | 1 2 3 10 | 1 2 3 11 | 12 | [0,1,2,3] 13 | 0 1 2 3 14 | 0 1 2 3 15 | 0 1 2 3 16 | 0 1 2 3 17 | [0,1,2,3] 18 | 0 1 2 3 19 | 0 1 2 3 20 | 0 1 2 3 21 | 0 1 2 3 22 | -------------------------------------------------------------------------------- /tests/literals.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # test literals 4 | 5 | procedure main() { 6 | 7 | # should interpret excapes in quoted string 8 | ^s := "\b\d\e\f\l\n\r\t\v\'\"\\\067\130\x58\u0058\^H" 9 | write(image(s)) 10 | every ^c := !s do 11 | write(ord(c), " ", image(c)) 12 | 13 | # these escapes should have no effect 14 | write(image("\a\c\g\h\i\j\k\m\o\p\q\s\w\y\z")) 15 | 16 | # should not interpret excapes in raw-quoted string 17 | s := `\b\d\e\f\l\n\r\t\v\'\"\\\067\130\x58\u0058\^H` 18 | write(*s, " ", image(s)) 19 | write(*s, " ", s) 20 | 21 | # try multi-line raw-quoted string 22 | write(`line 1 23 | line 2 24 | line 3 25 | line 4`) 26 | } 27 | -------------------------------------------------------------------------------- /tests/literals.std: -------------------------------------------------------------------------------- 1 | "\b\x7f\x1b\f\n\n\r\t\v'\"\\7XXX\b" 2 | 8 "\b" 3 | 127 "\x7f" 4 | 27 "\x1b" 5 | 12 "\f" 6 | 10 "\n" 7 | 10 "\n" 8 | 13 "\r" 9 | 9 "\t" 10 | 11 "\v" 11 | 39 "'" 12 | 34 "\"" 13 | 92 "\\" 14 | 55 "7" 15 | 88 "X" 16 | 88 "X" 17 | 88 "X" 18 | 8 "\b" 19 | "acghijkmopqswyz" 20 | 45 "\\b\\d\\e\\f\\l\\n\\r\\t\\v\\'\\\"\\\\\\067\\130\\x58\\u0058\\^H" 21 | 45 \b\d\e\f\l\n\r\t\v\'\"\\\067\130\x58\u0058\^H 22 | line 1 23 | line 2 24 | line 3 25 | line 4 26 | -------------------------------------------------------------------------------- /tests/meander.dat: -------------------------------------------------------------------------------- 1 | abc:2 2 | 1234:2 3 | ABC:4 4 | -------------------------------------------------------------------------------- /tests/meander.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/meander.icn 2 | # 3 | # M E A N D E R I N G S T R I N G S 4 | # 5 | 6 | # This main procedure accepts specifications for meandering strings 7 | # from standard input with the alphabet separated from the length by 8 | # a colon. 9 | 10 | procedure main() { 11 | while local line := read() do { 12 | local f := split(line, ":") 13 | if (*f = 2) & (local n := integer(f[2])) then { 14 | local alpha := f[1] 15 | write("meander(", alpha, ",", n, "): ") 16 | write(meander(alpha,n)) 17 | } else { 18 | stop("erroneous input: ", line) 19 | } 20 | } 21 | } 22 | 23 | procedure meander(alpha,n) { 24 | local i := local k := *alpha 25 | local t := n-1 26 | local result := repl(alpha[1],t) 27 | while local c := alpha[i] do { 28 | if contains(result, result[-t:0] || c) ~= 0 then i -:= 1 else {result ||:= c; i := k} 29 | } 30 | return result 31 | } 32 | -------------------------------------------------------------------------------- /tests/meander.std: -------------------------------------------------------------------------------- 1 | meander(abc,2): 2 | accbcabbaa 3 | meander(1234,2): 4 | 14434241332312211 5 | meander(ABC,4): 6 | AAACCCCBCCCACCBBCCBACCABCCAACBCBCACBBBCBBACBABCBAACACABBCABACAABCAAABBBBABBAABABAAAA 7 | -------------------------------------------------------------------------------- /tests/method.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | 3 | # simple method test 4 | 5 | record point() 6 | record square(w) 7 | record circle(r, color) 8 | 9 | procedure main() { 10 | 11 | # define values 12 | local c1 := circle(2) 13 | local c2 := circle(7, "red") 14 | local s1 := square(4) 15 | local s2 := square(6) 16 | 17 | # try methods 18 | every (point() | c1 | s1 | c2 | s2) . draw (1 | 5, 5 | 1) 19 | 20 | # try methodvalue 21 | local m := c1.draw 22 | write("value: ", m, " : ", image(m), " : ", methodvalue(m) | "[failed]") 23 | write("type: ", type(m), " ", m.type(), " ", type(m) === methodvalue) 24 | c1.color := "purple" 25 | m(3,4) 26 | 27 | # check methodvalue comparisons 28 | compare(c1.draw,s1.draw) 29 | compare(c1.draw,c2.draw) 30 | compare(c1.draw,c1.draw) 31 | 32 | write(methodvalue("FAIL") | "done") 33 | } 34 | 35 | procedure point.draw(x, y) { 36 | show(self, x, y, "P") 37 | } 38 | 39 | procedure circle.draw(x, y) { 40 | show(self, x, y, "C") 41 | self.r +:= 1 42 | } 43 | 44 | procedure square.draw(x, y) { 45 | show(self, x, y, "Q") 46 | } 47 | 48 | procedure show(o, x, y, c) { 49 | printf("at %.0f,%.0f: %s: %#v\n", x, y, c, o) 50 | } 51 | 52 | procedure compare(m1, m2) { 53 | writes(if m1 === m2 then "SAME:" else "DIFF:") 54 | write(" ", image(m1), " : ", image(m2)) 55 | } 56 | -------------------------------------------------------------------------------- /tests/method.std: -------------------------------------------------------------------------------- 1 | at 1,5: P: point{} 2 | at 1,1: P: point{} 3 | at 5,5: P: point{} 4 | at 5,1: P: point{} 5 | at 1,5: C: circle{r:2,color:~} 6 | at 1,1: C: circle{r:3,color:~} 7 | at 5,5: C: circle{r:4,color:~} 8 | at 5,1: C: circle{r:5,color:~} 9 | at 1,5: Q: square{w:4} 10 | at 1,1: Q: square{w:4} 11 | at 5,5: Q: square{w:4} 12 | at 5,1: Q: square{w:4} 13 | at 1,5: C: circle{r:7,color:red} 14 | at 1,1: C: circle{r:8,color:red} 15 | at 5,5: C: circle{r:9,color:red} 16 | at 5,1: C: circle{r:10,color:red} 17 | at 1,5: Q: square{w:6} 18 | at 1,1: Q: square{w:6} 19 | at 5,5: Q: square{w:6} 20 | at 5,1: Q: square{w:6} 21 | value: m:draw : methodvalue (circle{}).draw : m:draw 22 | type: t:methodvalue t:methodvalue t:methodvalue 23 | at 3,4: C: circle{r:6,color:purple} 24 | DIFF: methodvalue (circle{}).draw : methodvalue (square{}).draw 25 | DIFF: methodvalue (circle{}).draw : methodvalue (circle{}).draw 26 | SAME: methodvalue (circle{}).draw : methodvalue (circle{}).draw 27 | done 28 | -------------------------------------------------------------------------------- /tests/misc.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/misc.icn 2 | 3 | record message( 4 | who, # something 5 | gap, # something else 6 | what, # something more 7 | ) 8 | 9 | procedure main() { 10 | # local i, x 11 | local i 12 | local x 13 | 14 | x := 1 15 | x +:= |1 # tickled optimizer bug. 16 | write(x) 17 | 18 | x := table() 19 | write(x[]) 20 | 21 | x := "o" 22 | write("a" & "b") 23 | write("c" | "d") 24 | write(\"e") 25 | write(!"f") 26 | write(\nil | "g") 27 | write(/nil & "h") 28 | write("i" || "jk") 29 | write(23 || "skidoo") 30 | write(x, x, x := "b") # was: .x test 31 | 32 | every write( (1|2)("hello", "mom"), "!") 33 | every write ! [ (1|2) ! ["hello", "mom"], "!"] 34 | #write ! message("hello") 35 | #write ! message("hello", " ", "pop") 36 | every i := -4 to 4 do 37 | write("i=", i, ": ", i("a","b","c") | "failed") 38 | 39 | every write(seq() \ 3) 40 | every write(seq(4) \ 3) 41 | every write(seq(,4) \ 3) 42 | every write(seq(10,20) \ 3) 43 | 44 | write("repl: ", repl("",5), repl("x",3), repl("foo",0), repl("xyz",4)) 45 | write("reverse: ", reverse(""), reverse("x"), reverse("ab"), reverse(12345)); 46 | every i := 0 to 255 do 47 | if (ord(char(i)) ~= i) then write("char/ord oops ", i) 48 | writes("char: ") 49 | every writes(char((64 to 126) | 10)) 50 | 51 | evaluation("1234567890", "abcdefghi") 52 | 53 | every write(image(nullsuspend())) 54 | 55 | every write(tstreturn()) 56 | 57 | write("done") 58 | exit() 59 | write("oops!") 60 | dummy() 61 | } 62 | 63 | procedure tstreturn() { 64 | return fn() 65 | } 66 | 67 | procedure fn() { 68 | suspend "OK to get here" 69 | write("Should not get here when called from a 'return'") 70 | } 71 | 72 | # These got different results under 73 | # Icon's (odd) two-pass argument evaluation process. 74 | procedure evaluation(a,b) { 75 | # local x,y 76 | local x 77 | local y 78 | 79 | write("argument evaluation test") 80 | write("a. ", x, x:=1) 81 | write("b. ", x:=2, x:=3) 82 | write("c. ", a, a := 3) 83 | write("d. ", b[2], b[2] := "q") 84 | write("e. ", b[2:3], b[1:4] := "qwerty") 85 | y := [1,2,3,4] 86 | write("f. ", y[1], y[1] := 3) 87 | x := 7 88 | write("g. ", x[2], y[2] := 3) # fails 89 | y := table() 90 | write("h. ", y[3], y[3] := 7) 91 | x := y 92 | write("i. ", x[5], y[5] := 8) 93 | local m := message("Horton") 94 | write("j. ", m.who, m.who := "Stanley") 95 | write("k. ", %stdin) 96 | } 97 | 98 | procedure dummy() { 99 | image(every 1) | 2 # this triggered a problem once upon a time. 100 | } 101 | 102 | procedure args(x[]) { # later replaced by proc("args",0) 103 | local s 104 | s := "" 105 | every s ||:= image(!x) do 106 | s ||:= " " 107 | return s[1:-1] | "" 108 | } 109 | 110 | procedure nullsuspend() { 111 | suspend 112 | suspend 113 | } 114 | -------------------------------------------------------------------------------- /tests/misc.std: -------------------------------------------------------------------------------- 1 | 2 2 | ~ 3 | b 4 | c 5 | e 6 | f 7 | g 8 | h 9 | ijk 10 | 23skidoo 11 | oob 12 | hello! 13 | mom! 14 | hello! 15 | mom! 16 | i=-4: failed 17 | i=-3: a 18 | i=-2: b 19 | i=-1: c 20 | i=0: failed 21 | i=1: a 22 | i=2: b 23 | i=3: c 24 | i=4: failed 25 | 1 26 | 2 27 | 3 28 | 4 29 | 5 30 | 6 31 | 1 32 | 5 33 | 9 34 | 10 35 | 30 36 | 50 37 | repl: xxxxyzxyzxyzxyz 38 | reverse: xba54321 39 | char: @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ 40 | argument evaluation test 41 | a. ~1 42 | b. 23 43 | c. 12345678903 44 | d. bq 45 | e. qqwerty 46 | f. 13 47 | h. ~7 48 | i. ~8 49 | j. HortonStanley 50 | k. f:%stdin 51 | nil 52 | nil 53 | OK to get here 54 | done 55 | -------------------------------------------------------------------------------- /tests/nspace.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | #INCL: nspack.gd 3 | # 4 | # nspace.gd -- namespace test 5 | 6 | global g1 := note("g1", 12) 7 | global g2 := pack::note("g2", 24) 8 | 9 | procedure main() { 10 | write("g1 = ", g1) 11 | write("g2 = ", g2) 12 | write("pack::gval = ", pack::gval) 13 | write("pack::glen = ", pack::glen) 14 | write("pack::n3(3) = ", pack::n3(3)) 15 | note("a",20) 16 | pack::note("b", 21) 17 | pack::run() 18 | ^x := pack::r(98,76) 19 | x.show() 20 | } 21 | 22 | initial { write("main initial") } 23 | 24 | procedure ilen(x) { 25 | ^s := image(x) 26 | write("ilen(", s, ") = ", *s) 27 | return *s 28 | } 29 | 30 | procedure note(label, value) { 31 | write("----- note(", label, ",", value, ")") 32 | return value 33 | } 34 | -------------------------------------------------------------------------------- /tests/nspace.std: -------------------------------------------------------------------------------- 1 | ----- note(g1,12) 2 | pack::note(g2,24) 3 | pack::note(gvinit,7) 4 | ilen(procedure pack::n3(n)) = 21 5 | main initial 6 | pack initial 7 | g1 = 12 8 | g2 = 24 9 | pack::gval = 7 10 | pack::glen = 21 11 | pack::n3(3) = 27 12 | ----- note(a,20) 13 | pack::note(b,21) 14 | pack::run here 15 | n3(4) = 64 16 | pack::note(run,47) 17 | r{a:12,b:34} 18 | r{a:98,b:76} 19 | -------------------------------------------------------------------------------- /tests/nspack.gd: -------------------------------------------------------------------------------- 1 | # nspack.gd -- a supplemental package for namespace testing 2 | 3 | package pack 4 | 5 | record r(a,b) 6 | 7 | procedure r.show() { write(image(self)) } 8 | 9 | global gval := note("gvinit", 7) 10 | 11 | global glen := ilen(n3) 12 | 13 | initial { write("pack initial") } 14 | 15 | procedure run() { 16 | write("pack::run here") 17 | write("n3(4) = ", n3(4)) 18 | note("run", 47) 19 | r(12,34).show() 20 | } 21 | 22 | procedure n3(n) { 23 | return n * n * n 24 | } 25 | 26 | procedure note(label, value) { 27 | write("pack::note(", label, ",", value, ")") 28 | return value 29 | } 30 | -------------------------------------------------------------------------------- /tests/numforms.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # test numeric conversion in both translator and runtime system 4 | 5 | procedure main() { 6 | write(" want transl string runconv") 7 | trynum( 0, 0, "0") 8 | trynum( 1, 1b, "1b") 9 | trynum( 7, 7o, "7o") 10 | trynum( 8, 9r8, "9r8") 11 | trynum( 15, 0Fx, "0Fx") 12 | trynum( 42, 42, "42") 13 | trynum( 42, 042, "042") 14 | trynum( 42, 042, " \t 042\t ") 15 | trynum( 42, 2r101010, "2r101010") 16 | trynum( 42, 101010b, "101010b") 17 | trynum( 42, 8r52, "8r52") 18 | trynum( 42, 52o, "52o") 19 | trynum( 42, 16r2A, "16r2A") 20 | trynum( 42, 2Ax, "2Ax") 21 | trynum( 42, 23r1J, "23r1J") 22 | trynum( 1295, 36rZz, "36rZz") 23 | trynum( 27183, 27183, "27183") 24 | trynum( 210,11010010b, "11010010b") 25 | trynum( 10039, 23467o, "23467o") 26 | trynum( 524095, 7Ff3Fx, "7Ff3Fx") 27 | trynum(6.02e23, 602e21, "602e21") 28 | trynum(6303265, 602e21x, "602e21x") 29 | trynum( .0123, 0.123e-1, "0.123e-1") 30 | trynum( 1123, 1.123e+3, "1.123e+3") 31 | trynum( .0123, .123e-1, ".123e-1") 32 | trynum( 1230, .123e+4, ".123e+4") 33 | trynum(123.456, 123.456, "123.456") 34 | trynum( 789, 789., "789.") 35 | } 36 | 37 | procedure trynum(want, n, s) { 38 | local sn := number(s) | nil 39 | writes(if n === want & sn === want then "Okay: " else "ERROR:") 40 | write(right(want,10), right(n,10), right(image(s), 14), right(sn, 10)) 41 | return 42 | } 43 | -------------------------------------------------------------------------------- /tests/numforms.std: -------------------------------------------------------------------------------- 1 | want transl string runconv 2 | Okay: 0 0 "0" 0 3 | Okay: 1 1 "1b" 1 4 | Okay: 7 7 "7o" 7 5 | Okay: 8 8 "9r8" 8 6 | Okay: 15 15 "0Fx" 15 7 | Okay: 42 42 "42" 42 8 | Okay: 42 42 "042" 42 9 | Okay: 42 42 " \t 042\t " 42 10 | Okay: 42 42 "2r101010" 42 11 | Okay: 42 42 "101010b" 42 12 | Okay: 42 42 "8r52" 42 13 | Okay: 42 42 "52o" 42 14 | Okay: 42 42 "16r2A" 42 15 | Okay: 42 42 "2Ax" 42 16 | Okay: 42 42 "23r1J" 42 17 | Okay: 1295 1295 "36rZz" 1295 18 | Okay: 27183 27183 "27183" 27183 19 | Okay: 210 210 "11010010b" 210 20 | Okay: 10039 10039 "23467o" 10039 21 | Okay: 524095 524095 "7Ff3Fx" 524095 22 | Okay: 6.02e+23 6.02e+23 "602e21" 6.02e+23 23 | Okay: 6303265 6303265 "602e21x" 6303265 24 | Okay: 0.0123 0.0123 "0.123e-1" 0.0123 25 | Okay: 1123 1123 "1.123e+3" 1123 26 | Okay: 0.0123 0.0123 ".123e-1" 0.0123 27 | Okay: 1230 1230 ".123e+4" 1230 28 | Okay: 123.5 123.5 "123.456" 123.5 29 | Okay: 789 789 "789." 789 30 | -------------------------------------------------------------------------------- /tests/numlib.std: -------------------------------------------------------------------------------- 1 | 2 | arithmetic: 3 | -1.618: abs()1.618 integer()-1 ceil()-1 floor()-2 log()NaN sqrt()NaN cbrt()-1.174 exp()0.1983 4 | 0: abs()0 integer()0 ceil()0 floor()0 log()-Inf sqrt()0 cbrt()0 exp()1 5 | 1: abs()1 integer()1 ceil()1 floor()1 log()0 sqrt()1 cbrt()1 exp()2.718 6 | 2: abs()2 integer()2 ceil()2 floor()2 log()0.6931 sqrt()1.414 cbrt()1.26 exp()7.389 7 | 2.718: abs()2.718 integer()2 ceil()3 floor()2 log()1 sqrt()1.649 cbrt()1.396 exp()15.15 8 | 3.142: abs()3.142 integer()3 ceil()4 floor()3 log()1.145 sqrt()1.772 cbrt()1.465 exp()23.14 9 | 10 | amean: 10.67 gmean: 5.194 hmean: 2.722 qmean: 16.59 11 | 12 | trigonometry: 13 | -1.618: sin()-0.9989 cos()-0.04722 tan()21.15 asin()NaN acos()NaN atan()-1.017 14 | 0: sin()0 cos()1 tan()0 asin()0 acos()1.571 atan()0 15 | 1: sin()0.8415 cos()0.5403 tan()1.557 asin()1.571 acos()0 atan()0.7854 16 | 2: sin()0.9093 cos()-0.4161 tan()-2.185 asin()NaN acos()NaN atan()1.107 17 | 2.718: sin()0.4108 cos()-0.9117 tan()-0.4505 asin()NaN acos()NaN atan()1.218 18 | 3.142: sin()1.225e-16 cos()-1 tan()-1.225e-16 asin()NaN acos()NaN atan()1.263 19 | 20 | hypertrigonometry: 21 | -1.618: sinh()-2.422 cosh()2.621 tanh()-0.9243 asinh()-1.259 acosh()NaN atanh()NaN 22 | 0: sinh()0 cosh()1 tanh()0 asinh()0 acosh()NaN atanh()0 23 | 1: sinh()1.175 cosh()1.543 tanh()0.7616 asinh()0.8814 acosh()0 atanh()+Inf 24 | 2: sinh()3.627 cosh()3.762 tanh()0.964 asinh()1.444 acosh()1.317 atanh()NaN 25 | 2.718: sinh()7.544 cosh()7.61 tanh()0.9913 asinh()1.725 acosh()1.657 atanh()NaN 26 | 3.142: sinh()11.55 cosh()11.59 tanh()0.9963 asinh()1.862 acosh()1.812 atanh()NaN 27 | hypot: 2:3:3.606 2:5:5.385 2:8:8.246 3:3:4.243 3:5:5.831 3:8:8.544 4:3:5 4:5:6.403 4:8:8.944 28 | dtortod: -45/-0.7854/-45 0/0/0 30/0.5236/30 60/1.047/60 90/1.571/90 114.6/2/114.6 180/3.142/180 29 | 30 | based logarithms: 31 | 0: log(,~)-Inf log(,2.718)-Inf log(,2)-Inf log(,4)-Inf log(,10)-Inf 32 | 1: log(,~)0 log(,2.718)0 log(,2)0 log(,4)0 log(,10)0 33 | 1.618: log(,~)0.4812 log(,2.718)0.4812 log(,2)0.6942 log(,4)0.3471 log(,10)0.209 34 | 2: log(,~)0.6931 log(,2.718)0.6931 log(,2)1 log(,4)0.5 log(,10)0.301 35 | 8: log(,~)2.079 log(,2.718)2.079 log(,2)3 log(,4)1.5 log(,10)0.9031 36 | 32: log(,~)3.466 log(,2.718)3.466 log(,2)5 log(,4)2.5 log(,10)1.505 37 | 100: log(,~)4.605 log(,2.718)4.605 log(,2)6.644 log(,4)3.322 log(,10)2 38 | 1012: log(,~)6.92 log(,2.718)6.92 log(,2)9.983 log(,4)4.991 log(,10)3.005 39 | 40 | atan2: 41 | (0,0)0 (0,2.718)0 (0,3.142)0 (1.618,0)1.571 (1.618,2.718)0.5369 (1.618,3.142)0.4756 (3.142,0)1.571 (3.142,2.718)0.8575 (3.142,3.142)0.7854 42 | 43 | gcd: 44 | a.0 b.1 c.3 d.5 e.3 f.3 g.3 h.3 i.3 j.2 k.6 l.1 m.0 45 | 46 | randgen: 47 | stdgen: 554 407 760 652 644 48 | randgen(nil): t:external : 99 99 418 325 692 49 | randgen(0): t:external : 99 99 418 325 692 50 | randgen(1): t:external : 878 636 407 983 895 51 | randgen(1): t:external : 878 636 407 983 895 52 | randgen(314159): t:external : 385 384 979 620 32 53 | stdgen: 554 407 760 652 644 54 | -------------------------------------------------------------------------------- /tests/parconj.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # test parallel conjunction (e1 && e2) 4 | 5 | procedure main() { 6 | local i 7 | local j 8 | local k 9 | every i := toby(1,3) && j := toby(4,5) do 10 | write(": ", i, j) 11 | every i := toby(1,3) && j := toby(4,6) do 12 | write(": ", i, j) 13 | every i := toby(1,3) && j := toby(4,7) do 14 | write(": ", i, j) 15 | every i := toby(1,3) && j := toby(4,5) && k := toby(6, 9) do 16 | write(": ", i, j, k) 17 | write() 18 | 1 && 0 # too simple -- this used to panic 19 | write("done") 20 | } 21 | 22 | procedure toby(i, j) { 23 | every local v := i to j do { 24 | writes(v, " ") 25 | suspend(v) 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /tests/parconj.std: -------------------------------------------------------------------------------- 1 | 1 4 : 14 2 | 2 5 : 25 3 | 3 1 4 : 14 4 | 2 5 : 25 5 | 3 6 : 36 6 | 1 4 : 14 7 | 2 5 : 25 8 | 3 6 : 36 9 | 1 4 6 : 146 10 | 2 5 7 : 257 11 | 3 12 | done 13 | -------------------------------------------------------------------------------- /tests/primes.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/primes.icn 2 | 3 | # a simple and slow prime number generator 4 | 5 | procedure main() { 6 | local i 7 | every i := 2 to 100 do { 8 | if i % (2 to i - 1) = 0 then 9 | continue 10 | write(i) 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /tests/primes.std: -------------------------------------------------------------------------------- 1 | 2 2 | 3 3 | 5 4 | 7 5 | 11 6 | 13 7 | 17 8 | 19 9 | 23 10 | 29 11 | 31 12 | 37 13 | 41 14 | 43 15 | 47 16 | 53 17 | 59 18 | 61 19 | 67 20 | 71 21 | 73 22 | 79 23 | 83 24 | 89 25 | 97 26 | -------------------------------------------------------------------------------- /tests/proto.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/proto.icn 2 | # This program contains samples of all the basic syntactic forms in Icon. 3 | # (Now modified somewhat for Goaldi but not necessarily complete.) 4 | 5 | record three(x,y,z) 6 | record zero() 7 | record one(z) 8 | 9 | global line 10 | global count 11 | 12 | procedure main() { 13 | write() 14 | } 15 | 16 | procedure expr1(a, b) { 17 | local x 18 | local y 19 | local i 20 | local j 21 | 22 | static e1 23 | /e1 := 0 24 | () 25 | {} 26 | ();() 27 | [] 28 | [,] 29 | x.y 30 | x[i] 31 | x[i:j] 32 | x[i+:j] 33 | x[i-:j] 34 | (,,,) 35 | x(,,,) 36 | x!y 37 | not x 38 | |x 39 | !x 40 | *x 41 | +x 42 | -x 43 | /x 44 | ?x 45 | \x 46 | @x 47 | } 48 | 49 | procedure expr2(a, b[]) { 50 | local x 51 | local y 52 | local i 53 | local j 54 | local k 55 | local c1 56 | local c2 57 | local s1 58 | local s2 59 | x \ i 60 | i ^ j 61 | i * j 62 | i / j 63 | i % j 64 | c1 ** c2 65 | i + j 66 | i - j 67 | c1 ++ c2 68 | c1 -- c2 69 | s1 || s2 70 | x ||| y 71 | i < j 72 | i <= j 73 | i = j 74 | i >= j 75 | i > j 76 | i ~= j 77 | s1 << s2 78 | s1 == s2 79 | s1 >>= s2 80 | s1 >> s2 81 | s1 ~== s2 82 | x === y 83 | x ~=== y 84 | x | y 85 | x ~| y 86 | i to j 87 | i to j by k 88 | x := y 89 | x <- y 90 | x :=: y 91 | x <-> y 92 | i +:= j 93 | i -:= j 94 | i *:= j 95 | i /:= j 96 | i %:= j 97 | i ^:= j 98 | i <:= j 99 | i <=:= j 100 | i =:= j 101 | i >=:= j 102 | i ~=:= j 103 | c1 ++:= c2 104 | c1 --:= c2 105 | c1 **:= c2 106 | s1 ||:= s2 107 | s1 <<:= s2 108 | s1 <<=:= s2 109 | s1 ==:= s2 110 | s1 >>=:= s2 111 | s1 >>:= s2 112 | s1 ~==:= s2 113 | x |||:= y 114 | x ===:= y 115 | x ~===:= y 116 | x &:= y 117 | x @: y 118 | x & y 119 | create x 120 | return 121 | return x 122 | suspend x 123 | suspend x do y 124 | } 125 | 126 | procedure expr4() { 127 | ^i; ^j; ^s; ^x 128 | local e; local e1; local e2; local e3 129 | 130 | while e1 do break 131 | # while e1 do break e2 132 | while e1 do continue 133 | case e of { 134 | x: return fail 135 | (i > j) | 1 : return 136 | } 137 | case *s of { 138 | 1: 1 139 | default: return fail 140 | } 141 | if e1 then e2 142 | if e1 then e2 else e3 143 | repeat e 144 | repeat e1 until e2 145 | while e1 146 | while e1 do e2 147 | every e1 148 | every e1 do e2 149 | } 150 | 151 | procedure expr9() { 152 | ^x 153 | x 154 | local X_ 155 | nil 156 | "abc" 157 | "\n" 158 | "^a" 159 | "\001" 160 | "\x01" 161 | 1 162 | 999999 163 | 36ra1 164 | 3.5 165 | 2.5e4 166 | 4e-10 167 | .127 168 | } 169 | -------------------------------------------------------------------------------- /tests/proto.std: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /tests/queens.std: -------------------------------------------------------------------------------- 1 | 6-Queens: 2 | solution: 1 3 | ------------------------- 4 | | | Q | | | | | 5 | ------------------------- 6 | | | | | Q | | | 7 | ------------------------- 8 | | | | | | | Q | 9 | ------------------------- 10 | | Q | | | | | | 11 | ------------------------- 12 | | | | Q | | | | 13 | ------------------------- 14 | | | | | | Q | | 15 | ------------------------- 16 | 17 | solution: 2 18 | ------------------------- 19 | | | | Q | | | | 20 | ------------------------- 21 | | | | | | | Q | 22 | ------------------------- 23 | | | Q | | | | | 24 | ------------------------- 25 | | | | | | Q | | 26 | ------------------------- 27 | | Q | | | | | | 28 | ------------------------- 29 | | | | | Q | | | 30 | ------------------------- 31 | 32 | solution: 3 33 | ------------------------- 34 | | | | | Q | | | 35 | ------------------------- 36 | | Q | | | | | | 37 | ------------------------- 38 | | | | | | Q | | 39 | ------------------------- 40 | | | Q | | | | | 41 | ------------------------- 42 | | | | | | | Q | 43 | ------------------------- 44 | | | | Q | | | | 45 | ------------------------- 46 | 47 | solution: 4 48 | ------------------------- 49 | | | | | | Q | | 50 | ------------------------- 51 | | | | Q | | | | 52 | ------------------------- 53 | | Q | | | | | | 54 | ------------------------- 55 | | | | | | | Q | 56 | ------------------------- 57 | | | | | Q | | | 58 | ------------------------- 59 | | | Q | | | | | 60 | ------------------------- 61 | 62 | -------------------------------------------------------------------------------- /tests/record.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/record.icn 2 | 3 | record simple(f) 4 | record rec(f1, f2) 5 | 6 | procedure main() { 7 | 8 | local a := rec() 9 | a.f1 := 1 10 | a.f2 := 2 11 | write("a1 ", a.f1, " ", a.f2) 12 | a := rec(3) 13 | a.f2 := 4 14 | write("a2 ", a.f1, " ", a.f2) 15 | a := rec(5,6) 16 | write("a3 ", a.f1, " ", a.f2) 17 | a.f1 := 7 18 | a.f2 := 8 19 | write("a4 ", a.f1, " ", a.f2) 20 | a := rec(9,10) 21 | write("a5 ", a.f1, " ", a.f2) 22 | a := rec(11, 12) 23 | every write("!a ", !a) 24 | every !a := 13 25 | write("a6 ", a.f2) 26 | 27 | local b := simple(14) 28 | write("*b ", *b) 29 | write("?b ", ?b) 30 | ?b := 15 31 | write("!b ",!b) 32 | 33 | b := rec(3, 7) 34 | every write("b[n] ", b[1 to 3]) 35 | every write("b[s] ", b["f" || (1 to 3)]) 36 | 37 | a := rec(1, 2) 38 | b := rec(3, 4) 39 | a.f1 +:= 10 40 | a.f2 +:= 20 41 | every !b +:= 70 42 | every writes(" ", !a | !b | "\n") 43 | 44 | local c := b.copy() 45 | b.f2 +:= 3 46 | write(image(a)) 47 | write(image(b)) 48 | write(image(c)) 49 | 50 | write(`simple["f"]: `, simple["f"]) 51 | write(`rec["f1"] `, rec["f1"]) 52 | write(`rec["f2"] `, rec["f2"]) 53 | write(`rec[2] `, rec[2]) 54 | write(`rec[-2] `, rec[-2]) 55 | write(`rec["2"] `, rec["2"]) 56 | write(`rec["-2"] `, rec["-2"]) 57 | } 58 | -------------------------------------------------------------------------------- /tests/record.std: -------------------------------------------------------------------------------- 1 | a1 1 2 2 | a2 3 4 3 | a3 5 6 4 | a4 7 8 5 | a5 9 10 6 | !a 11 7 | !a 12 8 | a6 13 9 | *b 1 10 | ?b 14 11 | !b 15 12 | b[n] 3 13 | b[n] 7 14 | b[s] 3 15 | b[s] 7 16 | 11 22 73 74 17 | rec{f1:11,f2:22} 18 | rec{f1:73,f2:77} 19 | rec{f1:73,f2:74} 20 | simple["f"]: 1 21 | rec["f1"] 1 22 | rec["f2"] 2 23 | rec[2] f2 24 | rec[-2] f1 25 | rec["2"] f2 26 | rec["-2"] f1 27 | -------------------------------------------------------------------------------- /tests/regex.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # regex demo 3 | 4 | procedure main() { 5 | # local c, v, p 6 | local c 7 | local v 8 | local p 9 | 10 | rex("a(x*)b(y|z)c", "-axxxbyc-", "-abzc-") 11 | rex("(a|bcdef|g|ab|c|d|e|efg|fg)*", "abcdefg", ) 12 | rex(`\d+(\.\d*)?(e\d+)?`, "5", "2.71", "3e9", "x59", "16r99", "eleven") 13 | v := "([aeiou]*)" 14 | c := "([bcdfghj-np-tv-z]*)" 15 | p := "p" || v || c || "ch" 16 | rex(p, "punch", "patch", "peach", "pitch", "porch", "pooch", "prunch", ) 17 | 18 | every ^rx := `\d` | `a\d` | `ab` | `\.\d+` do 19 | write("regex(", image(rx), ").LiteralPrefix => ", 20 | image(regex(rx).LiteralPrefix())) 21 | } 22 | 23 | procedure rex(expr, s[]) { 24 | local e 25 | if e := regex(expr) then every try(e, !s) else write("FAILED: ", expr) 26 | } 27 | 28 | procedure try(re, s) { 29 | local a 30 | writes(re, " : ", image(s), " :") 31 | if a := \re.FindStringSubmatch(s) then { 32 | every writes(" ", image(!a) | "\n") 33 | } else { 34 | write(" [no match]") 35 | } 36 | return 37 | } 38 | -------------------------------------------------------------------------------- /tests/regex.std: -------------------------------------------------------------------------------- 1 | a(x*)b(y|z)c : "-axxxbyc-" : "axxxbyc" "xxx" "y" 2 | a(x*)b(y|z)c : "-abzc-" : "abzc" "" "z" 3 | (a|bcdef|g|ab|c|d|e|efg|fg)* : "abcdefg" : "abcdefg" "g" 4 | \d+(\.\d*)?(e\d+)? : "5" : "5" "" "" 5 | \d+(\.\d*)?(e\d+)? : "2.71" : "2.71" ".71" "" 6 | \d+(\.\d*)?(e\d+)? : "3e9" : "3e9" "" "e9" 7 | \d+(\.\d*)?(e\d+)? : "x59" : "59" "" "" 8 | \d+(\.\d*)?(e\d+)? : "16r99" : "16" "" "" 9 | \d+(\.\d*)?(e\d+)? : "eleven" : [no match] 10 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "punch" : "punch" "u" "n" 11 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "patch" : "patch" "a" "t" 12 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "peach" : "peach" "ea" "" 13 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "pitch" : "pitch" "i" "t" 14 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "porch" : "porch" "o" "r" 15 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "pooch" : "pooch" "oo" "" 16 | p([aeiou]*)([bcdfghj-np-tv-z]*)ch : "prunch" : [no match] 17 | regex("\\d").LiteralPrefix => [,0] 18 | regex("a\\d").LiteralPrefix => [a,0] 19 | regex("ab").LiteralPrefix => [ab,1] 20 | regex("\\.\\d+").LiteralPrefix => [.,0] 21 | -------------------------------------------------------------------------------- /tests/runtest.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # runtest [name...] -- test Goaldi translator and intepreter 4 | 5 | # check for necessary binaries 6 | GOBIN=${GOPATH%%:*}/bin 7 | GOALDI=${GOALDI-goaldi} 8 | ls -l $GOALDI || exit 9 | 10 | # ensure scipt exits immediately on interrupt (needed on Mac) 11 | trap 'exit' INT 12 | 13 | # if no test files specified, run them all 14 | if [ $# = 0 ]; then 15 | set - *.std 16 | fi 17 | 18 | # loop through the chosen tests 19 | NTESTS=$# 20 | FAILURES= 21 | for F in $*; do 22 | F=`basename $F .std` 23 | F=`basename $F .gd` 24 | rm -f $F.gir $F.out $F.err 25 | printf "%-12s" $F: 26 | if test -r $F.dat; then 27 | exec <$F.dat 28 | else 29 | exec $F.out 2>$F.err; then 33 | if cmp -s $F.std $F.out; then 34 | echo "ok" 35 | rm $F.out 36 | test -s $F.err || rm $F.err 37 | rm -f $F*.tmp 38 | else 39 | echo "output differs" 40 | FAILURES="$FAILURES $F" 41 | fi 42 | elif [ $? = 125 ]; then 43 | echo "compilation error" 44 | FAILURES="$FAILURES $F" 45 | else 46 | echo "execution error" 47 | FAILURES="$FAILURES $F" 48 | fi 49 | done 50 | 51 | echo "" 52 | if [ "x$FAILURES" != "x" ]; then 53 | echo "Tests failed: $FAILURES" 54 | echo "" 55 | exit 1 56 | elif [ "$NTESTS" = "1" ]; then 57 | echo "1 test passed" 58 | echo "" 59 | exit 0 60 | else 61 | echo "All $NTESTS tests passed" 62 | echo "" 63 | exit 0 64 | fi 65 | -------------------------------------------------------------------------------- /tests/scoping.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # test nested scoping 4 | 5 | procedure main() { 6 | local x := 1 7 | static y := 2 8 | write("00. ", x, " ", y) 9 | every local i := !3 do { 10 | write(i, "a. ", x, " ", y) 11 | local x := 10 12 | /static y := 20 13 | write(i, "b. ", x, " ", y) 14 | x +:= 2 15 | y +:= 3 16 | write(i, "c. ", x, " ", y) 17 | } 18 | write("99. ", x, " ", y) 19 | local L := [] 20 | every local j := 1 to 4 do { 21 | local x := j 22 | local f := procedure () { return x } 23 | L.put(f) 24 | } 25 | every write("f: ", (!L)()) 26 | } 27 | -------------------------------------------------------------------------------- /tests/scoping.std: -------------------------------------------------------------------------------- 1 | 00. 1 2 2 | 1a. 1 2 3 | 1b. 10 20 4 | 1c. 12 23 5 | 2a. 1 2 6 | 2b. 10 23 7 | 2c. 12 26 8 | 3a. 1 2 9 | 3b. 10 26 10 | 3c. 12 29 11 | 99. 1 2 12 | f: 1 13 | f: 2 14 | f: 3 15 | f: 4 16 | -------------------------------------------------------------------------------- /tests/select.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # select test 4 | # 5 | # results are deterministic if the random number generator is predictable 6 | 7 | procedure main() { 8 | # local i, n, c1, c2, c3, c9 9 | local i 10 | local n 11 | local c1 12 | local c2 13 | local c3 14 | local c9 15 | 16 | every c1 | c2 | c9 := channel(1) 17 | c3 := channel(5) 18 | every i := !40 do { 19 | writes(i, ". ") 20 | select { 21 | n := @c1 : { write("c1 got ", n) } 22 | n := @c2 : { write("c2 got ", n); c1.put(n) } 23 | n := @c3 : { write("c3 got ", n); c2 @: n } 24 | c9 @: i : { write("c9 sent ", i) } 25 | default : { 26 | if ?4 === 0 then { 27 | write("c9 got ", @c9) 28 | } else { 29 | write("sending ", i) 30 | ?[c1, c2, c3] @: i 31 | } 32 | } 33 | } 34 | } 35 | every c3 @: 77 | 88 | 99 36 | drain("c1", c1) 37 | drain("c2", c2) 38 | drain("c3", c3) 39 | drain("c9", c9) 40 | select { 41 | n := @c1 : write("oops: closed c1 returned ", n) 42 | n := @c9 : write("oops: closed c9 returned ", n) 43 | default : write("ok: got default when files closed") 44 | } 45 | 46 | select { 47 | n := @c1 : write("oops: closed c1 returned ", n) 48 | n := @c9 : write("oops: closed c9 returned ", n) 49 | } | write("ok: no-default select failed as expected") 50 | 51 | write(select{} | "ok: empty select failed as expected") 52 | } 53 | 54 | procedure drain(name, ch) { 55 | ch.close() 56 | every writes(" ", " drain" | name | ":" | !ch | "\n") 57 | } 58 | -------------------------------------------------------------------------------- /tests/select.std: -------------------------------------------------------------------------------- 1 | 1. c9 sent 1 2 | 2. sending 2 3 | 3. c1 got 2 4 | 4. sending 4 5 | 5. c3 got 4 6 | 6. c2 got 4 7 | 7. c1 got 4 8 | 8. sending 8 9 | 9. c1 got 8 10 | 10. c9 got 1 11 | 11. c9 sent 11 12 | 12. c9 got 11 13 | 13. c9 sent 13 14 | 14. c9 got 13 15 | 15. c9 sent 15 16 | 16. sending 16 17 | 17. c3 got 16 18 | 18. c2 got 16 19 | 19. c1 got 16 20 | 20. sending 20 21 | 21. c1 got 20 22 | 22. sending 22 23 | 23. c2 got 22 24 | 24. c1 got 22 25 | 25. sending 25 26 | 26. c1 got 25 27 | 27. sending 27 28 | 28. c3 got 27 29 | 29. c2 got 27 30 | 30. c1 got 27 31 | 31. c9 got 15 32 | 32. c9 sent 32 33 | 33. c9 got 32 34 | 34. c9 sent 34 35 | 35. sending 35 36 | 36. c3 got 35 37 | 37. c2 got 35 38 | 38. c1 got 35 39 | 39. sending 39 40 | 40. c1 got 39 41 | drain c1 : 42 | drain c2 : 43 | drain c3 : 77 88 99 44 | drain c9 : 34 45 | ok: got default when files closed 46 | ok: no-default select failed as expected 47 | ok: empty select failed as expected 48 | -------------------------------------------------------------------------------- /tests/sets1.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # Test set operations 4 | 5 | procedure main() { 6 | testset("empty", set()) 7 | testset("pidigits", ^S := set([3,1,4,1,5])) 8 | testset("nodelete", S.delete()) 9 | testset("delete", S.delete(3,7,5)) 10 | testset("noput", S.put()) 11 | testset("put", S.put(4, 7,9)) 12 | testset("delete", S.delete(9, 1)) 13 | testset("put", S.put(2,4,6,8)) 14 | testset("delete", S.delete(2,5,7,9)) 15 | testset("S@:x", S @: 3 & S @: 1 & S) 16 | testset("strings", set(["three","one","four","one","five"])) 17 | testset("mixed", set([,1,"two",channel(3),%stdin,type,main])) 18 | every ^S2 := set([] | [0,2,4,6,8]) do { 19 | every ^S3 := set([] | [0,3,6,9]) do { 20 | write("S2 = ", image(S2), " S3 = ", image(S3)) 21 | testset("S2 ++ S3", S2 ++ S3) 22 | testset("S2 -- S3", S2 -- S3) 23 | testset("S2 ** S3", S2 ** S3) 24 | } 25 | } 26 | } 27 | 28 | # print set contents and run some tests 29 | procedure testset(label, S) { 30 | # show label, short string, size, and image 31 | writes(left((label || ":"), 10), S, " (", *S, ") ", image(S), " :") 32 | # look for and print small numbers (two different ways) 33 | every writes(" ", S.member(0 to 9)) 34 | writes(" :") 35 | every writes(" ", S[0 to 9]) 36 | write() 37 | 38 | # run some tests and print error if results don't match 39 | cksame("not self", S, S) 40 | cksame("copy(S)", S, copy(S)) 41 | cksame("S.copy()", S, S.copy()) 42 | cksame("S.sort()", S, set(S.sort())) 43 | ^L := [] 44 | every L.put(!S) 45 | cksame("!S", S, set(L)) 46 | L := [] 47 | ^S2 := S.copy() 48 | while L.put(@S2) 49 | cksame("@S", S, set(L)) 50 | L := [] 51 | S2 := set() 52 | while *S2 < *S do 53 | S2.put(?S) 54 | cksame("?S", S, S2) 55 | } 56 | 57 | # check that two sets are the same by comparing their images 58 | procedure cksame(label, S1, S2) { 59 | ^im1 := image(S1) 60 | ^im2 := image(S2) 61 | if im1 ~== im2 then { 62 | write(" ERROR: ", label, ": ", im1, " ~=== ", im2) 63 | } 64 | } 65 | -------------------------------------------------------------------------------- /tests/sets1.std: -------------------------------------------------------------------------------- 1 | empty: S:0 (0) set{} : : 2 | pidigits: S:4 (4) set{1,3,4,5} : 1 3 4 5 : 1 3 4 5 3 | nodelete: S:4 (4) set{1,3,4,5} : 1 3 4 5 : 1 3 4 5 4 | delete: S:2 (2) set{1,4} : 1 4 : 1 4 5 | noput: S:2 (2) set{1,4} : 1 4 : 1 4 6 | put: S:4 (4) set{1,4,7,9} : 1 4 7 9 : 1 4 7 9 7 | delete: S:2 (2) set{4,7} : 4 7 : 4 7 8 | put: S:5 (5) set{2,4,6,7,8} : 2 4 6 7 8 : 2 4 6 7 8 9 | delete: S:3 (3) set{4,6,8} : 4 6 8 : 4 6 8 10 | S@:x: S:5 (5) set{1,3,4,6,8} : 1 3 4 6 8 : 1 3 4 6 8 11 | strings: S:4 (4) set{five,four,one,three} : : 12 | mixed: S:7 (7) set{~,t:type,1,two,f:%stdin,c:3,p:main} : 1 : 1 13 | S2 = set{} S3 = set{} 14 | S2 ++ S3: S:0 (0) set{} : : 15 | S2 -- S3: S:0 (0) set{} : : 16 | S2 ** S3: S:0 (0) set{} : : 17 | S2 = set{} S3 = set{0,3,6,9} 18 | S2 ++ S3: S:4 (4) set{0,3,6,9} : 0 3 6 9 : 0 3 6 9 19 | S2 -- S3: S:0 (0) set{} : : 20 | S2 ** S3: S:0 (0) set{} : : 21 | S2 = set{0,2,4,6,8} S3 = set{} 22 | S2 ++ S3: S:5 (5) set{0,2,4,6,8} : 0 2 4 6 8 : 0 2 4 6 8 23 | S2 -- S3: S:5 (5) set{0,2,4,6,8} : 0 2 4 6 8 : 0 2 4 6 8 24 | S2 ** S3: S:0 (0) set{} : : 25 | S2 = set{0,2,4,6,8} S3 = set{0,3,6,9} 26 | S2 ++ S3: S:7 (7) set{0,2,3,4,6,8,9} : 0 2 3 4 6 8 9 : 0 2 3 4 6 8 9 27 | S2 -- S3: S:3 (3) set{2,4,8} : 2 4 8 : 2 4 8 28 | S2 ** S3: S:2 (2) set{0,6} : 0 6 : 0 6 29 | -------------------------------------------------------------------------------- /tests/sets2.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/sets.icn 2 | 3 | # set test 4 | 5 | procedure main() { 6 | local x 7 | local y 8 | local z 9 | 10 | wset("empty", x := set()) 11 | write(type(x)) 12 | write(image(?x)) # should fail 13 | write(image(x.member())) # should fail 14 | wset("put", x.put(nil)) 15 | write(image(?x)) # should write nil 16 | write(image(x.member())) # should write nil 17 | write(image(x.member(3))) # should write nil 18 | wset("put", x.put()) 19 | wset("delete", x.delete()) 20 | wset("delete", x.delete()) 21 | write() 22 | 23 | wset("x", x := set([1,2,4])) 24 | wset("y", y := set([1,2,5])) 25 | wset("x ++ y", x ++ y) 26 | wset("y ++ x", y ++ x) 27 | wset("x -- y", x -- y) 28 | wset("y -- x", y -- x) 29 | wset("x ** y", x ** y) 30 | wset("y ** x", y ** x) 31 | write() 32 | 33 | wset("empty", x := set(nil)) 34 | wset("+ 1", x.put(1)) # only inserts 1 35 | wset("+ 2", x.put(2)) 36 | wset("+ c", x.put("c")) 37 | wset("- 3", x.delete(3)) # deletes nothing 38 | wset("- 1", x.delete(1)) # only deletes 1 39 | wset("- 1", x.delete(1)) 40 | wset("+ 2", x.put(2)) 41 | wset("+ 1", x.put(1)) 42 | wset("+ 7.0", x.put(7.0)) 43 | wset("+ 7.0", x.put(7.0)) 44 | wset(`+ "cs"`, x.put("cs")) 45 | wset(`+ "cs"`, x.put("cs")) 46 | wset("x =", x) 47 | write() 48 | 49 | wset("3,a,4", y := set([3,"a",4])) 50 | wset("y ++ x", y ++ x) 51 | wset("y ** x", y ** x) 52 | wset("y -- x", y -- x) 53 | wset("x -- y", x -- y) 54 | write() 55 | 56 | every (z := set()).put(!y) 57 | wset("z from !y", z) 58 | 59 | write() 60 | x := set([3,1,4,1,5,9,2,6,5,3,5]) 61 | y := copy(x) 62 | x.delete(4) 63 | x.put(7) 64 | y.put(0) 65 | y.delete(1) 66 | wset("x", x) 67 | wset("y", y) 68 | } 69 | 70 | 71 | 72 | # dump a set, assuming it contains nothing other than: 73 | # nil, 0 - 9, "", "a" - "e", "cs" 74 | 75 | procedure wset(label, S) { 76 | local x 77 | 78 | writes(right(label, 10), " :", right(*S, 2), " :") 79 | every x := nil | (0 to 9) | "" | !"abcde" | "cs" do 80 | writes(" ", image(S.member(x))) 81 | write() 82 | return 83 | } 84 | -------------------------------------------------------------------------------- /tests/sets2.std: -------------------------------------------------------------------------------- 1 | empty : 0 : 2 | t:set 3 | put : 1 : nil 4 | nil 5 | nil 6 | put : 1 : nil 7 | delete : 1 : nil 8 | delete : 1 : nil 9 | 10 | x : 3 : 1 2 4 11 | y : 3 : 1 2 5 12 | x ++ y : 4 : 1 2 4 5 13 | y ++ x : 4 : 1 2 4 5 14 | x -- y : 1 : 4 15 | y -- x : 1 : 5 16 | x ** y : 2 : 1 2 17 | y ** x : 2 : 1 2 18 | 19 | empty : 0 : 20 | + 1 : 1 : 1 21 | + 2 : 2 : 1 2 22 | + c : 3 : 1 2 "c" 23 | - 3 : 3 : 1 2 "c" 24 | - 1 : 2 : 2 "c" 25 | - 1 : 2 : 2 "c" 26 | + 2 : 2 : 2 "c" 27 | + 1 : 3 : 1 2 "c" 28 | + 7.0 : 4 : 1 2 7 "c" 29 | + 7.0 : 4 : 1 2 7 "c" 30 | + "cs" : 5 : 1 2 7 "c" "cs" 31 | + "cs" : 5 : 1 2 7 "c" "cs" 32 | x = : 5 : 1 2 7 "c" "cs" 33 | 34 | 3,a,4 : 3 : 3 4 "a" 35 | y ++ x : 8 : 1 2 3 4 7 "a" "c" "cs" 36 | y ** x : 0 : 37 | y -- x : 3 : 3 4 "a" 38 | x -- y : 5 : 1 2 7 "c" "cs" 39 | 40 | z from !y : 3 : 3 4 "a" 41 | 42 | x : 7 : 1 2 3 5 6 7 9 43 | y : 7 : 0 2 3 4 5 6 9 44 | -------------------------------------------------------------------------------- /tests/sieve.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/sieve.icn 2 | # 3 | # S I E V E O F E R A T O S T H E N E S 4 | # 5 | 6 | # This program illustrates the use of tables as sets in implementing the 7 | # classical sieve algorithm for computing prime numbers. 8 | 9 | procedure main(limit) { 10 | # local s, i 11 | local s 12 | local i 13 | 14 | /limit := 100 15 | s := table() 16 | every s[2 to limit] := 1 17 | every s.member(i := 2 to limit) do 18 | every s.delete(i + i to limit by i) 19 | write("In the first ", limit, " integers there are ", *s, " primes:") 20 | every write((!s.sort()).key) 21 | } 22 | -------------------------------------------------------------------------------- /tests/sieve.std: -------------------------------------------------------------------------------- 1 | In the first 100 integers there are 25 primes: 2 | 2 3 | 3 4 | 5 5 | 7 6 | 11 7 | 13 8 | 17 9 | 19 10 | 23 11 | 29 12 | 31 13 | 37 14 | 41 15 | 43 16 | 47 17 | 53 18 | 59 19 | 61 20 | 67 21 | 71 22 | 73 23 | 79 24 | 83 25 | 89 26 | 97 27 | -------------------------------------------------------------------------------- /tests/simple.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | procedure main() { 3 | local i 4 | local s 5 | local n 6 | local p 7 | local x 8 | # local i, s, n, p, x 9 | 10 | println("hello", 47, 3.14159) 11 | 12 | i := sqrt(2) 13 | s := "abc" 14 | n := nil 15 | p := main 16 | every x := i | s | n | p do 17 | println(x, type(x), image(x)) 18 | 19 | every write (1 | 2 | 3) 20 | every write (4 to 6) 21 | write(p1()) 22 | every write(p1()) 23 | every write(p2()) 24 | p3(11,12,13) 25 | every writes (!12 | "\n") 26 | every writes ((!12 \ 5) | "\n") 27 | every 1 to 5 do write(?0) 28 | every writes (" ", (!27) | "\n") 29 | every writes (" ", ?(!27) | "\n") 30 | every writes (" ", (!27 & ?100) | "\n") 31 | every i := -5 to +5 do 32 | write (i, i("a","b","c","d") | "--") 33 | 34 | writes("seq") 35 | every writes(" ", ":" | seq() \ 3) 36 | every writes(" ", ":" | seq(5) \ 3) 37 | every writes(" ", ":" | seq(10, 2) \ 3) 38 | every writes(" ", ":" | seq(, 17) \ 3) 39 | every writes(" ", ":" | seq(2.5, .375) \ 5) 40 | write() 41 | 42 | every writes(" a", !3 | !3) 43 | every writes(" b", !3 ~| !3) 44 | every writes(" c", !1 ~| !3) 45 | every writes(" d", !0 ~| !3) 46 | every writes(" e", !3 ~| !0) 47 | every writes(" f", 1 | 2 ~| 3 | 4 ~| 5 | 6) 48 | every writes(" g", no() | 2 ~| 3 | 4 ~| 5 | 6) 49 | every writes(" h", no() | no() ~| 3 | 4 ~| 5 | 6) 50 | every writes(" i", no() | no() ~| no() | 4 ~| 5 | 6) 51 | every writes(" j", no() | no() ~| no() | no() ~| 5 | 6) 52 | every writes(" k", no() | no() ~| no() | no() ~| no() | 6) 53 | every writes(" l", no() | no() ~| no() | no() ~| no() | no()) 54 | write() 55 | 56 | p4() 57 | p4(1) 58 | p4(2,3) 59 | p4(4,5,6) 60 | p4(7,8,9,10) 61 | p4(11,22,31,41,59,26,535) 62 | } 63 | 64 | procedure p1() { 65 | return 7 66 | } 67 | 68 | procedure p2() { 69 | suspend 7 | 8 | 9 70 | } 71 | 72 | procedure p3(a,b,c) { 73 | write(a,b,c) 74 | } 75 | 76 | procedure p4(a,b,c[]) 77 | { 78 | write("p4: ", image(a), " ", image(b), " ", image(c)) 79 | } 80 | 81 | procedure no(){} # always just fails 82 | -------------------------------------------------------------------------------- /tests/simple.std: -------------------------------------------------------------------------------- 1 | hello 47 3.142 2 | 1.414 t:number 1.4142135623730951 3 | abc t:string "abc" 4 | ~ t:nil nil 5 | p:main t:procedure procedure main() 6 | 1 7 | 2 8 | 3 9 | 4 10 | 5 11 | 6 12 | 7 13 | 7 14 | 7 15 | 8 16 | 9 17 | 111213 18 | 123456789101112 19 | 12345 20 | 0.6047 21 | 0.9405 22 | 0.6646 23 | 0.4377 24 | 0.4246 25 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 26 | 0 0 0 0 1 3 5 1 3 3 5 3 3 9 3 3 6 10 16 5 6 16 4 20 17 13 0 27 | 15 60 97 7 59 5 69 30 17 54 54 27 42 53 25 28 78 36 88 29 89 9 97 7 22 68 24 28 | -5-- 29 | -4a 30 | -3b 31 | -2c 32 | -1d 33 | 0-- 34 | 1a 35 | 2b 36 | 3c 37 | 4d 38 | 5-- 39 | seq : 1 2 3 : 5 6 7 : 10 12 14 : 1 18 35 : 2.5 2.875 3.25 3.625 4 40 | a1 a2 a3 a1 a2 a3 b1 b2 b3 c1 d1 d2 d3 e1 e2 e3 f1 f2 g2 h3 h4 i4 j5 j6 k6 41 | p4: nil nil [] 42 | p4: 1 nil [] 43 | p4: 2 3 [] 44 | p4: 4 5 [6] 45 | p4: 7 8 [9,10] 46 | p4: 11 22 [31,41,59,26,535] 47 | -------------------------------------------------------------------------------- /tests/sort1.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # test of L.sort() and M.sort() 4 | 5 | procedure main() { 6 | # local a, b, c, n, l, m 7 | local a 8 | local b 9 | local c 10 | local n 11 | local l 12 | local m 13 | 14 | a := [3,1,4,1,5,9,2,6,5,3,5] 15 | write("a1: ", image(a)) 16 | write("a2: ", image(a.sort())) 17 | 18 | b := [:!"cowabunga,dude!":] 19 | write("b1: ", image(b)) 20 | write("b2: ", image(b.sort())) 21 | 22 | m := table() 23 | every n := !8 do 24 | m[n * 97 % 61] := n * 71 % 43 25 | write("m0: ", image(m)) 26 | show("l!:", l := [:!m:].sort()) 27 | show("l0:", l.sort()) 28 | show("l1:", l.sort(1)) 29 | show("l2:", l.sort(2)) 30 | show("m1:", m.sort(1)) 31 | show("m2:", m.sort(2)) 32 | } 33 | 34 | procedure show(label, kvlist) { 35 | local kv 36 | writes(label) 37 | every kv := !kvlist do 38 | writes(" ", kv.key, ":", kv.value) 39 | return write() 40 | } 41 | -------------------------------------------------------------------------------- /tests/sort1.std: -------------------------------------------------------------------------------- 1 | a1: [3,1,4,1,5,9,2,6,5,3,5] 2 | a2: [1,1,2,3,3,4,5,5,5,6,9] 3 | b1: [c,o,w,a,b,u,n,g,a,,,d,u,d,e,!] 4 | b2: [!,,,a,a,b,c,d,d,e,g,n,o,u,u,w] 5 | m0: table{8:24,11:13,22:26,33:39,36:28,44:9,47:41,58:11} 6 | l!: 8:24 11:13 22:26 33:39 36:28 44:9 47:41 58:11 7 | l0: 8:24 11:13 22:26 33:39 36:28 44:9 47:41 58:11 8 | l1: 8:24 11:13 22:26 33:39 36:28 44:9 47:41 58:11 9 | l2: 44:9 58:11 11:13 8:24 22:26 36:28 33:39 47:41 10 | m1: 8:24 11:13 22:26 33:39 36:28 44:9 47:41 58:11 11 | m2: 44:9 58:11 11:13 8:24 22:26 36:28 33:39 47:41 12 | -------------------------------------------------------------------------------- /tests/stdlib.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # test miscellaneous library functions 3 | 4 | procedure main() { 5 | testprint() 6 | write("\nstrings:") 7 | every teststring("aBc" | "d33" | 47 | 3) 8 | write("\nconversion:") 9 | every testcnv(nil | "" | "abc" | "12" | "23.4" | 0 | 1 | 10 | %phi | %e | %pi | %stdin | %stdout | %stderr) 11 | testcommand() 12 | exit() 13 | } 14 | 15 | procedure testprint() { 16 | writes("ab", 34, "ef", %phi) 17 | write("gh", 90, "kl", %pi) 18 | print("mn", 37, "qr", %phi) 19 | println("st", 25, "uv", 0) 20 | write("543210") 21 | printf("%10.3f %g %.0f %s\n", %phi, %pi, 12345, "abcde") 22 | fprintf(%stdout, "%10.3f %g %.0f %s\n", %phi, %pi, 12345, "abcde") 23 | write(image(sprintf("%.4f", %e))) 24 | } 25 | 26 | procedure teststring(v) { 27 | writes(v, ":") 28 | apply(equalfold, v, "3") 29 | apply(repl, v, "3") 30 | apply(toupper, v) 31 | apply(tolower, v) 32 | apply(trim, v, "3") 33 | write() 34 | return 35 | } 36 | 37 | procedure testcnv(v) { 38 | writes(v, ":") 39 | every apply(type | image | number | string, v) 40 | write() 41 | return 42 | } 43 | 44 | procedure apply(p, x, y) { 45 | local v := (if \y then p(x,y) else p(x)) | "--" 46 | writes(" ", string(p)[3:0], "()", v) 47 | return 48 | } 49 | 50 | procedure testcommand() { 51 | write("\ncommand():") 52 | ^c := command("echo", "hello", "world") 53 | c.Stdout := %stdout 54 | c.Stderr := %stderr 55 | write("command: ", c.Path, " ", c.Args) 56 | ^r := c.Run() 57 | write("result: ", image(r)) 58 | write("state: ", c.ProcessState) 59 | } 60 | -------------------------------------------------------------------------------- /tests/stdlib.std: -------------------------------------------------------------------------------- 1 | ab34ef1.618gh90kl3.142 2 | mn 37 qr 1.618st 25 uv 0 3 | 543210 4 | 1.618 3.141592653589793 12345 abcde 5 | 1.618 3.141592653589793 12345 abcde 6 | "2.7183" 7 | 8 | strings: 9 | aBc: equalfold()0 repl()aBcaBcaBc toupper()ABC tolower()abc trim()aBc 10 | d33: equalfold()0 repl()d33d33d33 toupper()D33 tolower()d33 trim()d 11 | 47: equalfold()0 repl()474747 toupper()47 tolower()47 trim()47 12 | 3: equalfold()1 repl()333 toupper()3 tolower()3 trim() 13 | 14 | conversion: 15 | ~: type()t:nil image()nil number()-- string()~ 16 | : type()t:string image()"" number()-- string() 17 | abc: type()t:string image()"abc" number()-- string()abc 18 | 12: type()t:string image()"12" number()12 string()12 19 | 23.4: type()t:string image()"23.4" number()23.4 string()23.4 20 | 0: type()t:number image()0 number()0 string()0 21 | 1: type()t:number image()1 number()1 string()1 22 | 1.618: type()t:number image()1.618033988749895 number()1.618 string()1.618 23 | 2.718: type()t:number image()2.718281828459045 number()2.718 string()2.718 24 | 3.142: type()t:number image()3.141592653589793 number()3.142 string()3.142 25 | f:%stdin: type()t:file image()file(%stdin,r) number()-- string()f:%stdin 26 | f:%stdout: type()t:file image()file(%stdout,w) number()-- string()f:%stdout 27 | f:%stderr: type()t:file image()file(%stderr,wn) number()-- string()f:%stderr 28 | 29 | command(): 30 | command: /bin/echo [echo hello world] 31 | hello world 32 | result: nil 33 | state: exit status 0 34 | -------------------------------------------------------------------------------- /tests/string1.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/string1.icn 2 | 3 | # string test -- including operations on string *constants* 4 | 5 | procedure main() { 6 | # local s, t 7 | local s 8 | local t 9 | 10 | s := "abcde" 11 | write("type ", type(s)) 12 | write("*s ", *s) 13 | write("s: ", s) 14 | write("s: ", image(s)) 15 | every writes("!: " | !s | "\n") 16 | every writes("1: " | s[1 to 5] | "\n") 17 | every writes("0: " | s[0 to 7] | "\n") 18 | every writes("-5: " | s[-5 to -1] | "\n") 19 | every writes("-7: " | s[-7 to -0] | "\n") 20 | 21 | write("s1: ", s[1:6]); 22 | write("s2: ", s[1+:5]); 23 | write("s3: ", s[1-:-5]); 24 | write("s4: ", s[1:0]); 25 | write("s5: ", s[-5:0]); 26 | write("s6: ", s[6:1]); 27 | write("s7: ", s[0:-5]); 28 | write("s8: ", s[2:4]); 29 | write("s9: ", s[-2:-4]); 30 | 31 | write("k1: ","ABCDE"[1:6]); 32 | write("k2: ","ABCDE"[1+:5]); 33 | write("k3: ","ABCDE"[1-:-5]); 34 | write("k4: ","ABCDE"[1:0]); 35 | write("k5: ","ABCDE"[-5:0]); 36 | write("k6: ","ABCDE"[6:1]); 37 | write("k7: ","ABCDE"[0:-5]); 38 | write("k8: ","ABCDE"[2:4]); 39 | write("k9: ","ABCDE"[-2:-4]); 40 | 41 | t := "abc" || "de" 42 | write("t: ", image(t)) 43 | (s === t) | write("not ===") 44 | (s ~=== t) & write("are ~===") 45 | 46 | write("?x: ", ?"x") 47 | write("?y: ", ?"yyyyyyyyyyy") 48 | write("?z: ", ?"" | "nope") # should "nope" 49 | 50 | write("c1: ", image("" || "")) 51 | write("c2: ", image("a" || "")) 52 | write("c3: ", image("" || "b")) 53 | write("c4: ", image("cd" || "ef")) 54 | write("c5: ", image(3.14 || 159)) 55 | #write("c6: ", image('abc' || 'def')) 56 | 57 | write("@1: ", s := "wxyz") 58 | while ^c := @s do write("@2: ", c, " + ", s) 59 | write("@3: ", s) 60 | every write("\t", image(s @: "" | "a" | "bc" | !"def" | 47)) do 61 | write("@4:", s) 62 | } 63 | -------------------------------------------------------------------------------- /tests/string1.std: -------------------------------------------------------------------------------- 1 | type t:string 2 | *s 5 3 | s: abcde 4 | s: "abcde" 5 | !: abcde 6 | 1: abcde 7 | 0: abcde 8 | -5: abcde 9 | -7: abcde 10 | s1: abcde 11 | s2: abcde 12 | s3: abcde 13 | s4: abcde 14 | s5: abcde 15 | s6: abcde 16 | s7: abcde 17 | s8: bc 18 | s9: bc 19 | k1: ABCDE 20 | k2: ABCDE 21 | k3: ABCDE 22 | k4: ABCDE 23 | k5: ABCDE 24 | k6: ABCDE 25 | k7: ABCDE 26 | k8: BC 27 | k9: BC 28 | t: "abcde" 29 | ?x: x 30 | ?y: y 31 | ?z: nope 32 | c1: "" 33 | c2: "a" 34 | c3: "b" 35 | c4: "cdef" 36 | c5: "3.14159" 37 | @1: wxyz 38 | @2: w + xyz 39 | @2: x + yz 40 | @2: y + z 41 | @2: z + 42 | @3: 43 | "" 44 | @4: 45 | "a" 46 | @4:a 47 | "bc" 48 | @4:abc 49 | "d" 50 | @4:abcd 51 | "e" 52 | @4:abcde 53 | "f" 54 | @4:abcdef 55 | "47" 56 | @4:abcdef47 57 | -------------------------------------------------------------------------------- /tests/strlib.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | procedure main() { 3 | # local i, c1, c2, n1, n2, el, f 4 | local i 5 | local c1 6 | local c2 7 | local n1 8 | local n2 9 | local el 10 | local f 11 | 12 | el := "argon, boron, carbon, freon, krypton, silicon, teflon" 13 | write("repl: ", repl("la, ", 11), "hey Jude") 14 | every write("reverse: ", reverse("abcde"[1+:(0 to 6)]) | "--") 15 | every write("tolower: ", tolower("AbCdE")) 16 | every write("toupper: ", toupper("AbCdE")) 17 | writes("fields: "); every writes(" ", image(!fields(el)) | "\n") 18 | writes("split: "); every writes(" ", image(!split(el, ", ")) | "\n") 19 | 20 | write() 21 | every i := 0 | 1 | 33 | 100 | 200 | 300 | 1000 | 10000 | 100000 do { 22 | c1 := char(i) 23 | n1 := ord(c1) 24 | c2 := char(n1) 25 | n2 := ord(c2) 26 | println("char/ord:", i, image(c1), n1, image(c2), n2) 27 | } 28 | 29 | local s 30 | local pad 31 | local proc 32 | local w 33 | write() 34 | every s := "" | "*" | "xy" | "abc" do { 35 | every proc := left | center | right do { 36 | writes("pad:") 37 | every pad := "-" | "123" do { 38 | writes(" ") 39 | every w := 0 to 7 do { 40 | writes(" ", proc(s,w,pad)) 41 | } 42 | } 43 | write() 44 | } 45 | } 46 | 47 | write() 48 | tryquote(`"abc"`) 49 | tryquote("`abc`") 50 | tryquote(`"abc\tdef"`) 51 | tryquote("`abc\tdef`") 52 | tryquote("`t0±Δt`") 53 | tryquote(`"t0±Δt"`) 54 | tryquote("abc") 55 | tryquote(`"ab`) 56 | tryquote("`ab") 57 | tryquote(`"ab\fyz"`) 58 | tryquote(`"ab\kyz"`) 59 | tryquote(`"ab\"`) 60 | 61 | write() 62 | write("map: ", map("aBcDeF")) 63 | write("map: ", map("AbCdEf")) 64 | write("map: ", map("aBcDeF", "abcdefghijklmnopqrstuvwxyz")) 65 | write("map: ", map("AbCdEf", "abcdefghijklmnopqrstuvwxyz")) 66 | write("map: ", map("aBcDeF", , "12345678901234567890123456")) 67 | write("map: ", map("AbCdEf", , "12345678901234567890123456")) 68 | write("map: ", map("aBcDeF", "abcdef", "!@#$%^")) 69 | write("map: ", map("AbCdEf", "abcdef", "!@#$%^")) 70 | write("map: ", map("", "abcdef", "!@#$%^")) 71 | write("map: ", map("abcdef", "aa", "bc")) 72 | write("map: ", map("Capitals Make A Title Or Slogan More Important")) 73 | write("map: ", map("but not too many!!!!", "abmnotuy", "ABMNOTUY")) 74 | write("map: ", map("If you can read this you can get a good job", "aeiou", "")) 75 | write("map: ", map("♠♥♦♣")) 76 | write("map: ", map("SDHC♠♥♦♣","♠♥♦♣","SHDC")) 77 | write("map: ", map("SDHC♠♥♦♣", "SHDC", "♠♥♦♣")) 78 | write("map: ", map("123456", "654321", "abcdef")) 79 | write("map: ", map("124578", "12345678", "03:56:42")) 80 | write("map: ", map("Hh:Mm:Ss", "HhMmSs", "035642")) 81 | write("map: ", map("123321", "123", "abc")) 82 | } 83 | 84 | procedure tryquote(a) { 85 | ^b := unquote(a) | "[FAILED]" 86 | ^c := quote(b) 87 | write("quoting: ", a, " => ", image(b), " => " ,c) 88 | } 89 | -------------------------------------------------------------------------------- /tests/strlib.std: -------------------------------------------------------------------------------- 1 | repl: la, la, la, la, la, la, la, la, la, la, la, hey Jude 2 | reverse: 3 | reverse: a 4 | reverse: ba 5 | reverse: cba 6 | reverse: dcba 7 | reverse: edcba 8 | reverse: -- 9 | tolower: abcde 10 | toupper: ABCDE 11 | fields: "argon," "boron," "carbon," "freon," "krypton," "silicon," "teflon" 12 | split: "argon" "boron" "carbon" "freon" "krypton" "silicon" "teflon" 13 | 14 | char/ord: 0 "\x00" 0 "\x00" 0 15 | char/ord: 1 "\x01" 1 "\x01" 1 16 | char/ord: 33 "!" 33 "!" 33 17 | char/ord: 100 "d" 100 "d" 100 18 | char/ord: 200 "È" 200 "È" 200 19 | char/ord: 300 "Ĭ" 300 "Ĭ" 300 20 | char/ord: 1000 "Ϩ" 1000 "Ϩ" 1000 21 | char/ord: 10000 "✐" 10000 "✐" 10000 22 | char/ord: 100000 "𘚠" 100000 "𘚠" 100000 23 | 24 | pad: - -- --- ---- ----- ------ ------- 3 23 123 3123 23123 123123 3123123 25 | pad: - -- --- ---- ----- ------ ------- 3 13 123 1223 12123 123123 1233123 26 | pad: - -- --- ---- ----- ------ ------- 1 12 123 1231 12312 123123 1231231 27 | pad: * *- *-- *--- *---- *----- *------ * *3 *23 *123 *3123 *23123 *123123 28 | pad: * *- -*- -*-- --*-- --*--- ---*--- * *3 1*3 1*23 12*23 12*123 123*123 29 | pad: * -* --* ---* ----* -----* ------* * 1* 12* 123* 1231* 12312* 123123* 30 | pad: x xy xy- xy-- xy--- xy---- xy----- x xy xy3 xy23 xy123 xy3123 xy23123 31 | pad: y xy xy- -xy- -xy-- --xy-- --xy--- y xy xy3 1xy3 1xy23 12xy23 12xy123 32 | pad: y xy -xy --xy ---xy ----xy -----xy y xy 1xy 12xy 123xy 1231xy 12312xy 33 | pad: a ab abc abc- abc-- abc--- abc---- a ab abc abc3 abc23 abc123 abc3123 34 | pad: b bc abc abc- -abc- -abc-- --abc-- b bc abc abc3 1abc3 1abc23 12abc23 35 | pad: c bc abc -abc --abc ---abc ----abc c bc abc 1abc 12abc 123abc 1231abc 36 | 37 | quoting: "abc" => "abc" => "abc" 38 | quoting: `abc` => "abc" => "abc" 39 | quoting: "abc\tdef" => "abc\tdef" => "abc\tdef" 40 | quoting: `abc def` => "abc\tdef" => "abc\tdef" 41 | quoting: `t0±Δt` => "t0±Δt" => "t0±Δt" 42 | quoting: "t0±Δt" => "t0±Δt" => "t0±Δt" 43 | quoting: abc => "[FAILED]" => "[FAILED]" 44 | quoting: "ab => "[FAILED]" => "[FAILED]" 45 | quoting: `ab => "[FAILED]" => "[FAILED]" 46 | quoting: "ab\fyz" => "ab\fyz" => "ab\fyz" 47 | quoting: "ab\kyz" => "[FAILED]" => "[FAILED]" 48 | quoting: "ab\" => "[FAILED]" => "[FAILED]" 49 | 50 | map: abcdef 51 | map: abcdef 52 | map: aBcDeF 53 | map: AbCdEf 54 | map: a2c4e6 55 | map: 1b3d5f 56 | map: !B#D%F 57 | map: A@C$E^ 58 | map: 59 | map: cbcdef 60 | map: capitals make a title or slogan more important 61 | map: BUT NOT TOO MANY!!!! 62 | map: If y cn rd ths y cn gt gd jb 63 | map: ♠♥♦♣ 64 | map: SDHCSHDC 65 | map: ♠♦♥♣♠♥♦♣ 66 | map: fedcba 67 | map: 035642 68 | map: 03:56:42 69 | map: abccba 70 | -------------------------------------------------------------------------------- /tests/structinit.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # test structure initialization e0 { e1:v1 ...} 4 | 5 | record rectangle(x,y,w,h,) 6 | 7 | procedure main() { 8 | 9 | ^a := list(26,"-"){ 1:"a", 5:"e", 9:"i", 15:"o", 21:"u"} 10 | write(a, " ", image(a)) 11 | a{ "25":"y" } # 25 gets converted to number 12 | write(a, " ", image(a)) 13 | 14 | ^c := table(){ "California":"Berkeley", "Arizona":"Tucson"} 15 | write(c, " ", image(c)) 16 | c{ "Massachusetts":"Cambridge" } 17 | write(c, " ", image(c)) 18 | 19 | ^r := rectangle(){ "y":3, "x":5, "h":1, "w":2 } 20 | write(r, " ", image(r)) 21 | r{ "x":8, "y":9 } 22 | write(r, " ", image(r)) 23 | 24 | ^s := "word" 25 | write(image(s)) 26 | s{ 2:"i", 1:"b" } 27 | write(image(s)) 28 | } 29 | -------------------------------------------------------------------------------- /tests/structinit.std: -------------------------------------------------------------------------------- 1 | L:26 [a,-,-,-,e,-,-,-,i,-,-,-,-,-,o,-,-,-,-,-,u,-,-,-,-,-] 2 | L:26 [a,-,-,-,e,-,-,-,i,-,-,-,-,-,o,-,-,-,-,-,u,-,-,-,y,-] 3 | T:2 table{Arizona:Tucson,California:Berkeley} 4 | T:3 table{Arizona:Tucson,California:Berkeley,Massachusetts:Cambridge} 5 | rectangle{} rectangle{x:5,y:3,w:2,h:1} 6 | rectangle{} rectangle{x:8,y:9,w:2,h:1} 7 | "word" 8 | "bird" 9 | -------------------------------------------------------------------------------- /tests/substring.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/substring.icn 2 | 3 | # string subscripting test 4 | 5 | # note that Goaldi follows Jcon (not Icon) in failing on wraparound for [+:] 6 | 7 | procedure main() { 8 | # local i, j, k, s, t 9 | local i 10 | local j 11 | local k 12 | local s 13 | local t 14 | 15 | s := "abcde" 16 | t := "ABCDE" 17 | write("A. ", !s) 18 | every write("B. ", !s) 19 | every i := 0 to 6 do write("C ", i, ". ", s[i] | "--") 20 | every i := 0 to -6 by -1 do write("D ", i, ". ", s[i] | "--") 21 | every i := -10 to 10 do write("E ", i, ". ", s[3:i] | "--") 22 | every i := -10 to 5 do write("F ", i, ". ", s[3+:i] | "--") #some SHOULD fail 23 | every i := -5 to 10 do write("G ", i, ". ", s[3-:i] | "--") #some SHOULD fail 24 | 25 | !s := "X" 26 | write("H. ", s) 27 | every !s := "Y" 28 | write("I. ", s) 29 | 30 | every i := -6 to 6 do { 31 | s := "abcde" 32 | if s[i] := t[i] then { 33 | write("J ", i, ". ", s) 34 | } else { 35 | write("J ", i, ". --") 36 | } 37 | } 38 | 39 | every i := 1 to 6 do { 40 | every j := 1 to 6 do { 41 | s := "abcde" 42 | writes("K ", i, " ", j, ". ") 43 | if s[i:j] := "(*)" then { 44 | write(s) 45 | } else { 46 | write(s, " [failed]") 47 | } 48 | } 49 | } 50 | 51 | every i := 1 to 6 do { 52 | every j := 1 to 6 do { 53 | every k := 1 to 6 do { 54 | s := "abcde" 55 | writes("L ", i, " ", j, " ", k, ". ") 56 | if s[i:j][k:2] := "(*)" then { 57 | write(s) 58 | } else { 59 | write(s, " [failed]") 60 | } 61 | } 62 | } 63 | } 64 | 65 | s := "abcde" 66 | every !s <- "-" do write("M ", s) 67 | every s [1 to 5] <- "-" do write("N ", s) 68 | every s [(-5 to 6) +: 0] <- "--" do write("O ", s) 69 | 70 | s := "abcde" 71 | every s[2:4] := !"123" do write("P ", s) 72 | s := "fghij" 73 | every s[2:4] := !"456" do { write("Q ", s); s := "klmno" } 74 | 75 | s := "3♠4♥2♦4♣" 76 | write("R1: ", image(s)) # ascii and non-ascii 77 | write("R2: ", image(s[2+:4])) # both, in substring 78 | write("R3: ", image(s[1])) # ascii only ("3") 79 | write("R4: ", image(number(s[1]))) # so this should work 80 | write("R5: ", s[1] + s[3] + s[5] + s[7]) # and this too 81 | t := s[1:3] || " " || s[3:5] || " " || s[5:7] || " " || s[7:9] 82 | write("R6: ", image(t)) 83 | t := s[1] || t[4] || t[7] || t[10] 84 | write("R7: ", image(t)) 85 | write("R8: ", image(number(t))) 86 | 87 | } 88 | -------------------------------------------------------------------------------- /tests/tables1.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # Table operations 4 | 5 | procedure main() { 6 | # local t, u, c, i, k, kv, l 7 | local t 8 | local u 9 | local c 10 | local i 11 | local k 12 | local kv 13 | local l 14 | 15 | t := table() 16 | println("\t\t\t\t", type(t), t, *t, image(t)) 17 | ck(t) 18 | every i := !4 do { 19 | t[i] := "abcd"[i] 20 | ck(t) 21 | } 22 | every c := !"efgh" do { 23 | t[toupper(c)] := c 24 | ck(t) 25 | } 26 | every i := 5-!4 do { 27 | t[i] := "wxyz"[i] 28 | ck(t) 29 | } 30 | println("\t\t\t\t", type(t), t, *t, image(t)) 31 | u := t.copy() 32 | write("\t\t\t\t t vs t: ", if t === t then "identical" else "distinct") 33 | write("\t\t\t\t t vs u: ", if t === u then "identical" else "distinct") 34 | u.delete(2).delete("G") 35 | ck(u) 36 | ck(t) # should be unchanged 37 | println("\t\t\t\t", type(t), t, *t, image(t)) 38 | every k := 3 | "G" | 1 | "H" | 2 | 4 | "F" | "E" do { 39 | t.delete(k) 40 | ck(t) 41 | } 42 | println("\t\t\t\t", type(t), t, *t, image(t)) 43 | ck(u) 44 | l := [] 45 | every l.put(!u) 46 | ck(u) 47 | every kv := !l.sort() do 48 | writes(" ", kv.key, ":", kv.value) 49 | write() 50 | 51 | write() 52 | t := table("#") 53 | t { 2 to 3 : "l", 4 | "F": "a", "E": "m"} 54 | ck(t) 55 | 56 | # test deletion from table while suspended 57 | write() 58 | t := table() 59 | every i := 1 to 10000 do # fill table with 10000 integers 60 | t[i] := i 61 | every k := (!t).key do # delete a random assortment 62 | t.delete(?10000) 63 | every k := (!t).key do # delete all that are left 64 | t.delete(k) 65 | ck(t) 66 | 67 | # (random portion disabled) 68 | # every t[!4 | !"EFGH"] := ?"abcdefghijklmnopqrstuvwxyz" 69 | # ck(t) 70 | # writes("\t\t\t") 71 | # every !12 do 72 | # kv := ?t & writes(" ", kv.key, ":", kv.value) 73 | # write() 74 | 75 | # test @T 76 | write() 77 | ^elems := table(){"Au":"Gold", "Fe":"Iron", "Pb":"Lead", "Al":"Aluminium"} 78 | write(image(elems)) 79 | ^elist := [] 80 | while elist.put(@elems) do writes("@") 81 | write(image(elist)) 82 | every write(image(!elist.sort())) 83 | write(image(elems)) 84 | } 85 | 86 | procedure ck(t) { #: show table indexed by 1..4 and "E".."H" 87 | # local k, kv 88 | local k 89 | local kv 90 | 91 | writes(*t, " ") 92 | every k := !"1234" | !4 | !"EFGH" do { 93 | writes(t.member(k) | "-") 94 | } 95 | every writes(" " | t[!4 | !"EFGH"]) 96 | writes(" ") 97 | every kv := !t.sort() do 98 | writes(" ", kv.key, ":", kv.value) 99 | write() 100 | } 101 | -------------------------------------------------------------------------------- /tests/tables1.std: -------------------------------------------------------------------------------- 1 | t:table T:0 0 table{} 2 | 0 ------------ ~~~~~~~~ 3 | 1 ----1------- a~~~~~~~ 1:a 4 | 2 ----12------ ab~~~~~~ 1:a 2:b 5 | 3 ----123----- abc~~~~~ 1:a 2:b 3:c 6 | 4 ----1234---- abcd~~~~ 1:a 2:b 3:c 4:d 7 | 5 ----1234E--- abcde~~~ 1:a 2:b 3:c 4:d E:e 8 | 6 ----1234EF-- abcdef~~ 1:a 2:b 3:c 4:d E:e F:f 9 | 7 ----1234EFG- abcdefg~ 1:a 2:b 3:c 4:d E:e F:f G:g 10 | 8 ----1234EFGH abcdefgh 1:a 2:b 3:c 4:d E:e F:f G:g H:h 11 | 8 ----1234EFGH abczefgh 1:a 2:b 3:c 4:z E:e F:f G:g H:h 12 | 8 ----1234EFGH abyzefgh 1:a 2:b 3:y 4:z E:e F:f G:g H:h 13 | 8 ----1234EFGH axyzefgh 1:a 2:x 3:y 4:z E:e F:f G:g H:h 14 | 8 ----1234EFGH wxyzefgh 1:w 2:x 3:y 4:z E:e F:f G:g H:h 15 | t:table T:8 8 table{1:w,2:x,3:y,4:z,E:e,F:f,G:g,H:h} 16 | t vs t: identical 17 | t vs u: distinct 18 | 6 ----1-34EF-H w~yzef~h 1:w 3:y 4:z E:e F:f H:h 19 | 8 ----1234EFGH wxyzefgh 1:w 2:x 3:y 4:z E:e F:f G:g H:h 20 | t:table T:8 8 table{1:w,2:x,3:y,4:z,E:e,F:f,G:g,H:h} 21 | 7 ----12-4EFGH wx~zefgh 1:w 2:x 4:z E:e F:f G:g H:h 22 | 6 ----12-4EF-H wx~zef~h 1:w 2:x 4:z E:e F:f H:h 23 | 5 -----2-4EF-H ~x~zef~h 2:x 4:z E:e F:f H:h 24 | 4 -----2-4EF-- ~x~zef~~ 2:x 4:z E:e F:f 25 | 3 -------4EF-- ~~~zef~~ 4:z E:e F:f 26 | 2 --------EF-- ~~~~ef~~ E:e F:f 27 | 1 --------E--- ~~~~e~~~ E:e 28 | 0 ------------ ~~~~~~~~ 29 | t:table T:0 0 table{} 30 | 6 ----1-34EF-H w~yzef~h 1:w 3:y 4:z E:e F:f H:h 31 | 6 ----1-34EF-H w~yzef~h 1:w 3:y 4:z E:e F:f H:h 32 | 1:w 3:y 4:z E:e F:f H:h 33 | 34 | 5 -----234EF-- #llama## 2:l 3:l 4:a E:m F:a 35 | 36 | 0 ------------ ~~~~~~~~ 37 | 38 | table{Al:Aluminium,Au:Gold,Fe:Iron,Pb:Lead} 39 | @@@@[elemtype{},elemtype{},elemtype{},elemtype{}] 40 | elemtype{key:Al,value:Aluminium} 41 | elemtype{key:Au,value:Gold} 42 | elemtype{key:Fe,value:Iron} 43 | elemtype{key:Pb,value:Lead} 44 | table{} 45 | -------------------------------------------------------------------------------- /tests/tables2.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/table.icn 2 | # 3 | # Table test 4 | 5 | procedure main() { 6 | # local k, kv, x, y 7 | local k 8 | local kv 9 | local x 10 | local y 11 | 12 | x := table() 13 | tdump("initial", x) 14 | writes("should fail ", image(?x)) 15 | # portable with 0 or 1 entries: 16 | every writes(" ", ">>" | (!x).value | "\n") 17 | x[2] := 3; 18 | every writes(" ", ">>" | (!x).value | image((?x).value) | "\n") 19 | x[4] := 7; 20 | x["a"] := "A"; 21 | tdump("+2+4+a", x) 22 | 23 | every kv := !x do x[kv.key] := 88 24 | tdump("!x=88", x) 25 | 26 | every x[(!x).key] := 99 27 | tdump("[all]=99", x) 28 | 29 | every k := (!x).key do 30 | x[k] := k 31 | tdump("x[k]=k", x) 32 | 33 | /x[1] | write("/1") 34 | \x[2] | write("\\2") 35 | 36 | x := table() 37 | if x.member() then write("NIL IS MEMBER") 38 | x[nil] := nil | write("failed 0") 39 | x[1] := nil | write("failed 1") 40 | x[3] := nil | write("failed 3") 41 | x[5] := 55 | write("failed 5") 42 | (x[6] := 66 & x[7] := 77) | write("failed 67") 43 | x[nil] := "nil" | write("failed n") 44 | if not x.member() then write("NIL IS NOT MEMBER") 45 | tdump("insert", x) 46 | x.delete(nil) | write("failed dn") 47 | x.delete(3) | write("failed d3") 48 | x.delete(7,1) | write("failed d71") 49 | tdump("delete", x) 50 | 51 | x := table(0) 52 | write(x[47]) 53 | tdump("t0", x) 54 | x[nil] := nil | write("failed 0") 55 | x[1] := nil | write("failed 1") 56 | x[3] := nil | write("failed 3") 57 | x[5] := 55 | write("failed 5") 58 | (x[6] := 66 & x[7] := 77) | write("failed 67") 59 | x[nil] := "nil" | write("failed n") 60 | tdump("t0i", x) 61 | x.delete(nil) | write("failed dn") 62 | x.delete(3) | write("failed d3") 63 | x.delete(7).delete(1) | write("failed d71") 64 | tdump("t0d", x) 65 | 66 | write() 67 | x := table() 68 | every x[3] <- 19 # should insert key but revert to default value 69 | every kv := !x do 70 | write("{",kv.key,",",kv.value,"}") 71 | 72 | x := table() 73 | every k := 0 to 4 do 74 | x[k] := k + 10 75 | y := copy(x) 76 | every x[(!x).key] +:= 20 77 | every y[(!y).key] +:= 40 78 | tdump("30s", x) 79 | tdump("50s", y) 80 | 81 | } 82 | 83 | 84 | # dump a table, assuming that keys are drawn from: nil, 0 - 9, "a" - "e" 85 | # 86 | # also checks member() 87 | 88 | procedure tdump(label, T) { 89 | local x 90 | 91 | printf("%10s :%2.0f :", label, *T) 92 | every x := nil | (0 to 9) | !"abcde" do 93 | if x === ((!T).key) then { 94 | writes(" [", image(x), "]", image(T[x])) 95 | T.member(x) | writes(":NONMEMBER") 96 | } else { 97 | T.member(x) & writes(" MEMBER:", image(x)) 98 | } 99 | write() 100 | return 101 | } 102 | -------------------------------------------------------------------------------- /tests/tables2.std: -------------------------------------------------------------------------------- 1 | initial : 0 : 2 | >> 3 | >> 3 3 4 | +2+4+a : 3 : [2]3 [4]7 ["a"]"A" 5 | !x=88 : 3 : [2]88 [4]88 ["a"]88 6 | [all]=99 : 3 : [2]99 [4]99 ["a"]99 7 | x[k]=k : 3 : [2]2 [4]4 ["a"]"a" 8 | insert : 6 : [nil]"nil" [1]nil [3]nil [5]55 [6]66 [7]77 9 | delete : 2 : [5]55 [6]66 10 | 0 11 | t0 : 0 : 12 | t0i : 6 : [nil]"nil" [1]nil [3]nil [5]55 [6]66 [7]77 13 | t0d : 2 : [5]55 [6]66 14 | 15 | {3,~} 16 | 30s : 5 : [0]30 [1]31 [2]32 [3]33 [4]34 17 | 50s : 5 : [0]50 [1]51 [2]52 [3]53 [4]54 18 | -------------------------------------------------------------------------------- /tests/traps.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/traps.icn 2 | # test assignments to trapped variables 3 | # original source unknown; found 2013 in an ancient to-do collection 4 | 5 | procedure tvtbl_test () { 6 | local T 7 | 8 | # 9 | # Test to make sure that the table trapped variable returns 10 | # the correct value. 11 | # 12 | # Old Icon Note: "The parameters to write are not de-referenced 13 | # until all of them are evaluated. Any line produced by this section 14 | # that has includes two different values for T [] is therefore incorrect." 15 | # 16 | # In Goaldi, the rules are different: 17 | # Each write() argument is dereferenced as it is produced, 18 | # so different values ARE to be expected. 19 | # 20 | write ( "TVTBL test 1" ) 21 | T := table() 22 | 23 | write ( "Assignment test: \t", T [], "\t", T [] := "Assigned" ) 24 | write ( "Reassignment test:\t", T [], "\t", T [] := "Reassigned" ) 25 | write ( "Deletion test: \t", T [], "\t", T.delete(nil) & T [] ) 26 | write ( "Insertion test: \t", T [], "\t", 27 | T [] := ( ( T[] := "Assigned" ) & "Reassigned" ) ) 28 | 29 | # 30 | # Test to make sure that the table is getting updated properly by 31 | # trapped variable assignment. 32 | # 33 | # Note: there have been past errors where "T [] :=..." returns the 34 | # correct value without properly updating the table. 35 | # 36 | write ( "\nTVTBL test 2" ) 37 | T.delete() 38 | T [] := "Assigned"; write ( "Assignment test: \t", T [] ) 39 | T [] := "Reassigned"; write ( "Reassignment test:\t", T [] ) 40 | T [] := "Assigned" 41 | T [] := ( T.delete() & "Reassigned" ) 42 | write ( "Deletion test: \t" , T [] ) 43 | T.delete() 44 | T [] := ( ( T[] := "Assigned" ) & "Reassigned" ) 45 | write ( "Insertion test: \t", T [] ) 46 | write ( ) 47 | 48 | } 49 | 50 | 51 | procedure subs_test ( ) { 52 | # local T, s 53 | local T 54 | local s 55 | 56 | write ( "TVSUBS test" ) 57 | T := table() 58 | T [ 7 ] := "....." 59 | T [ 7 ] [ 4 ] := "X" 60 | write ( "Subs of new table elem: ", T [ 7 ] ) 61 | T [ 7 ] := "....." 62 | T [ 7 ] [ 4 ] := "X" 63 | write ( "Subs of existing table elem: ", T [ 7 ] ) 64 | 65 | # Lots more cases should be added here. 66 | 67 | return 68 | } 69 | 70 | 71 | procedure main ( ) { 72 | tvtbl_test ( ) 73 | subs_test ( ) 74 | return 75 | } 76 | -------------------------------------------------------------------------------- /tests/traps.std: -------------------------------------------------------------------------------- 1 | TVTBL test 1 2 | Assignment test: ~ Assigned 3 | Reassignment test: Assigned Reassigned 4 | Deletion test: Reassigned ~ 5 | Insertion test: ~ Reassigned 6 | 7 | TVTBL test 2 8 | Assignment test: Assigned 9 | Reassignment test: Reassigned 10 | Deletion test: Reassigned 11 | Insertion test: Reassigned 12 | 13 | TVSUBS test 14 | Subs of new table elem: ...X. 15 | Subs of existing table elem: ...X. 16 | -------------------------------------------------------------------------------- /tests/tuple.gd: -------------------------------------------------------------------------------- 1 | procedure main() { 2 | local t 3 | 4 | # tuple construction 5 | write(image(tuple())) 6 | write(image(tuple(a:1,b:3))) 7 | write(image(tuple(a:2,b:1))) 8 | write(image(tuple(a:1,b:3,c:5))) 9 | 10 | # tuple operations 11 | write() 12 | t := tuple(key:3, value:5) 13 | write(image(t)) 14 | write(t.key, " : ", t.value) 15 | t := tuple(x:3, y:5, w:2, h:1) 16 | write(image(t)) 17 | write(t.x, " ", t.y, " ", t.w, " ", t.h) 18 | every writes(" ", image(!t) | "\n") 19 | every writes(" ", image(t[!4]) | "\n") 20 | every writes(" ", image(t[!*t]) | "\n") 21 | 22 | # inspecting the tuple type 23 | write("t.type():") 24 | ^y := t.type() 25 | every writes(" ", image(!y) | "\n") 26 | every writes(" ", image(y[!4]) | "\n") 27 | every writes(" ", image(y[!*y]) | "\n") 28 | every writes(" ", image(y[!"xywh"]) | "\n") 29 | 30 | # use tuple to protect an unhashable value 31 | write() 32 | ^L := [1,2,3] 33 | ^t1 := tuple(k:external(L)) 34 | ^t2 := tuple(k:external(L)) # a distinct value 35 | ^t3 := tuple(k:external([1,2,3])) # also distinct 36 | ^t4 := tuple(k:external([4,5,6,7])) 37 | ^S := set([t1,t2,t3,t4]) 38 | write("S: ", image(S)) 39 | L := [: image(!S) :].sort() # for reproducibility 40 | every write("!S: ", !L) 41 | # all should be of the same type (tuple(k)) 42 | write(image(type(t1))) 43 | write(if type(t1) === type(t2) then "t1 === t2" else "t1 ~=== t2") 44 | write(if type(t2) === type(t3) then "t2 === t3" else "t2 ~=== t3") 45 | write(if type(t3) === type(t4) then "t3 === t4" else "t3 ~=== t4") 46 | } 47 | -------------------------------------------------------------------------------- /tests/tuple.std: -------------------------------------------------------------------------------- 1 | tuple{} 2 | tuple{a:1,b:3} 3 | tuple{a:2,b:1} 4 | tuple{a:1,b:3,c:5} 5 | 6 | tuple{key:3,value:5} 7 | 3 : 5 8 | tuple{x:3,y:5,w:2,h:1} 9 | 3 5 2 1 10 | 3 5 2 1 11 | 3 5 2 1 12 | 3 5 2 1 13 | t.type(): 14 | "x" "y" "w" "h" 15 | "x" "y" "w" "h" 16 | "x" "y" "w" "h" 17 | 1 2 3 4 18 | 19 | S: set{tuple{},tuple{},tuple{},tuple{}} 20 | !S: tuple{k:[1 2 3]} 21 | !S: tuple{k:[1 2 3]} 22 | !S: tuple{k:[1 2 3]} 23 | !S: tuple{k:[4 5 6 7]} 24 | constructor tuple(k) 25 | t1 === t2 26 | t2 === t3 27 | t3 === t4 28 | -------------------------------------------------------------------------------- /tests/unidents.gd: -------------------------------------------------------------------------------- 1 | #SRC: Goaldi original 2 | # 3 | # Using Unicode identifiers in various situations 4 | 5 | global Dvořák := 1841 6 | 7 | record rtype(Σ, Ω) 8 | 9 | procedure main(args[]) { 10 | local Strauß := 1825 11 | ^π := %pi 12 | with %ϕ := %phi do { 13 | println(Dvořák, Strauß, π, %ϕ) 14 | } 15 | ^R := rtype(123,456) 16 | println(image(R), R.Σ, R.Ω) 17 | R := rtype(Ω:999, Σ:888) 18 | println(image(R), R.Σ, R.Ω) 19 | ^C := constructor("greeks", "α", "β", "γ") 20 | println(image(C)) 21 | println(image(C(1,2,3))) 22 | ^T := tuple(Ψ:"saguaro", Ξ:"gate", Π:"wicket",) 23 | println(image(T)) 24 | ^t1 := 1017 25 | ^t2 := 1023 26 | ^Δt := t2 - t1 27 | println(t1, t2, Δt) 28 | } 29 | -------------------------------------------------------------------------------- /tests/unidents.std: -------------------------------------------------------------------------------- 1 | 1841 1825 3.142 1.618 2 | rtype{Σ:123,Ω:456} 123 456 3 | rtype{Σ:888,Ω:999} 888 999 4 | constructor greeks(α,β,γ) 5 | greeks{α:1,β:2,γ:3} 6 | tuple{Ψ:saguaro,Ξ:gate,Π:wicket} 7 | 1017 1023 6 8 | -------------------------------------------------------------------------------- /tests/vars.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | global a 3 | global g 4 | 5 | procedure main() { 6 | a := "Ahoy" 7 | g := "Gladiola" 8 | p() 9 | q() 10 | p() 11 | q() 12 | println("m:", a, g) 13 | } 14 | 15 | procedure p() { 16 | local a 17 | static s 18 | println("p:", \a | "--", g, \s | "--") 19 | a := "Ain't gonna see this" 20 | g := "Gorgonzola" 21 | s := "Sarasota" 22 | } 23 | 24 | procedure q() { 25 | local a 26 | static t 27 | a := "Asparagus" 28 | println("q:", a, g, \t | "--") 29 | a := "Ain't gonna see this either" 30 | g := "Gouda" 31 | t := "Turnip" 32 | } 33 | -------------------------------------------------------------------------------- /tests/vars.std: -------------------------------------------------------------------------------- 1 | p: -- Gladiola -- 2 | q: Asparagus Gorgonzola -- 3 | p: -- Gouda Sarasota 4 | q: Asparagus Gorgonzola Turnip 5 | m: Ahoy Gouda 6 | -------------------------------------------------------------------------------- /tests/wordcnt.dat: -------------------------------------------------------------------------------- 1 | Camille Saint-Saëns 2 | (from Wikipedia) 3 | 4 | Saint-Saëns was born in Paris, the only child of Jacques-Joseph-Victor 5 | Saint-Saëns (1798–1835), an official in the French Ministry of the Interior, 6 | and his wife, Françoise-Clémence, née Collin. 7 | Victor Saint-Saëns was of Norman ancestry, 8 | and his wife was from a Haute-Marne family; 9 | their son, born in the Rue du Jardinet in the 6th arrondissement of Paris, 10 | and baptised at the nearby church of Saint-Sulpice, 11 | always considered himself a true Parisian. 12 | Less than two months after the christening, 13 | Victor Saint-Saëns died of consumption on the first anniversary of his marriage. 14 | The young Camille was taken to the country for the sake of his health, 15 | and for two years lived with a nurse at Corbeil, 16 | 29 kilometres (18 mi) to the south of Paris. 17 | -------------------------------------------------------------------------------- /tests/wordcnt.gd: -------------------------------------------------------------------------------- 1 | #SRC: icon/wordcnt.icn (extensively rewritten) 2 | # 3 | # Word Counter 4 | # 5 | # A word is a string of one or more Unicode "letters". 6 | 7 | procedure main(filename) { 8 | 9 | local f := file(\filename) | %stdin # input file 10 | local words := table(0) # table for talling counts 11 | local rx := regex(`\pL+`) # expr to match words 12 | 13 | while local line := f.read() do { # read line 14 | local matches := rx.FindAllString(line, -1) # find words 15 | every local w := !\matches do { # for each (if any) 16 | words[w] +:= 1 # bump the tally 17 | } 18 | } 19 | every local kv := !words.sort() do # for each key/value pair 20 | printf("%6.0f %s\n", kv.value, kv.key) # print count and word 21 | } 22 | -------------------------------------------------------------------------------- /tests/wordcnt.std: -------------------------------------------------------------------------------- 1 | 2 Camille 2 | 1 Clémence 3 | 1 Collin 4 | 1 Corbeil 5 | 1 Françoise 6 | 1 French 7 | 1 Haute 8 | 1 Interior 9 | 1 Jacques 10 | 1 Jardinet 11 | 1 Joseph 12 | 1 Less 13 | 1 Marne 14 | 1 Ministry 15 | 1 Norman 16 | 3 Paris 17 | 1 Parisian 18 | 1 Rue 19 | 6 Saint 20 | 5 Saëns 21 | 1 Sulpice 22 | 1 The 23 | 3 Victor 24 | 1 Wikipedia 25 | 3 a 26 | 1 after 27 | 1 always 28 | 1 an 29 | 1 ancestry 30 | 4 and 31 | 1 anniversary 32 | 1 arrondissement 33 | 2 at 34 | 1 baptised 35 | 2 born 36 | 1 child 37 | 1 christening 38 | 1 church 39 | 1 considered 40 | 1 consumption 41 | 1 country 42 | 1 died 43 | 1 du 44 | 1 family 45 | 1 first 46 | 2 for 47 | 2 from 48 | 1 health 49 | 1 himself 50 | 4 his 51 | 4 in 52 | 1 kilometres 53 | 1 lived 54 | 1 marriage 55 | 1 mi 56 | 1 months 57 | 1 nearby 58 | 1 nurse 59 | 1 née 60 | 9 of 61 | 1 official 62 | 1 on 63 | 1 only 64 | 1 sake 65 | 1 son 66 | 1 south 67 | 1 taken 68 | 1 th 69 | 1 than 70 | 11 the 71 | 1 their 72 | 2 to 73 | 1 true 74 | 2 two 75 | 4 was 76 | 2 wife 77 | 1 with 78 | 1 years 79 | 1 young 80 | -------------------------------------------------------------------------------- /tests/yield.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # 3 | # test generation of values by a loop expression 4 | 5 | procedure main() { 6 | local n := 74 7 | every writes(" ", 8 | "GO:" | 9 | (every local i := 10 to 50 by 10 do { 10 | yield i 11 | if i == (20 | 40) then yield i + 5 12 | if i == 30 then yield i+4 to i+6 13 | }) | 14 | (repeat { 15 | yield 61 to 64 16 | break 17 | }) | 18 | (while n < 78 do yield n +:= 1) | 19 | "DONE\n") 20 | } 21 | -------------------------------------------------------------------------------- /tests/yield.std: -------------------------------------------------------------------------------- 1 | GO: 10 20 25 30 34 35 36 40 45 50 61 62 63 64 75 76 77 78 DONE 2 | -------------------------------------------------------------------------------- /tests/zipreader.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proebsting/goaldi/983d69b36561117fb333fc4c316b7c7d16fafcc5/tests/zipreader.dat -------------------------------------------------------------------------------- /tests/zipreader.gd: -------------------------------------------------------------------------------- 1 | #SRC: goaldi original 2 | # zip file reader demo 3 | 4 | procedure main(fname) { 5 | # local zr, zf, f 6 | local zr 7 | local zf 8 | local f 9 | /fname := "zipreader.dat" 10 | zr := zipreader(fname) 11 | if /zr then stop("cannot open ", fname) 12 | write(fname) # show archive name 13 | write("" ~== zr.Comment) # show comment if present 14 | every zf := !zr.File do 15 | showfile(zf) 16 | zr.Close() 17 | write("[end]") 18 | } 19 | 20 | procedure showfile(zf) { 21 | write(repl("-", 60)) 22 | local h := zf.FileHeader 23 | write(h.Name, ": ", h.UncompressedSize64, " bytes") 24 | local retv := zf.Open() # u.c. "Open": Go method on zip file 25 | throw(\retv[2]) # handle error from Open 26 | local f := retv[1] # extract file result 27 | contents(f) # show contents 28 | f.close() # l.c. "close": Goaldi method on Goaldi file 29 | } 30 | 31 | procedure contents(f) { 32 | local i 33 | every i := !5 do 34 | write(@f) | return fail 35 | @f & write(" ... ") 36 | } 37 | -------------------------------------------------------------------------------- /tests/zipreader.std: -------------------------------------------------------------------------------- 1 | zipreader.dat 2 | ------------------------------------------------------------ 3 | README: 193 bytes 4 | A sample from "30 great poems everyone should know" 5 | The Times [of London], 19 November 2011 (viewed 20 November 2014) 6 | http://www.thetimes.co.uk/tto/public/poetrycompetition/article3229711.ece 7 | ------------------------------------------------------------ 8 | blake.txt: 571 bytes 9 | Jerusalem 10 | William Blake 11 | 12 | And did those feet in ancient time 13 | Walk upon England’s mountains green? 14 | ... 15 | ------------------------------------------------------------ 16 | carroll.txt: 974 bytes 17 | Jabberwocky 18 | Lewis Carroll 19 | 20 | ’Twas brillig, and the slithy toves 21 | Did gyre and gimble in the wabe: 22 | ... 23 | ------------------------------------------------------------ 24 | coleridge.txt: 2042 bytes 25 | Kubla Khan 26 | Samuel taylor Coleridge 27 | 28 | In Xanadu did Kubla Khan 29 | A stately pleasure-dome decree: 30 | ... 31 | ------------------------------------------------------------ 32 | grahame.txt: 682 bytes 33 | The Song of Mr Toad 34 | Kenneth Grahame 35 | 36 | The world has held great Heroes, 37 | As history-books have showed; 38 | ... 39 | ------------------------------------------------------------ 40 | kipling.txt: 1519 bytes 41 | If 42 | Rudyard Kipling 43 | 44 | If you can keep your head when all about you 45 | Are losing theirs and blaming it on you, 46 | ... 47 | ------------------------------------------------------------ 48 | lear.txt: 1141 bytes 49 | The Owl and the Pussycat 50 | Edward Lear 51 | 52 | The Owl and the Pussy-cat went to sea 53 | In a beautiful pea green boat, 54 | ... 55 | ------------------------------------------------------------ 56 | longfellow.txt: 477 bytes 57 | The Arrow and the Song 58 | Henry Wadsworth Longfellow 59 | 60 | I shot an arrow into the air, 61 | It fell to earth, I knew not where; 62 | ... 63 | ------------------------------------------------------------ 64 | whitman.txt: 885 bytes 65 | I Hear America Singing 66 | Walt Whitman 67 | 68 | I hear America singing, the varied carols I hear, 69 | Those of mechanics, each one singing his as it should be blithe and strong, 70 | ... 71 | [end] 72 | -------------------------------------------------------------------------------- /top.go: -------------------------------------------------------------------------------- 1 | // need at least one .go file at the top level 2 | 3 | package goaldi 4 | -------------------------------------------------------------------------------- /tran/.exrc: -------------------------------------------------------------------------------- 1 | :set tabstop=4 2 | :set shiftwidth=4 3 | :set autoindent 4 | :set exrc 5 | :set secure 6 | :set viminfo= 7 | -------------------------------------------------------------------------------- /tran/Makefile: -------------------------------------------------------------------------------- 1 | ## Makefile for Goaldi translator 2 | 3 | SRC = main.gd ast.gd ir.gd \ 4 | lex.gd parse.gd irgen.gd optimize.gd gen_json.gd gengo.gd 5 | GIR = $(SRC:.gd=.gir) 6 | GEN = X 7 | GOALDI = goaldi 8 | 9 | 10 | # rule for compiling a .gd file to make a .gir file 11 | .SUFFIXES: .gd .gir 12 | .gd.gir: ; $(GOALDI) -c $< 13 | 14 | # make Go source file for embedding the translator 15 | gtran.go: gtran0 gtran gobytes.sh 16 | ./gobytes.sh tran GCode gtran.go 17 | 18 | # make translator executable from component .gir files 19 | gtran: $(GIR) 20 | echo '#!/usr/bin/env goaldi -x' >gtran 21 | echo "# gtran gen$(GEN) `git rev-parse HEAD`" >>gtran 22 | echo "# $$USER `date`" >>gtran 23 | echo "# `uname -n -s -m`" >>gtran 24 | cat $(GIR) | bzip2 -9 >>gtran 25 | chmod +x gtran 26 | 27 | # if gtran0 doesn't exist (e.g. after make clean) force full two-pass rebuild 28 | gtran0: 29 | rm -f *.gir 30 | $(GOALDI) -c $(SRC) 31 | +make gtran 32 | $(GOALDI) -x gtran -c $(SRC) 33 | mv gtran gtran0 34 | 35 | # install the new translator as the stable version for future builds 36 | accept: gtran 37 | @echo '------' 38 | @head -4 stable-gtran | sed 's/^#/< /' 39 | @echo '------' 40 | @head -4 gtran | sed 's/^#/> /' 41 | @echo '------' 42 | cp -p gtran stable-gtran 43 | 44 | # make bootstrap Go file from saved, stable translator version 45 | boot: 46 | ./gobytes.sh tran GCode gtran.go 47 | 48 | # get profiling data (by running gtran to compile itself) and start pprof 49 | profile: gtran 50 | $(GOALDI) -x -P -t gtran -t -c *.gd 51 | : suggested pprof commands: "top25" or "weblist main" 52 | go tool pprof `command -v $(GOALDI)` ./PROFILE 53 | 54 | # clean up build products 55 | clean: 56 | rm -f *.gir gtran0 gtran gtran.go PROFILE 57 | -------------------------------------------------------------------------------- /tran/ast.gd: -------------------------------------------------------------------------------- 1 | # ast.gd -- record definitions for Abstract Syntax Tree nodes 2 | 3 | record a_NoOp(coord, ir) 4 | record a_Field(expr, field, coord, ir) 5 | record a_Limitation(expr, limit, coord, ir) 6 | record a_Not(expr, coord, ir) 7 | record a_Alt(eList, coord, ir) 8 | record a_ExcAlt(eList, coord, ir) 9 | record a_RepAlt(expr, coord, ir) 10 | record a_Case(expr, clauseList, dflt, coord, ir) 11 | record a_Cclause(expr, body, coord, ir) 12 | record a_Select(caseList, dflt, coord, ir) 13 | record a_SelectCase(kind, left, right, body, coord, ir) 14 | record a_Every(expr, body, name, coord, ir) 15 | record a_Sectionop(op, val, left, right, coord, ir) 16 | record a_Binop(op, left, right, coord, ir) 17 | record a_Unop(op, operand, coord, ir) 18 | record a_Global(id, expr, coord, ir, namespace) # phone namespace 19 | record a_Package(name, coord, ir) 20 | record a_If(expr, thenexpr, elseexpr, coord, ir) 21 | record a_Initial(expr, coord, ir) 22 | record a_Intlit(int, coord, ir) 23 | record a_Reallit(real, coord, ir) 24 | record a_Stringlit(str, coord, ir) 25 | record a_Lambda(paramList, accumulate, code, coord, endcoord, ir) 26 | record a_ProcDecl(ident, paramList, accumulate, code, coord, endcoord, ir) 27 | record a_ProcBody(nexprList, coord, ir) 28 | record a_ProcCode(body, coord, ir) 29 | record a_Record(ident, extendsRec, extendsPkg,idlist, coord, ir) 30 | record a_Repeat(body, expr, name, coord, ir) 31 | record a_Return(expr, coord, ir) 32 | record a_Catch(expr, coord, ir) 33 | record a_Fail(coord, ir) 34 | record a_Nil(coord, ir) 35 | record a_Suspend(expr, body, name, coord, ir) 36 | record a_While(expr, body, name, coord, ir) 37 | record a_Create(expr, coord, ir) 38 | record a_Ident(id, namespace, coord, ir) 39 | record a_Local(id, coord, ir, namespace) # phone namespace 40 | record a_Static(id, coord, ir, namespace) # phone namespace 41 | record a_Continue(name, coord, ir) 42 | record a_Break(name, coord, ir) 43 | record a_Yield(expr, name, coord, ir) 44 | record a_ToBy(fromexpr, toexpr, byexpr, coord, ir) 45 | record a_Mutual(exprList, coord, ir) 46 | record a_Parallel(exprList, coord, ir) 47 | record a_Compound(exprList, coord, ir) 48 | record a_ListConstructor(exprList, coord, ir) 49 | record a_ListComprehension(expr, coord, ir) 50 | record a_With(id, init, expr, coord, ir) 51 | record a_Key(id, coord, ir) 52 | record a_Arglist(exprList, nameList, coord, ir) 53 | record a_Call(fn, args, coord, ir) 54 | record a_Paired(fn, leftList, rightList, coord, ir) 55 | -------------------------------------------------------------------------------- /tran/gen_json.gd: -------------------------------------------------------------------------------- 1 | # gen_json.gd -- create json output from intermediate representation. 2 | 3 | procedure json_File(f, irgen) { 4 | local sep 5 | f.write("[") 6 | while ^p := @irgen do { 7 | f.writes(\sep) 8 | json(f, p, "") 9 | sep := "," 10 | } 11 | f.write("\n]") 12 | } 13 | 14 | procedure json(f, p, indent) { # write p to f 15 | case type(p) of { 16 | niltype: f.writes("null") 17 | number: f.writes(image(image(p))) # all digits, quoted 18 | string: f.writes(json_image(string(p))) 19 | ir_Label: f.writes(image(p.value)) 20 | ir_Tmp: f.writes(image(p.name)) 21 | ir_TmpLabel: f.writes(image(p.name)) 22 | ir_TmpClosure: f.writes(image(p.name)) 23 | set: json_list(f, p, indent) 24 | list: json_list(f, p, indent) 25 | default: return json_record(f, p, indent) 26 | } 27 | } 28 | 29 | procedure json_list(f, p, indent) { 30 | local sep 31 | f.writes("[") 32 | every ^i := !p do { 33 | f.writes(\sep | "", "\n", indent, "\t") 34 | json(f, i, indent || "\t") 35 | sep := "," 36 | } 37 | f.writes("\n", indent, "]") 38 | } 39 | 40 | procedure json_record(f, p, indent) { 41 | f.writes("{\n", indent, "\t\"tag\" : ", image(type(p).name())) 42 | ^t := p.type() 43 | every ^i := 1 to *p do { 44 | if ^v := \p[i] then { # omit null fields 45 | f.writes(",\n", indent, "\t\"", t[i], "\" : ") 46 | json(f, v, indent || "\t") 47 | } 48 | } 49 | f.writes("\n", indent, "}") 50 | } 51 | 52 | procedure json_image(s) { 53 | /static mapping := table() { 54 | "\x00" : `\u0000`, 55 | "\x01" : `\u0001`, 56 | "\x02" : `\u0002`, 57 | "\x03" : `\u0003`, 58 | "\x04" : `\u0004`, 59 | "\x05" : `\u0005`, 60 | "\x06" : `\u0006`, 61 | "\x07" : `\u0007`, 62 | "\b" : `\b`, 63 | "\t" : `\t`, 64 | "\n" : `\n`, 65 | "\v" : `\u000b`, 66 | "\f" : `\f`, 67 | "\r" : `\r`, 68 | "\x0e" : `\u000e`, 69 | "\x0f" : `\u000f`, 70 | "\x10" : `\u0010`, 71 | "\x11" : `\u0011`, 72 | "\x12" : `\u0012`, 73 | "\x13" : `\u0013`, 74 | "\x14" : `\u0014`, 75 | "\x15" : `\u0015`, 76 | "\x16" : `\u0016`, 77 | "\x17" : `\u0017`, 78 | "\x18" : `\u0018`, 79 | "\x19" : `\u0019`, 80 | "\x1a" : `\u001a`, 81 | "\e" : `\u001b`, 82 | "\x1c" : `\u001c`, 83 | "\x1d" : `\u001d`, 84 | "\x1e" : `\u001e`, 85 | "\x1f" : `\u001f`, 86 | `"` : `\"`, 87 | `\` : `\\`, 88 | "\d" : `\u007f`, 89 | } 90 | local t := `"` 91 | every local c := !s do 92 | t ||:= \mapping[c] | c 93 | return t || `"` 94 | } 95 | -------------------------------------------------------------------------------- /tran/gengo.gd: -------------------------------------------------------------------------------- 1 | # gengo.gd -- generate Go code from IR. (INCOMPLETE, EXPERIMENTAL) 2 | 3 | # Conventions: 4 | # user symbols map to the form _symbol 5 | # generated global/initial procedure names end up prefixed by __ 6 | # non-prefixed names are reserved for use by generated code 7 | # (e.g. env, args, frame, p_xxx etc) 8 | 9 | procedure go_File(f, irgen) { 10 | local init 11 | while local p := @irgen do { 12 | /init := go_start(f, p) 13 | p.go(f) 14 | } 15 | } 16 | 17 | procedure go_start(f, p) { 18 | ^namespace := ("" ~== \p.namespace) | "main" 19 | f.write(`package `, namespace) 20 | f.write(`import g "goaldi/runtime"`) 21 | return namespace 22 | } 23 | 24 | procedure ir_Global.go(f) { 25 | f.write() 26 | f.writes(`var _`, self.name, ` g.Value = g.NewVariable(`) 27 | if \self.fn then { 28 | #%#% not quite right: assumes that initialization function 29 | #%#% returns a value rather than implementing an assignment 30 | f.write(`g.ResultOf(p`, goname(self.fn), `))`) 31 | } else { 32 | f.write(`g.NilValue)`) 33 | } 34 | } 35 | 36 | procedure ir_Record.go(f) { 37 | ^flist := "[]string{" 38 | ^parent := "nil" 39 | every flist ||:= image(!self.fieldList) || "," 40 | f.write() 41 | f.write(`var _`, self.name, ` g.Value = g.NewCtor("`, 42 | self.name, `", `, parent, `, `, flist, `})`) 43 | } 44 | 45 | procedure ir_Initial.go(f) { 46 | f.write(`func init() { g.Run(p`, goname(self.fn), `, []g.Value{}) }`) 47 | } 48 | 49 | procedure ir_Function.go(f) { 50 | ^gname := goname(self.name) 51 | 52 | # generate global symbol 53 | f.write() 54 | ^plist := "&[]string{" 55 | every plist ||:= image(!self.paramList) || "," 56 | f.write(`var `, gname, ` g.Value = g.NewProcedure("`, 57 | self.name, `", `, "\n\t", plist, "},\n\t", 58 | if self.accumulate ~=== "" then "true" else "false", 59 | `, p`, gname, `, p`, gname, `, "")`) 60 | 61 | # generate prologue for implementing function 62 | f.write() 63 | f.write(`func p`, gname, 64 | `(env *g.Env, args ...g.Value) (g.Value, *g.Closure) {`) 65 | 66 | # generate code 67 | every ^c := !self.codeList do { 68 | c.go(f) 69 | } 70 | 71 | f.write(` return nil, nil`) 72 | f.write(`}`) 73 | } 74 | 75 | procedure ir_chunk.go(f) { 76 | every ^c := !self.insnList do { 77 | c.go(f) 78 | } 79 | } 80 | 81 | procedure ir_Fail.go(f) { 82 | } 83 | 84 | procedure ir_Call.go(f) { 85 | } 86 | 87 | procedure ir_OpFunction.go(f) { 88 | } 89 | 90 | procedure ir_Var.go(f) { 91 | } 92 | 93 | procedure ir_RealLit.go(f) { 94 | } 95 | 96 | procedure ir_EnterScope.go(f) { 97 | } 98 | 99 | # turn a user or generated symbol into the version used in generated Go code: 100 | # prefix by "_" and replace all "$" by "_" 101 | procedure goname(s) { 102 | ^t := "_" 103 | every ^c := !s do 104 | t ||:= if c == "$" then "_" else c 105 | return t 106 | } 107 | -------------------------------------------------------------------------------- /tran/gobytes.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # gobytes -- turn binary data into a byte array for embedding in Go code. 4 | # 5 | # usage: gobytes pkgname varname file.go 6 | 7 | echo package ${1-main} 8 | echo var ${2-data} ' = []byte{' 9 | od -v -An -tu1 | sed 's/ *\([0-9][0-9]*\)/\1,/g' 10 | echo '}' 11 | -------------------------------------------------------------------------------- /tran/ir.gd: -------------------------------------------------------------------------------- 1 | # ir.gd -- data structures for the Goaldi intermediate representation. 2 | 3 | record ir_Record(coord, name, extendsRec, extendsPkg, fieldList, namespace) 4 | record ir_Global(coord, name, fn, namespace) 5 | record ir_Initial(coord, fn, namespace) 6 | record ir_Function(coord, name, paramList, accumulate, 7 | localList, staticList, unboundList, codeList, codeStart, 8 | parent, namespace, tempCount) 9 | record ir_chunk(label, insnList) 10 | 11 | record ir_NoOp(coord, comment) 12 | record ir_Catch(coord, lhs, fn) 13 | record ir_EnterScope(coord, nameList, dynamicList, scope, parentScope) 14 | record ir_ExitScope(coord, nameList, dynamicList, scope) 15 | 16 | record ir_Tmp(name) 17 | record ir_TmpLabel(name) 18 | record ir_TmpClosure(name) 19 | record ir_Label(value) 20 | 21 | record ir_Var(coord, lhs, name, namespace, scope, rval) 22 | record ir_Key(coord, lhs, name, scope, rval) 23 | record ir_IntLit(coord, lhs, val) 24 | record ir_NilLit(coord, lhs) 25 | record ir_RealLit(coord, lhs, val) 26 | record ir_StrLit(coord, lhs, len, val) # UTF-8 encoded string 27 | 28 | record ir_operator(name, arity, rval) 29 | 30 | record ir_MakeClosure(coord, lhs, name) 31 | record ir_Move(coord, lhs, rhs) 32 | record ir_MoveLabel(coord, lhs, label) 33 | record ir_Deref(coord, lhs, value) 34 | record ir_MakeList(coord, lhs, valueList) 35 | record ir_Field(coord, lhs, expr, field, rval) 36 | record ir_OpFunction(coord, lhs, lhsclosure, fn, argList, rval, failLabel) 37 | record ir_Call(coord, lhs, lhsclosure, fn, argList, nameList, failLabel, scope) 38 | record ir_ResumeValue(coord, lhs, lhsclosure, closure, failLabel) 39 | 40 | record ir_Goto(coord, targetLabel) 41 | record ir_IndirectGoto(coord, targetTmpLabel, labelList) 42 | record ir_Succeed(coord, expr, resumeLabel) 43 | record ir_Fail(coord) 44 | 45 | record ir_Create(coord, lhs, coexpLabel, scope) 46 | record ir_CoRet(coord, value, resumeLabel) 47 | record ir_CoFail(coord) 48 | 49 | record ir_Select(coord, caseList, failLabel) 50 | record ir_SelectCase(coord, kind, lhs, rhs, bodyLabel) 51 | record ir_NoValue(coord, lhs) 52 | 53 | record ir_Unreachable(coord) 54 | -------------------------------------------------------------------------------- /tran/stable-gtran: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proebsting/goaldi/983d69b36561117fb333fc4c316b7c7d16fafcc5/tran/stable-gtran --------------------------------------------------------------------------------